1 /* TODOLIST 2 DofSplitting and DM attached to pc? 3 Change SetNeumannBoundaries to SetNeumannBoundariesLocal and provide new SetNeumannBoundaries (same Dirichlet) 4 change how to deal with the coarse problem (PCBDDCSetCoarseEnvironment): 5 - simplify coarse problem structure -> PCBDDC or PCREDUDANT, nothing else -> same comm for all levels? 6 - remove coarse enums and allow use of PCBDDCGetCoarseKSP 7 - remove metis dependency -> use MatPartitioning for multilevel -> Assemble serial adjacency in ManageLocalBoundaries? 8 code refactoring: 9 - pick up better names for static functions 10 change options structure: 11 - insert BDDC into MG framework? 12 provide other ops? Ask to developers 13 remove all unused printf 14 man pages 15 */ 16 17 /* ---------------------------------------------------------------------------------------------------------------------------------------------- 18 Implementation of BDDC preconditioner based on: 19 C. Dohrmann "An approximate BDDC preconditioner", Numerical Linear Algebra with Applications Volume 14, Issue 2, pages 149-168, March 2007 20 ---------------------------------------------------------------------------------------------------------------------------------------------- */ 21 22 #include "bddc.h" /*I "petscpc.h" I*/ 23 #include <petscblaslapack.h> 24 /* -------------------------------------------------------------------------- */ 25 #undef __FUNCT__ 26 #define __FUNCT__ "PCSetFromOptions_BDDC" 27 PetscErrorCode PCSetFromOptions_BDDC(PC pc) 28 { 29 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 30 PetscErrorCode ierr; 31 32 PetscFunctionBegin; 33 ierr = PetscOptionsHead("BDDC options");CHKERRQ(ierr); 34 /* Verbose debugging of main data structures */ 35 ierr = PetscOptionsBool("-pc_bddc_check_all" ,"Verbose (debugging) output for PCBDDC" ,"none",pcbddc->dbg_flag ,&pcbddc->dbg_flag ,NULL);CHKERRQ(ierr); 36 /* Some customization for default primal space */ 37 ierr = PetscOptionsBool("-pc_bddc_vertices_only" ,"Use only vertices in coarse space (i.e. discard constraints)","none",pcbddc->vertices_flag ,&pcbddc->vertices_flag ,NULL);CHKERRQ(ierr); 38 ierr = PetscOptionsBool("-pc_bddc_constraints_only","Use only constraints in coarse space (i.e. discard vertices)","none",pcbddc->constraints_flag,&pcbddc->constraints_flag,NULL);CHKERRQ(ierr); 39 ierr = PetscOptionsBool("-pc_bddc_faces_only" ,"Use only faces among constraints of coarse space (i.e. discard edges)" ,"none",pcbddc->faces_flag ,&pcbddc->faces_flag ,NULL);CHKERRQ(ierr); 40 ierr = PetscOptionsBool("-pc_bddc_edges_only" ,"Use only edges among constraints of coarse space (i.e. discard faces)" ,"none",pcbddc->edges_flag ,&pcbddc->edges_flag ,NULL);CHKERRQ(ierr); 41 42 /* Coarse solver context */ 43 static const char * const avail_coarse_problems[] = {"sequential","replicated","parallel","multilevel","CoarseProblemType","PC_BDDC_",0}; /* order of choiches depends on ENUM defined in bddc.h */ 44 ierr = PetscOptionsEnum("-pc_bddc_coarse_problem_type","Set coarse problem type","none",avail_coarse_problems,(PetscEnum)pcbddc->coarse_problem_type,(PetscEnum*)&pcbddc->coarse_problem_type,NULL);CHKERRQ(ierr); 45 46 /* Two different application of BDDC to the whole set of dofs, internal and interface */ 47 ierr = PetscOptionsBool("-pc_bddc_switch_preconditioning_type","Switch between M_2 (default) and M_3 preconditioners (as defined by Dohrmann)","none",pcbddc->inexact_prec_type,&pcbddc->inexact_prec_type,NULL);CHKERRQ(ierr); 48 ierr = PetscOptionsBool("-pc_bddc_use_change_of_basis","Use change of basis approach for primal space","none",pcbddc->usechangeofbasis,&pcbddc->usechangeofbasis,NULL);CHKERRQ(ierr); 49 ierr = PetscOptionsBool("-pc_bddc_use_change_on_faces","Use change of basis approach for face constraints","none",pcbddc->usechangeonfaces,&pcbddc->usechangeonfaces,NULL);CHKERRQ(ierr); 50 51 pcbddc->usechangeonfaces = pcbddc->usechangeonfaces && pcbddc->usechangeofbasis; 52 53 ierr = PetscOptionsInt("-pc_bddc_coarsening_ratio","Set coarsening ratio used in multilevel coarsening","none",pcbddc->coarsening_ratio,&pcbddc->coarsening_ratio,NULL);CHKERRQ(ierr); 54 ierr = PetscOptionsInt("-pc_bddc_max_levels","Set maximum number of levels for multilevel","none",pcbddc->max_levels,&pcbddc->max_levels,NULL);CHKERRQ(ierr); 55 ierr = PetscOptionsTail();CHKERRQ(ierr); 56 PetscFunctionReturn(0); 57 } 58 /* -------------------------------------------------------------------------- */ 59 EXTERN_C_BEGIN 60 #undef __FUNCT__ 61 #define __FUNCT__ "PCBDDCSetCoarseProblemType_BDDC" 62 static PetscErrorCode PCBDDCSetCoarseProblemType_BDDC(PC pc, CoarseProblemType CPT) 63 { 64 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 65 66 PetscFunctionBegin; 67 pcbddc->coarse_problem_type = CPT; 68 PetscFunctionReturn(0); 69 } 70 EXTERN_C_END 71 #undef __FUNCT__ 72 #define __FUNCT__ "PCBDDCSetCoarseProblemType" 73 /*@ 74 PCBDDCSetCoarseProblemType - Set coarse problem type in PCBDDC. 75 76 Not collective 77 78 Input Parameters: 79 + pc - the preconditioning context 80 - CoarseProblemType - pick a better name and explain what this is 81 82 Level: intermediate 83 84 Notes: 85 Not collective but all procs must call with same arguments. 86 87 .seealso: PCBDDC 88 @*/ 89 PetscErrorCode PCBDDCSetCoarseProblemType(PC pc, CoarseProblemType CPT) 90 { 91 PetscErrorCode ierr; 92 93 PetscFunctionBegin; 94 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 95 ierr = PetscTryMethod(pc,"PCBDDCSetCoarseProblemType_C",(PC,CoarseProblemType),(pc,CPT));CHKERRQ(ierr); 96 PetscFunctionReturn(0); 97 } 98 /* -------------------------------------------------------------------------- */ 99 EXTERN_C_BEGIN 100 #undef __FUNCT__ 101 #define __FUNCT__ "PCBDDCSetCoarseningRatio_BDDC" 102 static PetscErrorCode PCBDDCSetCoarseningRatio_BDDC(PC pc,PetscInt k) 103 { 104 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 105 106 PetscFunctionBegin; 107 pcbddc->coarsening_ratio=k; 108 PetscFunctionReturn(0); 109 } 110 EXTERN_C_END 111 #undef __FUNCT__ 112 #define __FUNCT__ "PCBDDCSetCoarseningRatio" 113 /*@ 114 PCBDDCSetCoarseningRatio - Set coarsening ratio used in multilevel coarsening 115 116 Logically collective on PC 117 118 Input Parameters: 119 + pc - the preconditioning context 120 - k - coarsening ratio 121 122 Approximatively k subdomains at the finer level will be aggregated into a single subdomain at the coarser level. 123 124 Level: intermediate 125 126 Notes: 127 128 .seealso: PCBDDC 129 @*/ 130 PetscErrorCode PCBDDCSetCoarseningRatio(PC pc,PetscInt k) 131 { 132 PetscErrorCode ierr; 133 134 PetscFunctionBegin; 135 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 136 ierr = PetscTryMethod(pc,"PCBDDCSetCoarseningRatio_C",(PC,PetscInt),(pc,k));CHKERRQ(ierr); 137 PetscFunctionReturn(0); 138 } 139 /* -------------------------------------------------------------------------- */ 140 EXTERN_C_BEGIN 141 #undef __FUNCT__ 142 #define __FUNCT__ "PCBDDCSetMaxLevels_BDDC" 143 static PetscErrorCode PCBDDCSetMaxLevels_BDDC(PC pc,PetscInt max_levels) 144 { 145 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 146 147 PetscFunctionBegin; 148 pcbddc->max_levels=max_levels; 149 PetscFunctionReturn(0); 150 } 151 EXTERN_C_END 152 #undef __FUNCT__ 153 #define __FUNCT__ "PCBDDCSetMaxLevels" 154 /*@ 155 PCBDDCSetMaxLevels - Sets the maximum number of levels within the multilevel approach. 156 157 Logically collective on PC 158 159 Input Parameters: 160 + pc - the preconditioning context 161 - max_levels - the maximum number of levels 162 163 Default value is 1, i.e. coarse problem will be solved inexactly with one application 164 of PCBDDC preconditioner if the multilevel approach is requested. 165 166 Level: intermediate 167 168 Notes: 169 170 .seealso: PCBDDC 171 @*/ 172 PetscErrorCode PCBDDCSetMaxLevels(PC pc,PetscInt max_levels) 173 { 174 PetscErrorCode ierr; 175 176 PetscFunctionBegin; 177 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 178 ierr = PetscTryMethod(pc,"PCBDDCSetMaxLevels_C",(PC,PetscInt),(pc,max_levels));CHKERRQ(ierr); 179 PetscFunctionReturn(0); 180 } 181 /* -------------------------------------------------------------------------- */ 182 EXTERN_C_BEGIN 183 #undef __FUNCT__ 184 #define __FUNCT__ "PCBDDCSetNullSpace_BDDC" 185 static PetscErrorCode PCBDDCSetNullSpace_BDDC(PC pc,MatNullSpace NullSpace) 186 { 187 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 188 PetscErrorCode ierr; 189 190 PetscFunctionBegin; 191 ierr = PetscObjectReference((PetscObject)NullSpace);CHKERRQ(ierr); 192 ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr); 193 194 pcbddc->NullSpace = NullSpace; 195 PetscFunctionReturn(0); 196 } 197 EXTERN_C_END 198 #undef __FUNCT__ 199 #define __FUNCT__ "PCBDDCSetNullSpace" 200 /*@ 201 PCBDDCSetNullSpace - Set NullSpace of global operator of BDDC preconditioned mat. 202 203 Logically collective on PC and MatNullSpace 204 205 Input Parameters: 206 + pc - the preconditioning context 207 - NullSpace - Null space of the linear operator to be preconditioned. 208 209 Level: intermediate 210 211 Notes: 212 213 .seealso: PCBDDC 214 @*/ 215 PetscErrorCode PCBDDCSetNullSpace(PC pc,MatNullSpace NullSpace) 216 { 217 PetscErrorCode ierr; 218 219 PetscFunctionBegin; 220 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 221 ierr = PetscTryMethod(pc,"PCBDDCSetNullSpace_C",(PC,MatNullSpace),(pc,NullSpace));CHKERRQ(ierr); 222 PetscFunctionReturn(0); 223 } 224 /* -------------------------------------------------------------------------- */ 225 EXTERN_C_BEGIN 226 #undef __FUNCT__ 227 #define __FUNCT__ "PCBDDCSetDirichletBoundaries_BDDC" 228 static PetscErrorCode PCBDDCSetDirichletBoundaries_BDDC(PC pc,IS DirichletBoundaries) 229 { 230 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 231 PetscErrorCode ierr; 232 233 PetscFunctionBegin; 234 ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr); 235 ierr = PetscObjectReference((PetscObject)DirichletBoundaries);CHKERRQ(ierr); 236 237 pcbddc->DirichletBoundaries = DirichletBoundaries; 238 PetscFunctionReturn(0); 239 } 240 EXTERN_C_END 241 #undef __FUNCT__ 242 #define __FUNCT__ "PCBDDCSetDirichletBoundaries" 243 /*@ 244 PCBDDCSetDirichletBoundaries - Set index set defining subdomain part (in local ordering) 245 of Dirichlet boundaries for the global problem. 246 247 Not collective 248 249 Input Parameters: 250 + pc - the preconditioning context 251 - DirichletBoundaries - sequential index set defining the subdomain part of Dirichlet boundaries (can be NULL) 252 253 Level: intermediate 254 255 Notes: 256 257 .seealso: PCBDDC 258 @*/ 259 PetscErrorCode PCBDDCSetDirichletBoundaries(PC pc,IS DirichletBoundaries) 260 { 261 PetscErrorCode ierr; 262 263 PetscFunctionBegin; 264 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 265 ierr = PetscTryMethod(pc,"PCBDDCSetDirichletBoundaries_C",(PC,IS),(pc,DirichletBoundaries));CHKERRQ(ierr); 266 PetscFunctionReturn(0); 267 } 268 /* -------------------------------------------------------------------------- */ 269 EXTERN_C_BEGIN 270 #undef __FUNCT__ 271 #define __FUNCT__ "PCBDDCSetNeumannBoundaries_BDDC" 272 static PetscErrorCode PCBDDCSetNeumannBoundaries_BDDC(PC pc,IS NeumannBoundaries) 273 { 274 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 275 PetscErrorCode ierr; 276 277 PetscFunctionBegin; 278 ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr); 279 ierr = PetscObjectReference((PetscObject)NeumannBoundaries);CHKERRQ(ierr); 280 281 pcbddc->NeumannBoundaries = NeumannBoundaries; 282 PetscFunctionReturn(0); 283 } 284 EXTERN_C_END 285 #undef __FUNCT__ 286 #define __FUNCT__ "PCBDDCSetNeumannBoundaries" 287 /*@ 288 PCBDDCSetNeumannBoundaries - Set index set defining subdomain part (in local ordering) 289 of Neumann boundaries for the global problem. 290 291 Not collective 292 293 Input Parameters: 294 + pc - the preconditioning context 295 - NeumannBoundaries - sequential index set defining the subdomain part of Neumann boundaries (can be NULL) 296 297 Level: intermediate 298 299 Notes: 300 301 .seealso: PCBDDC 302 @*/ 303 PetscErrorCode PCBDDCSetNeumannBoundaries(PC pc,IS NeumannBoundaries) 304 { 305 PetscErrorCode ierr; 306 307 PetscFunctionBegin; 308 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 309 ierr = PetscTryMethod(pc,"PCBDDCSetNeumannBoundaries_C",(PC,IS),(pc,NeumannBoundaries));CHKERRQ(ierr); 310 PetscFunctionReturn(0); 311 } 312 /* -------------------------------------------------------------------------- */ 313 EXTERN_C_BEGIN 314 #undef __FUNCT__ 315 #define __FUNCT__ "PCBDDCGetDirichletBoundaries_BDDC" 316 static PetscErrorCode PCBDDCGetDirichletBoundaries_BDDC(PC pc,IS *DirichletBoundaries) 317 { 318 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 319 320 PetscFunctionBegin; 321 *DirichletBoundaries = pcbddc->DirichletBoundaries; 322 PetscFunctionReturn(0); 323 } 324 EXTERN_C_END 325 #undef __FUNCT__ 326 #define __FUNCT__ "PCBDDCGetDirichletBoundaries" 327 /*@ 328 PCBDDCGetDirichletBoundaries - Get index set defining subdomain part (in local ordering) 329 of Dirichlet boundaries for the global problem. 330 331 Not collective 332 333 Input Parameters: 334 + pc - the preconditioning context 335 336 Output Parameters: 337 + DirichletBoundaries - index set defining the subdomain part of Dirichlet boundaries 338 339 Level: intermediate 340 341 Notes: 342 343 .seealso: PCBDDC 344 @*/ 345 PetscErrorCode PCBDDCGetDirichletBoundaries(PC pc,IS *DirichletBoundaries) 346 { 347 PetscErrorCode ierr; 348 349 PetscFunctionBegin; 350 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 351 ierr = PetscUseMethod(pc,"PCBDDCGetDirichletBoundaries_C",(PC,IS*),(pc,DirichletBoundaries));CHKERRQ(ierr); 352 PetscFunctionReturn(0); 353 } 354 /* -------------------------------------------------------------------------- */ 355 EXTERN_C_BEGIN 356 #undef __FUNCT__ 357 #define __FUNCT__ "PCBDDCGetNeumannBoundaries_BDDC" 358 static PetscErrorCode PCBDDCGetNeumannBoundaries_BDDC(PC pc,IS *NeumannBoundaries) 359 { 360 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 361 362 PetscFunctionBegin; 363 *NeumannBoundaries = pcbddc->NeumannBoundaries; 364 PetscFunctionReturn(0); 365 } 366 EXTERN_C_END 367 #undef __FUNCT__ 368 #define __FUNCT__ "PCBDDCGetNeumannBoundaries" 369 /*@ 370 PCBDDCGetNeumannBoundaries - Get index set defining subdomain part (in local ordering) 371 of Neumann boundaries for the global problem. 372 373 Not collective 374 375 Input Parameters: 376 + pc - the preconditioning context 377 378 Output Parameters: 379 + NeumannBoundaries - index set defining the subdomain part of Neumann boundaries 380 381 Level: intermediate 382 383 Notes: 384 385 .seealso: PCBDDC 386 @*/ 387 PetscErrorCode PCBDDCGetNeumannBoundaries(PC pc,IS *NeumannBoundaries) 388 { 389 PetscErrorCode ierr; 390 391 PetscFunctionBegin; 392 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 393 ierr = PetscUseMethod(pc,"PCBDDCGetNeumannBoundaries_C",(PC,IS*),(pc,NeumannBoundaries));CHKERRQ(ierr); 394 PetscFunctionReturn(0); 395 } 396 /* -------------------------------------------------------------------------- */ 397 EXTERN_C_BEGIN 398 #undef __FUNCT__ 399 #define __FUNCT__ "PCBDDCSetLocalAdjacencyGraph_BDDC" 400 static PetscErrorCode PCBDDCSetLocalAdjacencyGraph_BDDC(PC pc, PetscInt nvtxs,const PetscInt xadj[],const PetscInt adjncy[], PetscCopyMode copymode) 401 { 402 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 403 PCBDDCGraph mat_graph=pcbddc->mat_graph; 404 PetscErrorCode ierr; 405 406 PetscFunctionBegin; 407 mat_graph->nvtxs=nvtxs; 408 409 ierr = PetscFree(mat_graph->xadj);CHKERRQ(ierr); 410 ierr = PetscFree(mat_graph->adjncy);CHKERRQ(ierr); 411 if (copymode == PETSC_COPY_VALUES) { 412 ierr = PetscMalloc((mat_graph->nvtxs+1)*sizeof(PetscInt),&mat_graph->xadj);CHKERRQ(ierr); 413 ierr = PetscMalloc(xadj[mat_graph->nvtxs]*sizeof(PetscInt),&mat_graph->adjncy);CHKERRQ(ierr); 414 ierr = PetscMemcpy(mat_graph->xadj,xadj,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr); 415 ierr = PetscMemcpy(mat_graph->adjncy,adjncy,xadj[mat_graph->nvtxs]*sizeof(PetscInt));CHKERRQ(ierr); 416 } else if (copymode == PETSC_OWN_POINTER) { 417 mat_graph->xadj = (PetscInt*)xadj; 418 mat_graph->adjncy = (PetscInt*)adjncy; 419 } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported copy mode %d\n",copymode); 420 PetscFunctionReturn(0); 421 } 422 EXTERN_C_END 423 #undef __FUNCT__ 424 #define __FUNCT__ "PCBDDCSetLocalAdjacencyGraph" 425 /*@ 426 PCBDDCSetLocalAdjacencyGraph - Set CSR graph of local matrix for use of PCBDDC. 427 428 Not collective 429 430 Input Parameters: 431 + pc - the preconditioning context 432 - nvtxs - number of local vertices of the graph 433 - xadj, adjncy - the CSR graph 434 - copymode - either PETSC_COPY_VALUES or PETSC_OWN_POINTER. In the former case the user must free the array passed in; 435 in the latter case, memory must be obtained with PetscMalloc. 436 437 Level: intermediate 438 439 Notes: 440 441 .seealso: PCBDDC 442 @*/ 443 PetscErrorCode PCBDDCSetLocalAdjacencyGraph(PC pc,PetscInt nvtxs,const PetscInt xadj[],const PetscInt adjncy[], PetscCopyMode copymode) 444 { 445 PetscInt nrows,ncols; 446 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 447 PetscErrorCode ierr; 448 449 PetscFunctionBegin; 450 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 451 ierr = MatGetSize(matis->A,&nrows,&ncols);CHKERRQ(ierr); 452 if (nvtxs != nrows) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local adjacency size %d passed in %s differs from local problem size %d!\n",nvtxs,nrows); 453 else { 454 ierr = PetscTryMethod(pc,"PCBDDCSetLocalAdjacencyGraph_C",(PC,PetscInt,const PetscInt[],const PetscInt[],PetscCopyMode),(pc,nvtxs,xadj,adjncy,copymode));CHKERRQ(ierr); 455 } 456 PetscFunctionReturn(0); 457 } 458 /* -------------------------------------------------------------------------- */ 459 EXTERN_C_BEGIN 460 #undef __FUNCT__ 461 #define __FUNCT__ "PCBDDCSetDofsSplitting_BDDC" 462 static PetscErrorCode PCBDDCSetDofsSplitting_BDDC(PC pc,PetscInt n_is, IS ISForDofs[]) 463 { 464 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 465 PetscInt i; 466 PetscErrorCode ierr; 467 468 PetscFunctionBegin; 469 /* Destroy ISes if they were already set */ 470 for (i=0; i<pcbddc->n_ISForDofs; i++) { 471 ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr); 472 } 473 ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr); 474 /* allocate space then set */ 475 ierr = PetscMalloc(n_is*sizeof(IS),&pcbddc->ISForDofs);CHKERRQ(ierr); 476 for (i=0; i<n_is; i++) { 477 ierr = PetscObjectReference((PetscObject)ISForDofs[i]);CHKERRQ(ierr); 478 479 pcbddc->ISForDofs[i]=ISForDofs[i]; 480 } 481 pcbddc->n_ISForDofs=n_is; 482 PetscFunctionReturn(0); 483 } 484 EXTERN_C_END 485 #undef __FUNCT__ 486 #define __FUNCT__ "PCBDDCSetDofsSplitting" 487 /*@ 488 PCBDDCSetDofsSplitting - Set index sets defining fields of local mat. 489 490 Not collective 491 492 Input Parameters: 493 + pc - the preconditioning context 494 - n - number of index sets defining the fields 495 - IS[] - array of IS describing the fields 496 497 Level: intermediate 498 499 Notes: 500 501 .seealso: PCBDDC 502 @*/ 503 PetscErrorCode PCBDDCSetDofsSplitting(PC pc,PetscInt n_is, IS ISForDofs[]) 504 { 505 PetscErrorCode ierr; 506 507 PetscFunctionBegin; 508 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 509 ierr = PetscTryMethod(pc,"PCBDDCSetDofsSplitting_C",(PC,PetscInt,IS[]),(pc,n_is,ISForDofs));CHKERRQ(ierr); 510 PetscFunctionReturn(0); 511 } 512 /* -------------------------------------------------------------------------- */ 513 #undef __FUNCT__ 514 #define __FUNCT__ "PCPreSolve_BDDC" 515 /* -------------------------------------------------------------------------- */ 516 /* 517 PCPreSolve_BDDC - Changes the right hand side and (if necessary) the initial 518 guess if a transformation of basis approach has been selected. 519 520 Input Parameter: 521 + pc - the preconditioner contex 522 523 Application Interface Routine: PCPreSolve() 524 525 Notes: 526 The interface routine PCPreSolve() is not usually called directly by 527 the user, but instead is called by KSPSolve(). 528 */ 529 static PetscErrorCode PCPreSolve_BDDC(PC pc, KSP ksp, Vec rhs, Vec x) 530 { 531 PetscErrorCode ierr; 532 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 533 PC_IS *pcis = (PC_IS*)(pc->data); 534 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 535 Mat temp_mat; 536 IS dirIS; 537 PetscInt dirsize,i,*is_indices; 538 PetscScalar *array_x,*array_diagonal; 539 Vec used_vec; 540 PetscBool guess_nonzero; 541 542 PetscFunctionBegin; 543 if (x) { 544 ierr = PetscObjectReference((PetscObject)x);CHKERRQ(ierr); 545 used_vec = x; 546 } else { 547 ierr = PetscObjectReference((PetscObject)pcbddc->temp_solution);CHKERRQ(ierr); 548 used_vec = pcbddc->temp_solution; 549 ierr = VecSet(used_vec,0.0);CHKERRQ(ierr); 550 } 551 /* hack into ksp data structure PCPreSolve comes earlier in src/ksp/ksp/interface/itfunc.c */ 552 if (ksp) { 553 ierr = KSPGetInitialGuessNonzero(ksp,&guess_nonzero);CHKERRQ(ierr); 554 if (!guess_nonzero) { 555 ierr = VecSet(used_vec,0.0);CHKERRQ(ierr); 556 } 557 } 558 /* store the original rhs */ 559 ierr = VecCopy(rhs,pcbddc->original_rhs);CHKERRQ(ierr); 560 561 /* Take into account zeroed rows -> change rhs and store solution removed */ 562 ierr = MatGetDiagonal(pc->pmat,pcis->vec1_global);CHKERRQ(ierr); 563 ierr = VecPointwiseDivide(pcis->vec1_global,rhs,pcis->vec1_global);CHKERRQ(ierr); 564 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 565 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 566 ierr = VecScatterBegin(matis->ctx,used_vec,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 567 ierr = VecScatterEnd (matis->ctx,used_vec,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 568 ierr = PCBDDCGetDirichletBoundaries(pc,&dirIS);CHKERRQ(ierr); 569 if (dirIS) { 570 ierr = ISGetSize(dirIS,&dirsize);CHKERRQ(ierr); 571 ierr = VecGetArray(pcis->vec1_N,&array_x);CHKERRQ(ierr); 572 ierr = VecGetArray(pcis->vec2_N,&array_diagonal);CHKERRQ(ierr); 573 ierr = ISGetIndices(dirIS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 574 for (i=0; i<dirsize; i++) array_x[is_indices[i]] = array_diagonal[is_indices[i]]; 575 576 ierr = ISRestoreIndices(dirIS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 577 ierr = VecRestoreArray(pcis->vec2_N,&array_diagonal);CHKERRQ(ierr); 578 ierr = VecRestoreArray(pcis->vec1_N,&array_x);CHKERRQ(ierr); 579 } 580 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 581 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 582 583 /* remove the computed solution from the rhs */ 584 ierr = VecScale(used_vec,-1.0);CHKERRQ(ierr); 585 ierr = MatMultAdd(pc->pmat,used_vec,rhs,rhs);CHKERRQ(ierr); 586 ierr = VecScale(used_vec,-1.0);CHKERRQ(ierr); 587 588 /* store partially computed solution and set initial guess */ 589 if (x) { 590 ierr = VecCopy(used_vec,pcbddc->temp_solution);CHKERRQ(ierr); 591 ierr = VecSet(used_vec,0.0);CHKERRQ(ierr); 592 if (pcbddc->use_exact_dirichlet) { 593 ierr = VecScatterBegin(pcis->global_to_D,rhs,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 594 ierr = VecScatterEnd (pcis->global_to_D,rhs,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 595 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 596 ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 597 ierr = VecScatterEnd (pcis->global_to_D,pcis->vec2_D,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 598 if (ksp) { 599 ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr); 600 } 601 } 602 } 603 604 /* rhs change of basis */ 605 if (pcbddc->usechangeofbasis) { 606 /* swap pointers for local matrices */ 607 temp_mat = matis->A; 608 matis->A = pcbddc->local_mat; 609 pcbddc->local_mat = temp_mat; 610 /* Get local rhs and apply transformation of basis */ 611 ierr = VecScatterBegin(pcis->global_to_B,rhs,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 612 ierr = VecScatterEnd (pcis->global_to_B,rhs,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 613 /* from original basis to modified basis */ 614 ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr); 615 /* put back modified values into the global vec using INSERT_VALUES copy mode */ 616 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec2_B,rhs,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 617 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec2_B,rhs,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 618 if (ksp && pcbddc->NullSpace) { 619 ierr = MatNullSpaceRemove(pcbddc->NullSpace,used_vec,NULL);CHKERRQ(ierr); 620 ierr = MatNullSpaceRemove(pcbddc->NullSpace,rhs,NULL);CHKERRQ(ierr); 621 } 622 } 623 ierr = VecDestroy(&used_vec);CHKERRQ(ierr); 624 PetscFunctionReturn(0); 625 } 626 /* -------------------------------------------------------------------------- */ 627 #undef __FUNCT__ 628 #define __FUNCT__ "PCPostSolve_BDDC" 629 /* -------------------------------------------------------------------------- */ 630 /* 631 PCPostSolve_BDDC - Changes the computed solution if a transformation of basis 632 approach has been selected. Also, restores rhs to its original state. 633 634 Input Parameter: 635 + pc - the preconditioner contex 636 637 Application Interface Routine: PCPostSolve() 638 639 Notes: 640 The interface routine PCPostSolve() is not usually called directly by 641 the user, but instead is called by KSPSolve(). 642 */ 643 static PetscErrorCode PCPostSolve_BDDC(PC pc, KSP ksp, Vec rhs, Vec x) 644 { 645 PetscErrorCode ierr; 646 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 647 PC_IS *pcis = (PC_IS*)(pc->data); 648 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 649 Mat temp_mat; 650 651 PetscFunctionBegin; 652 if (pcbddc->usechangeofbasis) { 653 /* swap pointers for local matrices */ 654 temp_mat = matis->A; 655 matis->A = pcbddc->local_mat; 656 pcbddc->local_mat = temp_mat; 657 /* restore rhs to its original state */ 658 if (rhs) { 659 ierr = VecCopy(pcbddc->original_rhs,rhs);CHKERRQ(ierr); 660 } 661 /* Get Local boundary and apply transformation of basis to solution vector */ 662 ierr = VecScatterBegin(pcis->global_to_B,x,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 663 ierr = VecScatterEnd (pcis->global_to_B,x,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 664 /* from modified basis to original basis */ 665 ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr); 666 /* put back modified values into the global vec using INSERT_VALUES copy mode */ 667 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec2_B,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 668 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec2_B,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 669 } 670 /* add solution removed in presolve */ 671 if (x) { 672 ierr = VecAXPY(x,1.0,pcbddc->temp_solution);CHKERRQ(ierr); 673 } 674 PetscFunctionReturn(0); 675 } 676 /* -------------------------------------------------------------------------- */ 677 #undef __FUNCT__ 678 #define __FUNCT__ "PCSetUp_BDDC" 679 /* -------------------------------------------------------------------------- */ 680 /* 681 PCSetUp_BDDC - Prepares for the use of the BDDC preconditioner 682 by setting data structures and options. 683 684 Input Parameter: 685 + pc - the preconditioner context 686 687 Application Interface Routine: PCSetUp() 688 689 Notes: 690 The interface routine PCSetUp() is not usually called directly by 691 the user, but instead is called by PCApply() if necessary. 692 */ 693 PetscErrorCode PCSetUp_BDDC(PC pc) 694 { 695 PetscErrorCode ierr; 696 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 697 698 PetscFunctionBegin; 699 if (!pc->setupcalled) { 700 /* For BDDC we need to define a local "Neumann" problem different to that defined in PCISSetup 701 So, we set to pcnone the Neumann problem of pcis in order to avoid unneeded computation 702 Also, we decide to directly build the (same) Dirichlet problem */ 703 ierr = PetscOptionsSetValue("-is_localN_pc_type","none");CHKERRQ(ierr); 704 ierr = PetscOptionsSetValue("-is_localD_pc_type","none");CHKERRQ(ierr); 705 /* Set up all the "iterative substructuring" common block */ 706 707 ierr = PCISSetUp(pc);CHKERRQ(ierr); 708 /* Get stdout for dbg */ 709 if (pcbddc->dbg_flag) { 710 ierr = PetscViewerASCIIGetStdout(((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","",NULL);CHKERRQ(ierr); 876 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetMaxLevels_C","",NULL);CHKERRQ(ierr); 877 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNullSpace_C","",NULL);CHKERRQ(ierr); 878 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDirichletBoundaries_C","",NULL);CHKERRQ(ierr); 879 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNeumannBoundaries_C","",NULL);CHKERRQ(ierr); 880 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetDirichletBoundaries_C","",NULL);CHKERRQ(ierr); 881 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetNeumannBoundaries_C","",NULL);CHKERRQ(ierr); 882 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseProblemType_C","",NULL);CHKERRQ(ierr); 883 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDofsSplitting_C","",NULL);CHKERRQ(ierr); 884 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetLocalAdjacencyGraph_C","",NULL);CHKERRQ(ierr); 885 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPreSolve_C","",NULL);CHKERRQ(ierr); 886 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPostSolve_C","",NULL);CHKERRQ(ierr); 887 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCCreateFETIDPOperators_C","",NULL);CHKERRQ(ierr); 888 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetRHS_C","",NULL);CHKERRQ(ierr); 889 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetSolution_C","",NULL);CHKERRQ(ierr); 890 /* Free the private data structure that was hanging off the PC */ 891 ierr = PetscFree(pcbddc);CHKERRQ(ierr); 892 PetscFunctionReturn(0); 893 } 894 /* -------------------------------------------------------------------------- */ 895 EXTERN_C_BEGIN 896 #undef __FUNCT__ 897 #define __FUNCT__ "PCBDDCMatFETIDPGetRHS_BDDC" 898 static PetscErrorCode PCBDDCMatFETIDPGetRHS_BDDC(Mat fetidp_mat, Vec standard_rhs, Vec fetidp_flux_rhs) 899 { 900 FETIDPMat_ctx *mat_ctx; 901 PC_IS * pcis; 902 PC_BDDC * pcbddc; 903 PetscErrorCode ierr; 904 905 PetscFunctionBegin; 906 ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr); 907 pcis = (PC_IS*)mat_ctx->pc->data; 908 pcbddc = (PC_BDDC*)mat_ctx->pc->data; 909 910 /* change of basis for physical rhs if needed 911 It also changes the rhs in case of dirichlet boundaries */ 912 (*mat_ctx->pc->ops->presolve)(mat_ctx->pc,NULL,standard_rhs,NULL); 913 /* store vectors for computation of fetidp final solution */ 914 ierr = VecScatterBegin(pcis->global_to_D,standard_rhs,mat_ctx->temp_solution_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 915 ierr = VecScatterEnd (pcis->global_to_D,standard_rhs,mat_ctx->temp_solution_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 916 ierr = VecScatterBegin(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 917 ierr = VecScatterEnd (pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 918 /* scale rhs since it should be unassembled */ 919 ierr = VecPointwiseMult(mat_ctx->temp_solution_B,pcis->D,mat_ctx->temp_solution_B);CHKERRQ(ierr); 920 if (!pcbddc->inexact_prec_type) { 921 /* compute partially subassembled Schur complement right-hand side */ 922 ierr = KSPSolve(pcbddc->ksp_D,mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr); 923 ierr = MatMult(pcis->A_BI,pcis->vec1_D,pcis->vec1_B);CHKERRQ(ierr); 924 ierr = VecAXPY(mat_ctx->temp_solution_B,-1.0,pcis->vec1_B);CHKERRQ(ierr); 925 ierr = VecSet(standard_rhs,0.0);CHKERRQ(ierr); 926 ierr = VecScatterBegin(pcis->global_to_B,mat_ctx->temp_solution_B,standard_rhs,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 927 ierr = VecScatterEnd (pcis->global_to_B,mat_ctx->temp_solution_B,standard_rhs,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 928 ierr = VecScatterBegin(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 929 ierr = VecScatterEnd (pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 930 ierr = VecPointwiseMult(mat_ctx->temp_solution_B,pcis->D,mat_ctx->temp_solution_B);CHKERRQ(ierr); 931 } 932 /* BDDC rhs */ 933 ierr = VecCopy(mat_ctx->temp_solution_B,pcis->vec1_B);CHKERRQ(ierr); 934 if (pcbddc->inexact_prec_type) { 935 ierr = VecCopy(mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr); 936 } 937 /* apply BDDC */ 938 ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr); 939 /* Application of B_delta and assembling of rhs for fetidp fluxes */ 940 ierr = VecSet(fetidp_flux_rhs,0.0);CHKERRQ(ierr); 941 ierr = MatMult(mat_ctx->B_delta,pcis->vec1_B,mat_ctx->lambda_local);CHKERRQ(ierr); 942 ierr = VecScatterBegin(mat_ctx->l2g_lambda,mat_ctx->lambda_local,fetidp_flux_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 943 ierr = VecScatterEnd (mat_ctx->l2g_lambda,mat_ctx->lambda_local,fetidp_flux_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 944 /* restore original rhs */ 945 ierr = VecCopy(pcbddc->original_rhs,standard_rhs);CHKERRQ(ierr); 946 PetscFunctionReturn(0); 947 } 948 EXTERN_C_END 949 #undef __FUNCT__ 950 #define __FUNCT__ "PCBDDCMatFETIDPGetRHS" 951 /*@ 952 PCBDDCMatFETIDPGetRHS - Get rhs for FETIDP linear system. 953 954 Collective 955 956 Input Parameters: 957 + fetidp_mat - the FETIDP mat obtained by a call to PCBDDCCreateFETIDPOperators 958 + standard_rhs - the rhs of your linear system 959 960 Output Parameters: 961 + fetidp_flux_rhs - the rhs of the FETIDP linear system 962 963 Level: developer 964 965 Notes: 966 967 .seealso: PCBDDC 968 @*/ 969 PetscErrorCode PCBDDCMatFETIDPGetRHS(Mat fetidp_mat, Vec standard_rhs, Vec fetidp_flux_rhs) 970 { 971 FETIDPMat_ctx *mat_ctx; 972 PetscErrorCode ierr; 973 974 PetscFunctionBegin; 975 ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr); 976 ierr = PetscTryMethod(mat_ctx->pc,"PCBDDCMatFETIDPGetRHS_C",(Mat,Vec,Vec),(fetidp_mat,standard_rhs,fetidp_flux_rhs));CHKERRQ(ierr); 977 PetscFunctionReturn(0); 978 } 979 /* -------------------------------------------------------------------------- */ 980 EXTERN_C_BEGIN 981 #undef __FUNCT__ 982 #define __FUNCT__ "PCBDDCMatFETIDPGetSolution_BDDC" 983 static PetscErrorCode PCBDDCMatFETIDPGetSolution_BDDC(Mat fetidp_mat, Vec fetidp_flux_sol, Vec standard_sol) 984 { 985 FETIDPMat_ctx *mat_ctx; 986 PC_IS *pcis; 987 PC_BDDC *pcbddc; 988 PetscErrorCode ierr; 989 990 PetscFunctionBegin; 991 ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr); 992 pcis = (PC_IS*)mat_ctx->pc->data; 993 pcbddc = (PC_BDDC*)mat_ctx->pc->data; 994 995 /* apply B_delta^T */ 996 ierr = VecScatterBegin(mat_ctx->l2g_lambda,fetidp_flux_sol,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 997 ierr = VecScatterEnd (mat_ctx->l2g_lambda,fetidp_flux_sol,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 998 ierr = MatMultTranspose(mat_ctx->B_delta,mat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr); 999 /* compute rhs for BDDC application */ 1000 ierr = VecAYPX(pcis->vec1_B,-1.0,mat_ctx->temp_solution_B);CHKERRQ(ierr); 1001 if (pcbddc->inexact_prec_type) { 1002 ierr = VecCopy(mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr); 1003 } 1004 /* apply BDDC */ 1005 ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr); 1006 /* put values into standard global vector */ 1007 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1008 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_B,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1009 if (!pcbddc->inexact_prec_type) { 1010 /* compute values into the interior if solved for the partially subassembled Schur complement */ 1011 ierr = MatMult(pcis->A_IB,pcis->vec1_B,pcis->vec1_D);CHKERRQ(ierr); 1012 ierr = VecAXPY(mat_ctx->temp_solution_D,-1.0,pcis->vec1_D);CHKERRQ(ierr); 1013 ierr = KSPSolve(pcbddc->ksp_D,mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr); 1014 } 1015 ierr = VecScatterBegin(pcis->global_to_D,pcis->vec1_D,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1016 ierr = VecScatterEnd (pcis->global_to_D,pcis->vec1_D,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1017 /* final change of basis if needed 1018 Is also sums the dirichlet part removed during RHS assembling */ 1019 (*mat_ctx->pc->ops->postsolve)(mat_ctx->pc,NULL,NULL,standard_sol); 1020 PetscFunctionReturn(0); 1021 1022 } 1023 EXTERN_C_END 1024 #undef __FUNCT__ 1025 #define __FUNCT__ "PCBDDCMatFETIDPGetSolution" 1026 /*@ 1027 PCBDDCMatFETIDPGetSolution - Get Solution for FETIDP linear system. 1028 1029 Collective 1030 1031 Input Parameters: 1032 + fetidp_mat - the FETIDP mat obtained by a call to PCBDDCCreateFETIDPOperators 1033 + fetidp_flux_sol - the solution of the FETIDP linear system 1034 1035 Output Parameters: 1036 + standard_sol - the solution on the global domain 1037 1038 Level: developer 1039 1040 Notes: 1041 1042 .seealso: PCBDDC 1043 @*/ 1044 PetscErrorCode PCBDDCMatFETIDPGetSolution(Mat fetidp_mat, Vec fetidp_flux_sol, Vec standard_sol) 1045 { 1046 FETIDPMat_ctx *mat_ctx; 1047 PetscErrorCode ierr; 1048 1049 PetscFunctionBegin; 1050 ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr); 1051 ierr = PetscTryMethod(mat_ctx->pc,"PCBDDCMatFETIDPGetSolution_C",(Mat,Vec,Vec),(fetidp_mat,fetidp_flux_sol,standard_sol));CHKERRQ(ierr); 1052 PetscFunctionReturn(0); 1053 } 1054 /* -------------------------------------------------------------------------- */ 1055 EXTERN_C_BEGIN 1056 extern PetscErrorCode FETIDPMatMult(Mat,Vec,Vec); 1057 extern PetscErrorCode PCBDDCDestroyFETIDPMat(Mat); 1058 extern PetscErrorCode FETIDPPCApply(PC,Vec,Vec); 1059 extern PetscErrorCode PCBDDCDestroyFETIDPPC(PC); 1060 #undef __FUNCT__ 1061 #define __FUNCT__ "PCBDDCCreateFETIDPOperators_BDDC" 1062 static PetscErrorCode PCBDDCCreateFETIDPOperators_BDDC(PC pc, Mat *fetidp_mat, PC *fetidp_pc) 1063 { 1064 FETIDPMat_ctx *fetidpmat_ctx; 1065 Mat newmat; 1066 FETIDPPC_ctx *fetidppc_ctx; 1067 PC newpc; 1068 MPI_Comm comm = ((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,NULL,&shell_ctx->basis_mat);CHKERRQ(ierr); 1366 ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,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,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,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],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(NULL,"-fetidp_fullyredundant",&fully_redundant,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,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,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,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,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,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(NULL,"-fetidp_check",&test_fetidp,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,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,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,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,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,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,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 PetscStackCall("LAPACKsyevx",LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int,&abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,&temp_work,&lwork,iwork,ifail,&lierr)); 2616 #else 2617 SETERRQ(((PetscObject) pc)->comm, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1"); 2618 #endif 2619 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEVX Lapack routine %d",(int)lierr); 2620 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2621 #else /* on missing GESVD */ 2622 /* SVD */ 2623 PetscInt max_n,min_n; 2624 max_n = max_size_of_constraint; 2625 min_n = nnsp_addone+nnsp_size; 2626 if (max_size_of_constraint < (nnsp_addone+nnsp_size)) { 2627 min_n = max_size_of_constraint; 2628 max_n = nnsp_addone+nnsp_size; 2629 } 2630 ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 2631 #if defined(PETSC_USE_COMPLEX) 2632 ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 2633 #endif 2634 /* now we evaluate the optimal workspace using query with lwork=-1 */ 2635 lwork =-1; 2636 ierr = PetscBLASIntCast(max_n,&Bs);CHKERRQ(ierr); 2637 ierr = PetscBLASIntCast(min_n,&Bt);CHKERRQ(ierr); 2638 dummy_int = Bs; 2639 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2640 #if !defined(PETSC_USE_COMPLEX) 2641 PetscStackCall("LAPACKgesvd",LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr)); 2642 #else 2643 PetscStackCall("LAPACKgesvd",LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr); 2644 #endif 2645 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SVD Lapack routine %d",(int)lierr); 2646 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2647 #endif 2648 /* Allocate optimal workspace */ 2649 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr); 2650 total_counts = (PetscInt)lwork; 2651 ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&work);CHKERRQ(ierr); 2652 } 2653 /* get local part of global near null space vectors */ 2654 ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr); 2655 for (k=0; k<nnsp_size; k++) { 2656 ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr); 2657 ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2658 ierr = VecScatterEnd (matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2659 } 2660 /* Now we can loop on constraining sets */ 2661 total_counts =0; 2662 temp_indices[0]=0; 2663 /* vertices */ 2664 PetscBool used_vertex; 2665 ierr = ISGetIndices(pcbddc->ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2666 if (nnsp_has_cnst) { /* consider all vertices */ 2667 for (i=0; i<n_vertices; i++) { 2668 temp_indices_to_constraint[temp_indices[total_counts]] = is_indices[i]; 2669 temp_indices_to_constraint_B[temp_indices[total_counts]]= local_to_B[is_indices[i]]; 2670 temp_quadrature_constraint[temp_indices[total_counts]] = 1.0; 2671 temp_indices[total_counts+1] = temp_indices[total_counts]+1; 2672 change_basis[total_counts] = PETSC_FALSE; 2673 total_counts++; 2674 } 2675 } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */ 2676 for (i=0; i<n_vertices; i++) { 2677 used_vertex = PETSC_FALSE; 2678 k = 0; 2679 while (!used_vertex && k<nnsp_size) { 2680 ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2681 if (PetscAbsScalar(array_vector[is_indices[i]])>0.0) { 2682 temp_indices_to_constraint[temp_indices[total_counts]] =is_indices[i]; 2683 temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 2684 temp_quadrature_constraint[temp_indices[total_counts]] =1.0; 2685 temp_indices[total_counts+1] =temp_indices[total_counts]+1; 2686 change_basis[total_counts] =PETSC_FALSE; 2687 total_counts++; 2688 used_vertex=PETSC_TRUE; 2689 } 2690 ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2691 k++; 2692 } 2693 } 2694 } 2695 ierr = ISRestoreIndices(pcbddc->ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2696 n_vertices = total_counts; 2697 2698 /* edges and faces */ 2699 for (i=0; i<pcbddc->n_ISForEdges+pcbddc->n_ISForFaces; i++) { 2700 if (i<pcbddc->n_ISForEdges) { 2701 used_IS = &pcbddc->ISForEdges[i]; 2702 boolforface = pcbddc->usechangeofbasis; 2703 } else { 2704 used_IS = &pcbddc->ISForFaces[i-pcbddc->n_ISForEdges]; 2705 boolforface = pcbddc->usechangeonfaces; 2706 } 2707 temp_constraints = 0; /* zero the number of constraints I have on this conn comp */ 2708 temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */ 2709 ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr); 2710 ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2711 if (nnsp_has_cnst) { 2712 temp_constraints++; 2713 quad_value = (PetscScalar) (1.0/PetscSqrtReal((PetscReal)size_of_constraint)); 2714 for (j=0; j<size_of_constraint; j++) { 2715 temp_indices_to_constraint[temp_indices[total_counts]+j] =is_indices[j]; 2716 temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 2717 temp_quadrature_constraint[temp_indices[total_counts]+j] =quad_value; 2718 } 2719 temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 2720 change_basis[total_counts] =boolforface; 2721 total_counts++; 2722 } 2723 for (k=0; k<nnsp_size; k++) { 2724 ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2725 for (j=0; j<size_of_constraint; j++) { 2726 temp_indices_to_constraint[temp_indices[total_counts]+j] =is_indices[j]; 2727 temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 2728 temp_quadrature_constraint[temp_indices[total_counts]+j] =array_vector[is_indices[j]]; 2729 } 2730 ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2731 quad_value = 1.0; 2732 if (use_nnsp_true) { /* check if array is null on the connected component in case use_nnsp_true has been requested */ 2733 ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr); 2734 PetscStackCall("BLASasum",quad_value = BLASasum_(&Bs,&temp_quadrature_constraint[temp_indices[total_counts]],&Bone)); 2735 } 2736 if (quad_value > 0.0) { /* keep indices and values */ 2737 temp_constraints++; 2738 temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 2739 change_basis[total_counts] =boolforface; 2740 total_counts++; 2741 } 2742 } 2743 ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2744 /* perform SVD on the constraint if use_nnsp_true has not be requested by the user */ 2745 if (!use_nnsp_true) { 2746 ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr); 2747 ierr = PetscBLASIntCast(temp_constraints,&Bt);CHKERRQ(ierr); 2748 2749 #if defined(PETSC_MISSING_LAPACK_GESVD) 2750 ierr = PetscMemzero(correlation_mat,Bt*Bt*sizeof(PetscScalar));CHKERRQ(ierr); 2751 /* Store upper triangular part of correlation matrix */ 2752 for (j=0; j<temp_constraints; j++) { 2753 for (k=0; k<j+1; k++) { 2754 #if defined(PETSC_USE_COMPLEX) 2755 /* hand made complex dot product -> replace */ 2756 dot_result = 0.0; 2757 for (ii=0; ii<size_of_constraint; ii++) { 2758 val1 = temp_quadrature_constraint[temp_indices[temp_start_ptr+j]+ii]; 2759 val2 = temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]; 2760 dot_result += val1*PetscConj(val2); 2761 } 2762 #else 2763 PetscStackCall("BLASdot",dot_result = BLASdot_(&Bs,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Bone,&temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Bone)); 2764 #endif 2765 correlation_mat[j*temp_constraints+k]=dot_result; 2766 } 2767 } 2768 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2769 #if !defined(PETSC_USE_COMPLEX) 2770 PetscStackCall("LAPACKsyevx",LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int,&abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,work,&lwork,iwork,ifail,&lierr)); 2771 #else 2772 SETERRQ(((PetscObject) pc)->comm, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1"); 2773 #endif 2774 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEVX Lapack routine %d",(int)lierr); 2775 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2776 /* retain eigenvalues greater than tol: note that lapack SYEV gives eigs in ascending order */ 2777 j=0; 2778 while (j < Bt && singular_vals[j] < tol) j++; 2779 total_counts=total_counts-j; 2780 if (j<temp_constraints) { 2781 for (k=j;k<Bt;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]); 2782 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2783 PetscStackCall("BLASgemm",BLASgemm_("N","N",&Bs,&Bt,&Bt,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,correlation_mat,&Bt,&zero,temp_basis,&Bs)); 2784 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2785 /* copy POD basis into used quadrature memory */ 2786 for (k=0;k<Bt-j;k++) { 2787 for (ii=0;ii<size_of_constraint;ii++) { 2788 temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[Bt-1-k]*temp_basis[(Bt-1-k)*size_of_constraint+ii]; 2789 } 2790 } 2791 } 2792 2793 #else /* on missing GESVD */ 2794 PetscInt min_n = temp_constraints; 2795 if (min_n > size_of_constraint) min_n = size_of_constraint; 2796 dummy_int = Bs; 2797 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2798 #if !defined(PETSC_USE_COMPLEX) 2799 PetscStackCall("LAPACKgesvd",LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr)); 2800 #else 2801 PetscStackCall("LAPACKgesvd",LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr); 2802 #endif 2803 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SVD Lapack routine %d",(int)lierr); 2804 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2805 /* retain eigenvalues greater than tol: note that lapack SVD gives eigs in descending order */ 2806 j=0; 2807 while (j < min_n && singular_vals[min_n-j-1] < tol) j++; 2808 total_counts = total_counts-(PetscInt)Bt+(min_n-j); 2809 #endif 2810 } 2811 } 2812 2813 n_constraints =total_counts-n_vertices; 2814 local_primal_size = total_counts; 2815 /* set quantities in pcbddc data structure */ 2816 pcbddc->n_vertices = n_vertices; 2817 pcbddc->n_constraints = n_constraints; 2818 pcbddc->local_primal_size = local_primal_size; 2819 2820 /* Create constraint matrix */ 2821 /* The constraint matrix is used to compute the l2g map of primal dofs */ 2822 /* so we need to set it up properly either with or without change of basis */ 2823 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 2824 ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr); 2825 ierr = MatSetSizes(pcbddc->ConstraintMatrix,local_primal_size,pcis->n,local_primal_size,pcis->n);CHKERRQ(ierr); 2826 2827 /* compute a local numbering of constraints : vertices first then constraints */ 2828 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 2829 ierr = VecGetArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr); 2830 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr); 2831 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_permutation);CHKERRQ(ierr); 2832 2833 total_counts=0; 2834 2835 /* find vertices: subdomain corners plus dofs with basis changed */ 2836 for (i=0; i<local_primal_size; i++) { 2837 size_of_constraint=temp_indices[i+1]-temp_indices[i]; 2838 if (change_basis[i] || size_of_constraint == 1) { 2839 k=0; 2840 while (k < size_of_constraint && array_vector[temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]] != 0.0) { 2841 k=k+1; 2842 } 2843 j = temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]; 2844 2845 array_vector[j] = 1.0; 2846 aux_primal_numbering[total_counts] = j; 2847 aux_primal_permutation[total_counts] = total_counts; 2848 total_counts++; 2849 } 2850 } 2851 ierr = VecRestoreArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr); 2852 /* permute indices in order to have a sorted set of vertices */ 2853 ierr = PetscSortIntWithPermutation(total_counts,aux_primal_numbering,aux_primal_permutation); 2854 /* nonzero structure */ 2855 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 2856 for (i=0;i<total_counts;i++) nnz[i]=1; 2857 2858 j=total_counts; 2859 for (i=n_vertices; i<local_primal_size; i++) { 2860 if (!change_basis[i]) { 2861 nnz[j]=temp_indices[i+1]-temp_indices[i]; 2862 j++; 2863 } 2864 } 2865 ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr); 2866 ierr = PetscFree(nnz);CHKERRQ(ierr); 2867 /* set values in constraint matrix */ 2868 for (i=0; i<total_counts; i++) { 2869 j = aux_primal_permutation[i]; 2870 k = aux_primal_numbering[j]; 2871 ierr = MatSetValue(pcbddc->ConstraintMatrix,i,k,1.0,INSERT_VALUES);CHKERRQ(ierr); 2872 } 2873 for (i=n_vertices; i<local_primal_size; i++) { 2874 if (!change_basis[i]) { 2875 size_of_constraint = temp_indices[i+1]-temp_indices[i]; 2876 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); 2877 total_counts++; 2878 } 2879 } 2880 ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr); 2881 ierr = PetscFree(aux_primal_permutation);CHKERRQ(ierr); 2882 /* assembling */ 2883 ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2884 ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2885 2886 /* Create matrix for change of basis. We don't need it in case pcbddc->usechangeofbasis is FALSE */ 2887 if (pcbddc->usechangeofbasis) { 2888 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 2889 ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr); 2890 ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr); 2891 /* work arrays */ 2892 /* we need to reuse these arrays, so we free them */ 2893 ierr = PetscFree(temp_basis);CHKERRQ(ierr); 2894 ierr = PetscFree(work);CHKERRQ(ierr); 2895 ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 2896 ierr = PetscMalloc((nnsp_addone+nnsp_size)*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr); 2897 ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscScalar),&work);CHKERRQ(ierr); 2898 ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscBLASInt),&ipiv);CHKERRQ(ierr); 2899 for (i=0;i<pcis->n_B;i++) nnz[i]=1; 2900 2901 /* Overestimated nonzeros per row */ 2902 k=1; 2903 for (i=pcbddc->n_vertices;i<local_primal_size;i++) { 2904 if (change_basis[i]) { 2905 size_of_constraint = temp_indices[i+1]-temp_indices[i]; 2906 if (k < size_of_constraint) k = size_of_constraint; 2907 2908 for (j=0;j<size_of_constraint;j++) { 2909 nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint; 2910 } 2911 } 2912 } 2913 ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr); 2914 ierr = PetscFree(nnz);CHKERRQ(ierr); 2915 /* Temporary array to store indices */ 2916 ierr = PetscMalloc(k*sizeof(PetscInt),&is_indices);CHKERRQ(ierr); 2917 /* Set initial identity in the matrix */ 2918 for (i=0; i<pcis->n_B; i++) { 2919 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr); 2920 } 2921 /* Now we loop on the constraints which need a change of basis */ 2922 /* Change of basis matrix is evaluated as the FIRST APPROACH in */ 2923 /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (6.2.1) */ 2924 temp_constraints = 0; 2925 if (pcbddc->n_vertices < local_primal_size) { 2926 temp_start_ptr = temp_indices_to_constraint_B[temp_indices[pcbddc->n_vertices]]; 2927 } 2928 for (i=pcbddc->n_vertices; i<local_primal_size; i++) { 2929 if (change_basis[i]) { 2930 compute_submatrix = PETSC_FALSE; 2931 useksp = PETSC_FALSE; 2932 if (temp_start_ptr == temp_indices_to_constraint_B[temp_indices[i]]) { 2933 temp_constraints++; 2934 if (i == local_primal_size -1 || temp_start_ptr != temp_indices_to_constraint_B[temp_indices[i+1]]) { 2935 compute_submatrix = PETSC_TRUE; 2936 } 2937 } 2938 if (compute_submatrix) { 2939 if (temp_constraints > 1 || pcbddc->use_nnsp_true) useksp = PETSC_TRUE; 2940 size_of_constraint = temp_indices[i+1]-temp_indices[i]; 2941 if (useksp) { /* experimental */ 2942 ierr = MatCreate(PETSC_COMM_SELF,&temp_mat);CHKERRQ(ierr); 2943 ierr = MatSetType(temp_mat,impMatType);CHKERRQ(ierr); 2944 ierr = MatSetSizes(temp_mat,size_of_constraint,size_of_constraint,size_of_constraint,size_of_constraint);CHKERRQ(ierr); 2945 ierr = MatSeqAIJSetPreallocation(temp_mat,size_of_constraint,NULL);CHKERRQ(ierr); 2946 } 2947 /* First _size_of_constraint-temp_constraints_ columns */ 2948 dual_dofs = size_of_constraint-temp_constraints; 2949 start_constraint = i+1-temp_constraints; 2950 for (s=0; s<dual_dofs; s++) { 2951 is_indices[0] = s; 2952 for (j=0;j<temp_constraints;j++) { 2953 for (k=0;k<temp_constraints;k++) { 2954 temp_basis[j*temp_constraints+k]=temp_quadrature_constraint[temp_indices[start_constraint+k]+s+j+1]; 2955 } 2956 work[j] = -temp_quadrature_constraint[temp_indices[start_constraint+j]+s]; 2957 is_indices[j+1] = s+j+1; 2958 } 2959 Bt = temp_constraints; 2960 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2961 PetscStackCall("LAPACKgesvd",LAPACKgesv_(&Bt,&Bone,temp_basis,&Bt,ipiv,work,&Bt,&lierr)); 2962 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESV Lapack routine %d",(int)lierr); 2963 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2964 j = temp_indices_to_constraint_B[temp_indices[start_constraint]+s]; 2965 ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,temp_constraints,&temp_indices_to_constraint_B[temp_indices[start_constraint]+s+1],1,&j,work,INSERT_VALUES);CHKERRQ(ierr); 2966 if (useksp) { 2967 /* temp mat with transposed rows and columns */ 2968 ierr = MatSetValues(temp_mat,1,&s,temp_constraints,&is_indices[1],work,INSERT_VALUES);CHKERRQ(ierr); 2969 ierr = MatSetValue(temp_mat,is_indices[0],is_indices[0],1.0,INSERT_VALUES);CHKERRQ(ierr); 2970 } 2971 } 2972 if (useksp) { 2973 /* last rows of temp_mat */ 2974 for (j=0;j<size_of_constraint;j++) is_indices[j] = j; 2975 2976 for (s=0;s<temp_constraints;s++) { 2977 k = s + dual_dofs; 2978 ierr = MatSetValues(temp_mat,1,&k,size_of_constraint,is_indices,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr); 2979 } 2980 ierr = MatAssemblyBegin(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2981 ierr = MatAssemblyEnd(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2982 ierr = MatGetVecs(temp_mat,&temp_vec,NULL);CHKERRQ(ierr); 2983 ierr = KSPCreate(PETSC_COMM_SELF,&temp_ksp);CHKERRQ(ierr); 2984 ierr = KSPSetOperators(temp_ksp,temp_mat,temp_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 2985 ierr = KSPSetType(temp_ksp,KSPPREONLY);CHKERRQ(ierr); 2986 ierr = KSPGetPC(temp_ksp,&temp_pc);CHKERRQ(ierr); 2987 ierr = PCSetType(temp_pc,PCLU);CHKERRQ(ierr); 2988 ierr = KSPSetUp(temp_ksp);CHKERRQ(ierr); 2989 for (s=0; s<temp_constraints; s++) { 2990 ierr = VecSet(temp_vec,0.0);CHKERRQ(ierr); 2991 ierr = VecSetValue(temp_vec,s+dual_dofs,1.0,INSERT_VALUES);CHKERRQ(ierr); 2992 ierr = VecAssemblyBegin(temp_vec);CHKERRQ(ierr); 2993 ierr = VecAssemblyEnd(temp_vec);CHKERRQ(ierr); 2994 ierr = KSPSolve(temp_ksp,temp_vec,temp_vec);CHKERRQ(ierr); 2995 ierr = VecGetArray(temp_vec,&array_vector);CHKERRQ(ierr); 2996 j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1]; 2997 /* last columns of change of basis matrix associated to new primal dofs */ 2998 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); 2999 ierr = VecRestoreArray(temp_vec,&array_vector);CHKERRQ(ierr); 3000 } 3001 ierr = MatDestroy(&temp_mat);CHKERRQ(ierr); 3002 ierr = KSPDestroy(&temp_ksp);CHKERRQ(ierr); 3003 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 3004 } else { 3005 /* last columns of change of basis matrix associated to new primal dofs */ 3006 for (s=0; s<temp_constraints; s++) { 3007 j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1]; 3008 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); 3009 } 3010 } 3011 /* prepare for the next cycle */ 3012 temp_constraints = 0; 3013 if (i != local_primal_size -1) temp_start_ptr = temp_indices_to_constraint_B[temp_indices[i+1]]; 3014 } 3015 } 3016 } 3017 /* assembling */ 3018 ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3019 ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3020 ierr = PetscFree(ipiv);CHKERRQ(ierr); 3021 ierr = PetscFree(is_indices);CHKERRQ(ierr); 3022 } 3023 /* free workspace no longer needed */ 3024 ierr = PetscFree(rwork);CHKERRQ(ierr); 3025 ierr = PetscFree(work);CHKERRQ(ierr); 3026 ierr = PetscFree(temp_basis);CHKERRQ(ierr); 3027 ierr = PetscFree(singular_vals);CHKERRQ(ierr); 3028 ierr = PetscFree(correlation_mat);CHKERRQ(ierr); 3029 ierr = PetscFree(temp_indices);CHKERRQ(ierr); 3030 ierr = PetscFree(change_basis);CHKERRQ(ierr); 3031 ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr); 3032 ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr); 3033 ierr = PetscFree(local_to_B);CHKERRQ(ierr); 3034 ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr); 3035 #if defined(PETSC_MISSING_LAPACK_GESVD) 3036 ierr = PetscFree(iwork);CHKERRQ(ierr); 3037 ierr = PetscFree(ifail);CHKERRQ(ierr); 3038 ierr = PetscFree(singular_vectors);CHKERRQ(ierr); 3039 #endif 3040 for (k=0; k<nnsp_size; k++) { 3041 ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr); 3042 } 3043 ierr = PetscFree(localnearnullsp);CHKERRQ(ierr); 3044 PetscFunctionReturn(0); 3045 } 3046 /* -------------------------------------------------------------------------- */ 3047 #undef __FUNCT__ 3048 #define __FUNCT__ "PCBDDCCoarseSetUp" 3049 static PetscErrorCode PCBDDCCoarseSetUp(PC pc) 3050 { 3051 PetscErrorCode ierr; 3052 PC_IS *pcis = (PC_IS*)(pc->data); 3053 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3054 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 3055 Mat change_mat_all; 3056 IS is_R_local; 3057 IS is_V_local; 3058 IS is_C_local; 3059 IS is_aux1; 3060 IS is_aux2; 3061 VecType impVecType; 3062 MatType impMatType; 3063 PetscInt n_R =0; 3064 PetscInt n_D =0; 3065 PetscInt n_B =0; 3066 PetscScalar zero =0.0; 3067 PetscScalar one =1.0; 3068 PetscScalar m_one=-1.0; 3069 PetscScalar * array; 3070 PetscScalar *coarse_submat_vals; 3071 PetscInt *idx_R_local; 3072 PetscInt *idx_V_B; 3073 PetscScalar *coarsefunctions_errors; 3074 PetscScalar *constraints_errors; 3075 3076 /* auxiliary indices */ 3077 PetscInt i,j,k; 3078 3079 /* for verbose output of bddc */ 3080 PetscViewer viewer =pcbddc->dbg_viewer; 3081 PetscBool dbg_flag=pcbddc->dbg_flag; 3082 3083 /* for counting coarse dofs */ 3084 PetscInt n_vertices,n_constraints; 3085 PetscInt size_of_constraint; 3086 PetscInt *row_cmat_indices; 3087 PetscScalar *row_cmat_values; 3088 PetscInt *vertices,*nnz,*is_indices,*temp_indices; 3089 3090 PetscFunctionBegin; 3091 /* Set Non-overlapping dimensions */ 3092 n_B = pcis->n_B; n_D = pcis->n - n_B; 3093 /* Set types for local objects needed by BDDC precondtioner */ 3094 impMatType = MATSEQDENSE; 3095 impVecType = VECSEQ; 3096 3097 /* get vertex indices from constraint matrix */ 3098 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&vertices);CHKERRQ(ierr); 3099 n_vertices=0; 3100 for (i=0; i<pcbddc->local_primal_size; i++) { 3101 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 3102 if (size_of_constraint == 1) { 3103 vertices[n_vertices]=row_cmat_indices[0]; 3104 n_vertices++; 3105 } 3106 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 3107 } 3108 /* Set number of constraints */ 3109 n_constraints = pcbddc->local_primal_size-n_vertices; 3110 3111 /* vertices in boundary numbering */ 3112 if (n_vertices) { 3113 ierr = VecSet(pcis->vec1_N,m_one);CHKERRQ(ierr); 3114 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3115 for (i=0; i<n_vertices; i++) array[vertices[i]] = i; 3116 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3117 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3118 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3119 ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr); 3120 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3121 for (i=0; i<n_vertices; i++) { 3122 j=0; 3123 while (array[j] != i) j++; 3124 idx_V_B[i]=j; 3125 } 3126 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3127 } 3128 3129 /* transform local matrices if needed */ 3130 if (pcbddc->usechangeofbasis) { 3131 ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 3132 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3133 for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1; 3134 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3135 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3136 k=1; 3137 for (i=0;i<n_B;i++) { 3138 ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr); 3139 nnz[is_indices[i]]=j; 3140 if (k < j) k = j; 3141 ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr); 3142 } 3143 ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3144 /* assemble change of basis matrix on the whole set of local dofs */ 3145 ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr); 3146 ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr); 3147 ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr); 3148 ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr); 3149 ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr); 3150 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3151 for (i=0; i<n_D; i++) { 3152 ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr); 3153 } 3154 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3155 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3156 for (i=0; i<n_B; i++) { 3157 ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3158 for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]]; 3159 ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr); 3160 ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3161 } 3162 ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3163 ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3164 ierr = MatPtAP(matis->A,change_mat_all,MAT_INITIAL_MATRIX,1.0,&pcbddc->local_mat);CHKERRQ(ierr); 3165 ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr); 3166 ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr); 3167 ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr); 3168 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_IB);CHKERRQ(ierr); 3169 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_BI);CHKERRQ(ierr); 3170 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_BB);CHKERRQ(ierr); 3171 ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr); 3172 ierr = PetscFree(nnz);CHKERRQ(ierr); 3173 ierr = PetscFree(temp_indices);CHKERRQ(ierr); 3174 } else { 3175 /* without change of basis, the local matrix is unchanged */ 3176 ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr); 3177 3178 pcbddc->local_mat = matis->A; 3179 } 3180 /* Change global null space passed in by the user if change of basis has been performed */ 3181 if (pcbddc->NullSpace && pcbddc->usechangeofbasis) { 3182 ierr = PCBDDCAdaptNullSpace(pc);CHKERRQ(ierr); 3183 } 3184 3185 /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */ 3186 ierr = VecSet(pcis->vec1_N,one);CHKERRQ(ierr); 3187 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3188 for (i=0;i<n_vertices;i++) array[vertices[i]] = zero; 3189 ierr = PetscMalloc((pcis->n - n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr); 3190 for (i=0, n_R=0; i<pcis->n; i++) { 3191 if (array[i] == one) { 3192 idx_R_local[n_R] = i; 3193 n_R++; 3194 } 3195 } 3196 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3197 if (dbg_flag) { 3198 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3199 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3200 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr); 3201 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr); 3202 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); 3203 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr); 3204 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3205 } 3206 3207 /* Allocate needed vectors */ 3208 ierr = VecDuplicate(pcis->vec1_global,&pcbddc->original_rhs);CHKERRQ(ierr); 3209 ierr = VecDuplicate(pcis->vec1_global,&pcbddc->temp_solution);CHKERRQ(ierr); 3210 ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr); 3211 ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_R);CHKERRQ(ierr); 3212 ierr = VecSetSizes(pcbddc->vec1_R,n_R,n_R);CHKERRQ(ierr); 3213 ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr); 3214 ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr); 3215 ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_P);CHKERRQ(ierr); 3216 ierr = VecSetSizes(pcbddc->vec1_P,pcbddc->local_primal_size,pcbddc->local_primal_size);CHKERRQ(ierr); 3217 ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr); 3218 3219 /* Creating some index sets needed */ 3220 /* For submatrices */ 3221 ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&is_R_local);CHKERRQ(ierr); 3222 if (n_vertices) { 3223 ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_OWN_POINTER,&is_V_local);CHKERRQ(ierr); 3224 } 3225 if (n_constraints) { 3226 ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_C_local);CHKERRQ(ierr); 3227 } 3228 3229 /* For VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */ 3230 { 3231 PetscInt *aux_array1; 3232 PetscInt *aux_array2; 3233 PetscInt *idx_I_local; 3234 3235 ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr); 3236 ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr); 3237 3238 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&idx_I_local);CHKERRQ(ierr); 3239 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3240 for (i=0; i<n_D; i++) array[idx_I_local[i]] = 0; 3241 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&idx_I_local);CHKERRQ(ierr); 3242 for (i=0, j=0; i<n_R; i++) { 3243 if (array[idx_R_local[i]] == one) { 3244 aux_array1[j] = i; 3245 j++; 3246 } 3247 } 3248 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3249 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr); 3250 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3251 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3252 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3253 for (i=0, j=0; i<n_B; i++) { 3254 if (array[i] == one) { 3255 aux_array2[j] = i; j++; 3256 } 3257 } 3258 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3259 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_COPY_VALUES,&is_aux2);CHKERRQ(ierr); 3260 ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr); 3261 ierr = PetscFree(aux_array1);CHKERRQ(ierr); 3262 ierr = PetscFree(aux_array2);CHKERRQ(ierr); 3263 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3264 ierr = ISDestroy(&is_aux2);CHKERRQ(ierr); 3265 3266 if (pcbddc->inexact_prec_type || dbg_flag) { 3267 ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr); 3268 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3269 for (i=0, j=0; i<n_R; i++) { 3270 if (array[idx_R_local[i]] == zero) { 3271 aux_array1[j] = i; 3272 j++; 3273 } 3274 } 3275 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3276 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr); 3277 ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr); 3278 ierr = PetscFree(aux_array1);CHKERRQ(ierr); 3279 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3280 } 3281 } 3282 3283 /* Creating PC contexts for local Dirichlet and Neumann problems */ 3284 { 3285 Mat A_RR; 3286 PC pc_temp; 3287 3288 /* Matrix for Dirichlet problem is A_II -> we already have it from pcis.c code */ 3289 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr); 3290 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr); 3291 ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,SAME_PRECONDITIONER);CHKERRQ(ierr); 3292 ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr); 3293 ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr); 3294 3295 /* default */ 3296 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 3297 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 3298 3299 /* Allow user's customization */ 3300 ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr); 3301 3302 /* umfpack interface has a bug when matrix dimension is zero */ 3303 if (!n_D) { 3304 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 3305 } 3306 3307 /* Set Up KSP for Dirichlet problem of BDDC */ 3308 ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr); 3309 3310 /* set ksp_D into pcis data */ 3311 ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr); 3312 ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr); 3313 pcis->ksp_D = pcbddc->ksp_D; 3314 3315 /* Matrix for Neumann problem is A_RR -> we need to create it */ 3316 ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr); 3317 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr); 3318 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr); 3319 ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,SAME_PRECONDITIONER);CHKERRQ(ierr); 3320 ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr); 3321 ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr); 3322 3323 /* default */ 3324 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 3325 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 3326 3327 /* Allow user's customization */ 3328 ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr); 3329 3330 /* umfpack interface has a bug when matrix dimension is zero */ 3331 if (!pcis->n) { 3332 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 3333 } 3334 3335 /* Set Up KSP for Neumann problem of BDDC */ 3336 ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr); 3337 3338 /* check Dirichlet and Neumann solvers and adapt them is a nullspace correction is needed */ 3339 { 3340 Vec temp_vec; 3341 PetscReal value; 3342 PetscMPIInt use_exact,use_exact_reduced; 3343 3344 ierr = VecDuplicate(pcis->vec1_D,&temp_vec);CHKERRQ(ierr); 3345 ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr); 3346 ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 3347 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,temp_vec);CHKERRQ(ierr); 3348 ierr = VecAXPY(temp_vec,m_one,pcis->vec1_D);CHKERRQ(ierr); 3349 ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr); 3350 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 3351 use_exact = 1; 3352 if (PetscAbsReal(value) > 1.e-4) use_exact = 0; 3353 3354 ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,((PetscObject)pc)->comm);CHKERRQ(ierr); 3355 pcbddc->use_exact_dirichlet = (PetscBool) use_exact_reduced; 3356 if (dbg_flag) { 3357 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3358 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3359 ierr = PetscViewerASCIIPrintf(viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr); 3360 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr); 3361 } 3362 if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->inexact_prec_type) { 3363 ierr = PCBDDCAdaptLocalProblem(pc,pcis->is_I_local); 3364 } 3365 ierr = VecDuplicate(pcbddc->vec1_R,&temp_vec);CHKERRQ(ierr); 3366 ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr); 3367 ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 3368 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,temp_vec);CHKERRQ(ierr); 3369 ierr = VecAXPY(temp_vec,m_one,pcbddc->vec1_R);CHKERRQ(ierr); 3370 ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr); 3371 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 3372 3373 use_exact = 1; 3374 if (PetscAbsReal(value) > 1.e-4) use_exact = 0; 3375 ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,((PetscObject)pc)->comm);CHKERRQ(ierr); 3376 if (dbg_flag) { 3377 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for Neumann solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr); 3378 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3379 } 3380 if (pcbddc->NullSpace && !use_exact_reduced) { 3381 ierr = PCBDDCAdaptLocalProblem(pc,is_R_local); 3382 } 3383 } 3384 /* free Neumann problem's matrix */ 3385 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 3386 } 3387 3388 /* Assemble all remaining stuff needed to apply BDDC */ 3389 { 3390 Mat A_RV,A_VR,A_VV; 3391 Mat M1; 3392 Mat C_CR; 3393 Mat AUXMAT; 3394 Vec vec1_C; 3395 Vec vec2_C; 3396 Vec vec1_V; 3397 Vec vec2_V; 3398 PetscInt *nnz; 3399 PetscInt *auxindices; 3400 PetscInt index; 3401 PetscScalar *array2; 3402 MatFactorInfo matinfo; 3403 3404 /* Allocating some extra storage just to be safe */ 3405 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 3406 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr); 3407 for (i=0;i<pcis->n;i++) auxindices[i]=i; 3408 3409 /* some work vectors on vertices and/or constraints */ 3410 if (n_vertices) { 3411 ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr); 3412 ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr); 3413 ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr); 3414 ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr); 3415 } 3416 if (n_constraints) { 3417 ierr = VecCreate(PETSC_COMM_SELF,&vec1_C);CHKERRQ(ierr); 3418 ierr = VecSetSizes(vec1_C,n_constraints,n_constraints);CHKERRQ(ierr); 3419 ierr = VecSetType(vec1_C,impVecType);CHKERRQ(ierr); 3420 ierr = VecDuplicate(vec1_C,&vec2_C);CHKERRQ(ierr); 3421 ierr = VecDuplicate(vec1_C,&pcbddc->vec1_C);CHKERRQ(ierr); 3422 } 3423 /* Precompute stuffs needed for preprocessing and application of BDDC*/ 3424 if (n_constraints) { 3425 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr); 3426 ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,n_R,n_constraints);CHKERRQ(ierr); 3427 ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr); 3428 ierr = MatSeqDenseSetPreallocation(pcbddc->local_auxmat2,NULL);CHKERRQ(ierr); 3429 3430 /* Create Constraint matrix on R nodes: C_{CR} */ 3431 ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_C_local,is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr); 3432 ierr = ISDestroy(&is_C_local);CHKERRQ(ierr); 3433 3434 /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */ 3435 for (i=0; i<n_constraints; i++) { 3436 ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); 3437 3438 /* Get row of constraint matrix in R numbering */ 3439 ierr = VecGetArray(pcbddc->vec1_R,&array);CHKERRQ(ierr); 3440 ierr = MatGetRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3441 for (j=0;j<size_of_constraint;j++) array[row_cmat_indices[j]] = -row_cmat_values[j]; 3442 ierr = MatRestoreRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3443 ierr = VecRestoreArray(pcbddc->vec1_R,&array);CHKERRQ(ierr); 3444 3445 /* Solve for row of constraint matrix in R numbering */ 3446 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 3447 3448 /* Set values */ 3449 ierr = VecGetArray(pcbddc->vec2_R,&array);CHKERRQ(ierr); 3450 ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3451 ierr = VecRestoreArray(pcbddc->vec2_R,&array);CHKERRQ(ierr); 3452 } 3453 ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3454 ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3455 3456 /* Assemble AUXMAT = (LUFactor)(-C_{CR} A_{RR}^{-1} C^T_{CR})^{-1} */ 3457 ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&AUXMAT);CHKERRQ(ierr); 3458 ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr); 3459 ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,0,1,&is_aux1);CHKERRQ(ierr); 3460 ierr = MatLUFactor(AUXMAT,is_aux1,is_aux1,&matinfo);CHKERRQ(ierr); 3461 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3462 3463 /* Assemble explicitly M1 = (C_{CR} A_{RR}^{-1} C^T_{CR})^{-1} needed in preproc */ 3464 ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr); 3465 ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr); 3466 ierr = MatSetType(M1,impMatType);CHKERRQ(ierr); 3467 ierr = MatSeqDenseSetPreallocation(M1,NULL);CHKERRQ(ierr); 3468 for (i=0; i<n_constraints; i++) { 3469 ierr = VecSet(vec1_C,zero);CHKERRQ(ierr); 3470 ierr = VecSetValue(vec1_C,i,one,INSERT_VALUES);CHKERRQ(ierr); 3471 ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr); 3472 ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr); 3473 ierr = MatSolve(AUXMAT,vec1_C,vec2_C);CHKERRQ(ierr); 3474 ierr = VecScale(vec2_C,m_one);CHKERRQ(ierr); 3475 ierr = VecGetArray(vec2_C,&array);CHKERRQ(ierr); 3476 ierr = MatSetValues(M1,n_constraints,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3477 ierr = VecRestoreArray(vec2_C,&array);CHKERRQ(ierr); 3478 } 3479 ierr = MatAssemblyBegin(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3480 ierr = MatAssemblyEnd(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3481 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3482 /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */ 3483 ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr); 3484 3485 } 3486 3487 /* Get submatrices from subdomain matrix */ 3488 if (n_vertices) { 3489 ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_V_local,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr); 3490 ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr); 3491 ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_V_local,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr); 3492 } 3493 3494 /* Matrix of coarse basis functions (local) */ 3495 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr); 3496 ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr); 3497 ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr); 3498 ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_B,NULL);CHKERRQ(ierr); 3499 if (pcbddc->inexact_prec_type || dbg_flag) { 3500 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr); 3501 ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr); 3502 ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr); 3503 ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_D,NULL);CHKERRQ(ierr); 3504 } 3505 3506 if (dbg_flag) { 3507 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&coarsefunctions_errors);CHKERRQ(ierr); 3508 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&constraints_errors);CHKERRQ(ierr); 3509 } 3510 /* Subdomain contribution (Non-overlapping) to coarse matrix */ 3511 ierr = PetscMalloc ((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr); 3512 3513 /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */ 3514 for (i=0; i<n_vertices; i++) { 3515 ierr = VecSet(vec1_V,zero);CHKERRQ(ierr); 3516 ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr); 3517 ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr); 3518 ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr); 3519 /* solution of saddle point problem */ 3520 ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr); 3521 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 3522 ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr); 3523 if (n_constraints) { 3524 ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr); 3525 ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 3526 ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr); 3527 } 3528 ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); 3529 ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr); 3530 3531 /* Set values in coarse basis function and subdomain part of coarse_mat */ 3532 /* coarse basis functions */ 3533 ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 3534 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3535 ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3536 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3537 ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3538 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3539 ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr); 3540 if (pcbddc->inexact_prec_type || dbg_flag) { 3541 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3542 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3543 ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3544 ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3545 ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3546 } 3547 /* subdomain contribution to coarse matrix */ 3548 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3549 for (j=0; j<n_vertices; j++) coarse_submat_vals[i*pcbddc->local_primal_size+j] = array[j]; /* WARNING -> column major ordering */ 3550 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3551 if (n_constraints) { 3552 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3553 for (j=0; j<n_constraints; j++) coarse_submat_vals[i*pcbddc->local_primal_size+j+n_vertices] = array[j]; /* WARNING -> column major ordering */ 3554 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3555 } 3556 3557 if (dbg_flag) { 3558 /* assemble subdomain vector on nodes */ 3559 ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr); 3560 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3561 ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3562 for (j=0;j<n_R;j++) array[idx_R_local[j]] = array2[j]; 3563 array[vertices[i]] = one; 3564 ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3565 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3566 3567 /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */ 3568 ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr); 3569 ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3570 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3571 for (j=0;j<n_vertices;j++) array2[j]=array[j]; 3572 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3573 if (n_constraints) { 3574 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3575 for (j=0;j<n_constraints;j++) array2[j+n_vertices]=array[j]; 3576 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3577 } 3578 ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3579 ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr); 3580 3581 /* check saddle point solution */ 3582 ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr); 3583 ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr); 3584 ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr); 3585 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 3586 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3587 array[i]=array[i]+m_one; /* shift by the identity matrix */ 3588 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3589 ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr); 3590 } 3591 } 3592 3593 for (i=0; i<n_constraints; i++) { 3594 ierr = VecSet(vec2_C,zero);CHKERRQ(ierr); 3595 ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr); 3596 ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr); 3597 ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr); 3598 3599 /* solution of saddle point problem */ 3600 ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr); 3601 ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr); 3602 ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr); 3603 if (n_vertices) { ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); } 3604 3605 /* Set values in coarse basis function and subdomain part of coarse_mat */ 3606 /* coarse basis functions */ 3607 index=i+n_vertices; 3608 ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 3609 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3610 ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3611 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3612 ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr); 3613 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3614 if (pcbddc->inexact_prec_type || dbg_flag) { 3615 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3616 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3617 ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3618 ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr); 3619 ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3620 } 3621 3622 /* subdomain contribution to coarse matrix */ 3623 if (n_vertices) { 3624 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3625 for (j=0; j<n_vertices; j++) coarse_submat_vals[index*pcbddc->local_primal_size+j]=array[j]; /* WARNING -> column major ordering */ 3626 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3627 } 3628 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3629 for (j=0; j<n_constraints; j++) coarse_submat_vals[index*pcbddc->local_primal_size+j+n_vertices]=array[j]; /* WARNING -> column major ordering */ 3630 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3631 3632 if (dbg_flag) { 3633 /* assemble subdomain vector on nodes */ 3634 ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr); 3635 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3636 ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3637 for (j=0;j<n_R;j++) array[idx_R_local[j]] = array2[j]; 3638 ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3639 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3640 3641 /* assemble subdomain vector of lagrange multipliers */ 3642 ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr); 3643 ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3644 if (n_vertices) { 3645 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3646 for (j=0;j<n_vertices;j++) array2[j]=-array[j]; 3647 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3648 } 3649 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3650 for (j=0;j<n_constraints;j++) {array2[j+n_vertices]=-array[j];} 3651 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3652 ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3653 3654 /* check saddle point solution */ 3655 ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr); 3656 ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr); 3657 ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[index]);CHKERRQ(ierr); 3658 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 3659 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3660 array[index] = array[index]+m_one; /* shift by the identity matrix */ 3661 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3662 ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[index]);CHKERRQ(ierr); 3663 } 3664 } 3665 ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3666 ierr = MatAssemblyEnd (pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3667 if (pcbddc->inexact_prec_type || dbg_flag) { 3668 ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3669 ierr = MatAssemblyEnd (pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3670 } 3671 /* Checking coarse_sub_mat and coarse basis functios */ 3672 /* It shuld be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */ 3673 if (dbg_flag) { 3674 Mat coarse_sub_mat; 3675 Mat TM1,TM2,TM3,TM4; 3676 Mat coarse_phi_D,coarse_phi_B,A_II,A_BB,A_IB,A_BI; 3677 MatType checkmattype=MATSEQAIJ; 3678 PetscScalar value; 3679 3680 ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr); 3681 ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr); 3682 ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr); 3683 ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr); 3684 ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr); 3685 ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr); 3686 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr); 3687 ierr = MatConvert(coarse_sub_mat,checkmattype,MAT_REUSE_MATRIX,&coarse_sub_mat);CHKERRQ(ierr); 3688 3689 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3690 ierr = PetscViewerASCIIPrintf(viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr); 3691 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3692 ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr); 3693 ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr); 3694 ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 3695 ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr); 3696 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3697 ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 3698 ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr); 3699 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3700 ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3701 ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3702 ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3703 ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3704 ierr = MatNorm(TM1,NORM_INFINITY,&value);CHKERRQ(ierr); 3705 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"----------------------------------\n");CHKERRQ(ierr); 3706 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr); 3707 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"matrix error = % 1.14e\n",value);CHKERRQ(ierr); 3708 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"coarse functions errors\n");CHKERRQ(ierr); 3709 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); } 3710 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"constraints errors\n");CHKERRQ(ierr); 3711 for (i=0; i<pcbddc->local_primal_size; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr); } 3712 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3713 ierr = MatDestroy(&A_II);CHKERRQ(ierr); 3714 ierr = MatDestroy(&A_BB);CHKERRQ(ierr); 3715 ierr = MatDestroy(&A_IB);CHKERRQ(ierr); 3716 ierr = MatDestroy(&A_BI);CHKERRQ(ierr); 3717 ierr = MatDestroy(&TM1);CHKERRQ(ierr); 3718 ierr = MatDestroy(&TM2);CHKERRQ(ierr); 3719 ierr = MatDestroy(&TM3);CHKERRQ(ierr); 3720 ierr = MatDestroy(&TM4);CHKERRQ(ierr); 3721 ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr); 3722 ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr); 3723 ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr); 3724 ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr); 3725 ierr = PetscFree(constraints_errors);CHKERRQ(ierr); 3726 } 3727 /* free memory */ 3728 if (n_vertices) { 3729 ierr = VecDestroy(&vec1_V);CHKERRQ(ierr); 3730 ierr = VecDestroy(&vec2_V);CHKERRQ(ierr); 3731 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 3732 ierr = MatDestroy(&A_VR);CHKERRQ(ierr); 3733 ierr = MatDestroy(&A_VV);CHKERRQ(ierr); 3734 } 3735 if (n_constraints) { 3736 ierr = VecDestroy(&vec1_C);CHKERRQ(ierr); 3737 ierr = VecDestroy(&vec2_C);CHKERRQ(ierr); 3738 ierr = MatDestroy(&M1);CHKERRQ(ierr); 3739 ierr = MatDestroy(&C_CR);CHKERRQ(ierr); 3740 } 3741 ierr = PetscFree(auxindices);CHKERRQ(ierr); 3742 ierr = PetscFree(nnz);CHKERRQ(ierr); 3743 /* create coarse matrix and data structures for message passing associated actual choice of coarse problem type */ 3744 ierr = PCBDDCSetupCoarseEnvironment(pc,coarse_submat_vals);CHKERRQ(ierr); 3745 ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr); 3746 } 3747 /* free memory */ 3748 if (n_vertices) { 3749 ierr = PetscFree(idx_V_B);CHKERRQ(ierr); 3750 ierr = ISDestroy(&is_V_local);CHKERRQ(ierr); 3751 } 3752 ierr = ISDestroy(&is_R_local);CHKERRQ(ierr); 3753 PetscFunctionReturn(0); 3754 } 3755 3756 /* -------------------------------------------------------------------------- */ 3757 3758 #undef __FUNCT__ 3759 #define __FUNCT__ "PCBDDCSetupCoarseEnvironment" 3760 static PetscErrorCode PCBDDCSetupCoarseEnvironment(PC pc,PetscScalar* coarse_submat_vals) 3761 { 3762 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 3763 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3764 PC_IS *pcis = (PC_IS*)pc->data; 3765 MPI_Comm prec_comm = ((PetscObject)pc)->comm; 3766 MPI_Comm coarse_comm; 3767 3768 /* common to all choiches */ 3769 PetscScalar *temp_coarse_mat_vals; 3770 PetscScalar *ins_coarse_mat_vals; 3771 PetscInt *ins_local_primal_indices; 3772 PetscMPIInt *localsizes2,*localdispl2; 3773 PetscMPIInt size_prec_comm; 3774 PetscMPIInt rank_prec_comm; 3775 PetscMPIInt active_rank=MPI_PROC_NULL; 3776 PetscMPIInt master_proc=0; 3777 PetscInt ins_local_primal_size; 3778 3779 /* specific to MULTILEVEL_BDDC */ 3780 PetscMPIInt *ranks_recv; 3781 PetscMPIInt count_recv=0; 3782 PetscMPIInt rank_coarse_proc_send_to; 3783 PetscMPIInt coarse_color = MPI_UNDEFINED; 3784 ISLocalToGlobalMapping coarse_ISLG; 3785 3786 /* some other variables */ 3787 PetscErrorCode ierr; 3788 MatType coarse_mat_type; 3789 PCType coarse_pc_type; 3790 KSPType coarse_ksp_type; 3791 PC pc_temp; 3792 PetscInt i,j,k; 3793 PetscInt max_it_coarse_ksp=1; /* don't increase this value */ 3794 3795 /* verbose output viewer */ 3796 PetscViewer viewer = pcbddc->dbg_viewer; 3797 PetscBool dbg_flag = pcbddc->dbg_flag; 3798 3799 PetscInt offset,offset2; 3800 PetscMPIInt im_active,active_procs; 3801 PetscInt *dnz,*onz; 3802 3803 PetscBool setsym,issym=PETSC_FALSE; 3804 3805 PetscFunctionBegin; 3806 ins_local_primal_indices = 0; 3807 ins_coarse_mat_vals = 0; 3808 localsizes2 = 0; 3809 localdispl2 = 0; 3810 temp_coarse_mat_vals = 0; 3811 coarse_ISLG = 0; 3812 3813 ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr); 3814 ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr); 3815 ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr); 3816 3817 /* Assign global numbering to coarse dofs */ 3818 { 3819 PetscInt *auxlocal_primal; 3820 PetscInt *row_cmat_indices; 3821 PetscInt *aux_ordering; 3822 PetscInt *row_cmat_global_indices; 3823 PetscInt *dof_sizes,*dof_displs; 3824 PetscInt size_of_constraint; 3825 PetscBool *array_bool; 3826 PetscBool first_found; 3827 PetscInt first_index,old_index,s; 3828 PetscMPIInt mpi_local_primal_size; 3829 PetscScalar coarsesum,*array; 3830 3831 mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size; 3832 3833 /* Construct needed data structures for message passing */ 3834 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&pcbddc->local_primal_indices);CHKERRQ(ierr); 3835 j = 0; 3836 if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3837 j = size_prec_comm; 3838 } 3839 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr); 3840 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr); 3841 /* Gather local_primal_size information for all processes */ 3842 if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3843 ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr); 3844 } else { 3845 ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3846 } 3847 pcbddc->replicated_primal_size = 0; 3848 for (i=0; i<j; i++) { 3849 pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size; 3850 pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i]; 3851 } 3852 3853 /* First let's count coarse dofs. 3854 This code fragment assumes that the number of local constraints per connected component 3855 is not greater than the number of nodes defined for the connected component 3856 (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */ 3857 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr); 3858 j = 0; 3859 for (i=0; i<pcbddc->local_primal_size; i++) { 3860 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr); 3861 if (j < size_of_constraint) j = size_of_constraint; 3862 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr); 3863 } 3864 ierr = PetscMalloc(j*sizeof(PetscInt),&aux_ordering);CHKERRQ(ierr); 3865 ierr = PetscMalloc(j*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr); 3866 ierr = PetscMalloc(pcis->n*sizeof(PetscBool),&array_bool);CHKERRQ(ierr); 3867 for (i=0;i<pcis->n;i++) array_bool[i] = PETSC_FALSE; 3868 3869 for (i=0;i<pcbddc->local_primal_size;i++) { 3870 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 3871 for (j=0; j<size_of_constraint; j++) aux_ordering[j] = j; 3872 3873 ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr); 3874 ierr = PetscSortIntWithPermutation(size_of_constraint,row_cmat_global_indices,aux_ordering);CHKERRQ(ierr); 3875 for (j=0; j<size_of_constraint; j++) { 3876 k = row_cmat_indices[aux_ordering[j]]; 3877 if (!array_bool[k]) { 3878 array_bool[k] = PETSC_TRUE; 3879 auxlocal_primal[i] = k; 3880 break; 3881 } 3882 } 3883 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 3884 } 3885 ierr = PetscFree(aux_ordering);CHKERRQ(ierr); 3886 ierr = PetscFree(array_bool);CHKERRQ(ierr); 3887 ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr); 3888 3889 /* Compute number of coarse dofs */ 3890 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 3891 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3892 for (i=0;i<pcbddc->local_primal_size;i++) array[auxlocal_primal[i]] = 1.0; 3893 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3894 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 3895 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3896 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3897 ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr); 3898 pcbddc->coarse_size = (PetscInt)coarsesum; 3899 3900 /* Fill pcis->vec1_global with cumulative function for global numbering */ 3901 ierr = VecGetArray(pcis->vec1_global,&array);CHKERRQ(ierr); 3902 ierr = VecGetLocalSize(pcis->vec1_global,&s);CHKERRQ(ierr); 3903 k = 0; 3904 first_index = -1; 3905 first_found = PETSC_FALSE; 3906 for (i=0; i<s; i++) { 3907 if (!first_found && array[i] > 0.0) { 3908 first_found = PETSC_TRUE; 3909 first_index = i; 3910 } 3911 k += (PetscInt)array[i]; 3912 } 3913 j = (!rank_prec_comm ? size_prec_comm : 0); 3914 ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr); 3915 ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr); 3916 ierr = MPI_Gather(&k,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3917 if (!rank_prec_comm) { 3918 dof_displs[0]=0; 3919 for (i=1;i<size_prec_comm;i++) dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1]; 3920 } 3921 ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&k,1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3922 if (first_found) { 3923 array[first_index] += k; 3924 old_index = first_index; 3925 for (i=first_index+1;i<s;i++) { 3926 if (array[i] > 0.0) { 3927 array[i] += array[old_index]; 3928 old_index = i; 3929 } 3930 } 3931 } 3932 ierr = VecRestoreArray(pcis->vec1_global,&array);CHKERRQ(ierr); 3933 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 3934 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3935 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3936 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3937 for (i=0;i<pcbddc->local_primal_size;i++) pcbddc->local_primal_indices[i] = (PetscInt)array[auxlocal_primal[i]]-1; 3938 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3939 ierr = PetscFree(dof_displs);CHKERRQ(ierr); 3940 ierr = PetscFree(dof_sizes);CHKERRQ(ierr); 3941 3942 if (dbg_flag) { 3943 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3944 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3945 ierr = PetscViewerASCIIPrintf(viewer,"Check coarse indices\n");CHKERRQ(ierr); 3946 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 3947 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3948 for (i=0;i<pcbddc->local_primal_size;i++) array[auxlocal_primal[i]]=1.0; 3949 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3950 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 3951 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3952 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3953 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3954 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3955 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3956 for (i=0;i<pcis->n;i++) { 3957 if (array[i] == 1.0) { 3958 ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&j);CHKERRQ(ierr); 3959 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d: WRONG COARSE INDEX %d (local %d)\n",PetscGlobalRank,j,i);CHKERRQ(ierr); 3960 } 3961 } 3962 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3963 for (i=0;i<pcis->n;i++) { 3964 if (array[i] > 0.0) array[i] = 1.0/array[i]; 3965 } 3966 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3967 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 3968 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3969 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3970 ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr); 3971 ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem SHOULD be %lf\n",coarsesum);CHKERRQ(ierr); 3972 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3973 } 3974 ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr); 3975 } 3976 3977 if (dbg_flag) { 3978 ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem is %d\n",pcbddc->coarse_size);CHKERRQ(ierr); 3979 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3980 } 3981 3982 im_active = 0; 3983 if (pcis->n) im_active = 1; 3984 ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr); 3985 3986 /* adapt coarse problem type */ 3987 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3988 if (pcbddc->current_level < pcbddc->max_levels) { 3989 if ((active_procs/pcbddc->coarsening_ratio) < 2) { 3990 if (dbg_flag) { 3991 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); 3992 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3993 } 3994 pcbddc->coarse_problem_type = PARALLEL_BDDC; 3995 } 3996 } else { 3997 if (dbg_flag) { 3998 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); 3999 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 4000 } 4001 pcbddc->coarse_problem_type = PARALLEL_BDDC; 4002 } 4003 } 4004 4005 switch (pcbddc->coarse_problem_type) { 4006 4007 case (MULTILEVEL_BDDC): /* we define a coarse mesh where subdomains are elements */ 4008 { 4009 /* we need additional variables */ 4010 MetisInt n_subdomains,n_parts,objval,ncon,faces_nvtxs; 4011 MetisInt *metis_coarse_subdivision; 4012 MetisInt options[METIS_NOPTIONS]; 4013 PetscMPIInt size_coarse_comm,rank_coarse_comm; 4014 PetscMPIInt procs_jumps_coarse_comm; 4015 PetscMPIInt *coarse_subdivision; 4016 PetscMPIInt *total_count_recv; 4017 PetscMPIInt *total_ranks_recv; 4018 PetscMPIInt *displacements_recv; 4019 PetscMPIInt *my_faces_connectivity; 4020 PetscMPIInt *petsc_faces_adjncy; 4021 MetisInt *faces_adjncy; 4022 MetisInt *faces_xadj; 4023 PetscMPIInt *number_of_faces; 4024 PetscMPIInt *faces_displacements; 4025 PetscInt *array_int; 4026 PetscMPIInt my_faces =0; 4027 PetscMPIInt total_faces=0; 4028 PetscInt ranks_stretching_ratio; 4029 4030 /* define some quantities */ 4031 pcbddc->coarse_communications_type = SCATTERS_BDDC; 4032 coarse_mat_type = MATIS; 4033 coarse_pc_type = PCBDDC; 4034 coarse_ksp_type = KSPRICHARDSON; 4035 4036 /* details of coarse decomposition */ 4037 n_subdomains = active_procs; 4038 n_parts = n_subdomains/pcbddc->coarsening_ratio; 4039 ranks_stretching_ratio = size_prec_comm/active_procs; 4040 procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio; 4041 4042 #if 0 4043 PetscMPIInt *old_ranks; 4044 PetscInt *new_ranks,*jj,*ii; 4045 MatPartitioning mat_part; 4046 IS coarse_new_decomposition,is_numbering; 4047 PetscViewer viewer_test; 4048 MPI_Comm test_coarse_comm; 4049 PetscMPIInt test_coarse_color; 4050 Mat mat_adj; 4051 /* Create new communicator for coarse problem splitting the old one */ 4052 /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards) 4053 key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */ 4054 test_coarse_color = (im_active ? 0 : MPI_UNDEFINED); 4055 test_coarse_comm = MPI_COMM_NULL; 4056 ierr = MPI_Comm_split(prec_comm,test_coarse_color,rank_prec_comm,&test_coarse_comm);CHKERRQ(ierr); 4057 if (im_active) { 4058 ierr = PetscMalloc(n_subdomains*sizeof(PetscMPIInt),&old_ranks); 4059 ierr = PetscMalloc(size_prec_comm*sizeof(PetscInt),&new_ranks); 4060 ierr = MPI_Comm_rank(test_coarse_comm,&rank_coarse_comm);CHKERRQ(ierr); 4061 ierr = MPI_Comm_size(test_coarse_comm,&j);CHKERRQ(ierr); 4062 ierr = MPI_Allgather(&rank_prec_comm,1,MPIU_INT,old_ranks,1,MPIU_INT,test_coarse_comm);CHKERRQ(ierr); 4063 for (i=0; i<size_prec_comm; i++) 4064 new_ranks[i] = -1; 4065 for (i=0; i<n_subdomains; i++) 4066 new_ranks[old_ranks[i]] = i; 4067 ierr = PetscViewerASCIIOpen(test_coarse_comm,"test_mat_part.out",&viewer_test);CHKERRQ(ierr); 4068 k = pcis->n_neigh-1; 4069 ierr = PetscMalloc(2*sizeof(PetscInt),&ii); 4070 ii[0]=0; 4071 ii[1]=k; 4072 ierr = PetscMalloc(k*sizeof(PetscInt),&jj); 4073 for (i=0; i<k; i++) 4074 jj[i]=new_ranks[pcis->neigh[i+1]]; 4075 ierr = PetscSortInt(k,jj);CHKERRQ(ierr); 4076 ierr = MatCreateMPIAdj(test_coarse_comm,1,n_subdomains,ii,jj,NULL,&mat_adj);CHKERRQ(ierr); 4077 ierr = MatView(mat_adj,viewer_test);CHKERRQ(ierr); 4078 ierr = MatPartitioningCreate(test_coarse_comm,&mat_part);CHKERRQ(ierr); 4079 ierr = MatPartitioningSetAdjacency(mat_part,mat_adj);CHKERRQ(ierr); 4080 ierr = MatPartitioningSetFromOptions(mat_part);CHKERRQ(ierr); 4081 printf("Setting Nparts %d\n",n_parts); 4082 ierr = MatPartitioningSetNParts(mat_part,n_parts);CHKERRQ(ierr); 4083 ierr = MatPartitioningView(mat_part,viewer_test);CHKERRQ(ierr); 4084 ierr = MatPartitioningApply(mat_part,&coarse_new_decomposition);CHKERRQ(ierr); 4085 ierr = ISView(coarse_new_decomposition,viewer_test);CHKERRQ(ierr); 4086 ierr = ISPartitioningToNumbering(coarse_new_decomposition,&is_numbering);CHKERRQ(ierr); 4087 ierr = ISView(is_numbering,viewer_test);CHKERRQ(ierr); 4088 ierr = PetscViewerDestroy(&viewer_test);CHKERRQ(ierr); 4089 ierr = ISDestroy(&coarse_new_decomposition);CHKERRQ(ierr); 4090 ierr = ISDestroy(&is_numbering);CHKERRQ(ierr); 4091 ierr = MatPartitioningDestroy(&mat_part);CHKERRQ(ierr); 4092 ierr = PetscFree(old_ranks);CHKERRQ(ierr); 4093 ierr = PetscFree(new_ranks);CHKERRQ(ierr); 4094 ierr = MPI_Comm_free(&test_coarse_comm);CHKERRQ(ierr); 4095 } 4096 #endif 4097 4098 /* build CSR graph of subdomains' connectivity */ 4099 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr); 4100 ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr); 4101 for (i=1;i<pcis->n_neigh;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */ 4102 for (j=0;j<pcis->n_shared[i];j++) { 4103 array_int[pcis->shared[i][j]]+=1; 4104 } 4105 } 4106 for (i=1;i<pcis->n_neigh;i++) { 4107 for (j=0;j<pcis->n_shared[i];j++) { 4108 if (array_int[pcis->shared[i][j]] > 0) { 4109 my_faces++; 4110 break; 4111 } 4112 } 4113 } 4114 4115 ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr); 4116 ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr); 4117 my_faces=0; 4118 for (i=1;i<pcis->n_neigh;i++) { 4119 for (j=0;j<pcis->n_shared[i];j++) { 4120 if (array_int[pcis->shared[i][j]] > 0) { 4121 my_faces_connectivity[my_faces]=pcis->neigh[i]; 4122 my_faces++; 4123 break; 4124 } 4125 } 4126 } 4127 if (rank_prec_comm == master_proc) { 4128 ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr); 4129 ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr); 4130 ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr); 4131 ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr); 4132 ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr); 4133 } 4134 ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr); 4135 if (rank_prec_comm == master_proc) { 4136 faces_xadj[0] = 0; 4137 faces_displacements[0] = 0; 4138 4139 j=0; 4140 for (i=1;i<size_prec_comm+1;i++) { 4141 faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1]; 4142 if (number_of_faces[i-1]) { 4143 j++; 4144 faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1]; 4145 } 4146 } 4147 } 4148 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); 4149 ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr); 4150 ierr = PetscFree(array_int);CHKERRQ(ierr); 4151 if (rank_prec_comm == master_proc) { 4152 for (i=0; i<total_faces; i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */ 4153 ierr = PetscFree(faces_displacements);CHKERRQ(ierr); 4154 ierr = PetscFree(number_of_faces);CHKERRQ(ierr); 4155 ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr); 4156 } 4157 4158 if (rank_prec_comm == master_proc) { 4159 PetscInt heuristic_for_metis=3; 4160 ncon =1; 4161 faces_nvtxs=n_subdomains; 4162 /* partition graoh induced by face connectivity */ 4163 ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr); 4164 ierr = METIS_SetDefaultOptions(options); 4165 /* we need a contiguous partition of the coarse mesh */ 4166 options[METIS_OPTION_CONTIG]=1; 4167 options[METIS_OPTION_NITER] =30; 4168 if (pcbddc->coarsening_ratio > 1) { 4169 if (n_subdomains>n_parts*heuristic_for_metis) { 4170 options[METIS_OPTION_IPTYPE] =METIS_IPTYPE_EDGE; 4171 options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT; 4172 4173 ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision); 4174 if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphKway (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr); 4175 } else { 4176 ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision); 4177 if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphRecursive (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr); 4178 } 4179 } else { 4180 for (i=0;i<n_subdomains;i++) metis_coarse_subdivision[i]=i; 4181 } 4182 ierr = PetscFree(faces_xadj);CHKERRQ(ierr); 4183 ierr = PetscFree(faces_adjncy);CHKERRQ(ierr); 4184 ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr); 4185 4186 /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */ 4187 for (i=0;i<size_prec_comm;i++) coarse_subdivision[i]=MPI_PROC_NULL; 4188 for (i=0;i<n_subdomains;i++) coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]); 4189 ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr); 4190 } 4191 4192 /* Create new communicator for coarse problem splitting the old one */ 4193 if (!(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts) { 4194 coarse_color=0; /* for communicator splitting */ 4195 active_rank =rank_prec_comm; /* for insertion of matrix values */ 4196 } 4197 /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards) 4198 key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */ 4199 ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr); 4200 4201 if (coarse_color == 0) { 4202 ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr); 4203 ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr); 4204 } else { 4205 rank_coarse_comm = MPI_PROC_NULL; 4206 } 4207 4208 /* master proc take care of arranging and distributing coarse information */ 4209 if (rank_coarse_comm == master_proc) { 4210 ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr); 4211 ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr); 4212 ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr); 4213 /* some initializations */ 4214 displacements_recv[0]=0; 4215 ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr); 4216 /* count from how many processes the j-th process of the coarse decomposition will receive data */ 4217 for (j=0; j<size_coarse_comm; j++) { 4218 for (i=0; i<size_prec_comm; i++) { 4219 if (coarse_subdivision[i]==j) total_count_recv[j]++; 4220 } 4221 } 4222 /* displacements needed for scatterv of total_ranks_recv */ 4223 for (i=1; i<size_coarse_comm; i++) displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1]; 4224 4225 /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */ 4226 ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr); 4227 for (j=0; j<size_coarse_comm; j++) { 4228 for (i=0; i<size_prec_comm; i++) { 4229 if (coarse_subdivision[i]==j) { 4230 total_ranks_recv[displacements_recv[j]+total_count_recv[j]] = i; 4231 4232 total_count_recv[j] += 1; 4233 } 4234 } 4235 } 4236 /* for (j=0;j<size_coarse_comm;j++) { 4237 printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]); 4238 for (i=0;i<total_count_recv[j];i++) { 4239 printf("%d ",total_ranks_recv[displacements_recv[j]+i]); 4240 } 4241 printf("\n"); 4242 } */ 4243 4244 /* identify new decomposition in terms of ranks in the old communicator */ 4245 for (i=0; i<n_subdomains; i++) { 4246 coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm; 4247 } 4248 /* printf("coarse_subdivision in old end new ranks\n"); 4249 for (i=0;i<size_prec_comm;i++) { 4250 if (coarse_subdivision[i]!=MPI_PROC_NULL) { 4251 printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm); 4252 } else { 4253 printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]); 4254 } 4255 } 4256 printf("\n"); */ 4257 } 4258 4259 /* Scatter new decomposition for send details */ 4260 ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr); 4261 /* Scatter receiving details to members of coarse decomposition */ 4262 if (coarse_color == 0) { 4263 ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr); 4264 ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr); 4265 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); 4266 } 4267 4268 /* printf("I will send my matrix data to proc %d\n",rank_coarse_proc_send_to); 4269 if (coarse_color == 0) { 4270 printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv); 4271 for (i=0;i<count_recv;i++) 4272 printf("%d ",ranks_recv[i]); 4273 printf("\n"); 4274 } */ 4275 4276 if (rank_prec_comm == master_proc) { 4277 ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr); 4278 ierr = PetscFree(total_count_recv);CHKERRQ(ierr); 4279 ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr); 4280 ierr = PetscFree(displacements_recv);CHKERRQ(ierr); 4281 } 4282 break; 4283 } 4284 4285 case (REPLICATED_BDDC): 4286 4287 pcbddc->coarse_communications_type = GATHERS_BDDC; 4288 coarse_mat_type = MATSEQAIJ; 4289 coarse_pc_type = PCLU; 4290 coarse_ksp_type = KSPPREONLY; 4291 coarse_comm = PETSC_COMM_SELF; 4292 active_rank = rank_prec_comm; 4293 break; 4294 4295 case (PARALLEL_BDDC): 4296 4297 pcbddc->coarse_communications_type = SCATTERS_BDDC; 4298 coarse_mat_type = MATMPIAIJ; 4299 coarse_pc_type = PCREDUNDANT; 4300 coarse_ksp_type = KSPPREONLY; 4301 coarse_comm = prec_comm; 4302 active_rank = rank_prec_comm; 4303 break; 4304 4305 case (SEQUENTIAL_BDDC): 4306 pcbddc->coarse_communications_type = GATHERS_BDDC; 4307 coarse_mat_type = MATSEQAIJ; 4308 coarse_pc_type = PCLU; 4309 coarse_ksp_type = KSPPREONLY; 4310 coarse_comm = PETSC_COMM_SELF; 4311 active_rank = master_proc; 4312 break; 4313 } 4314 4315 switch (pcbddc->coarse_communications_type) { 4316 4317 case(SCATTERS_BDDC): 4318 { 4319 if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) { 4320 4321 IS coarse_IS; 4322 4323 if (pcbddc->coarsening_ratio == 1) { 4324 ins_local_primal_size = pcbddc->local_primal_size; 4325 ins_local_primal_indices = pcbddc->local_primal_indices; 4326 if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); } 4327 /* nonzeros */ 4328 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr); 4329 ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr); 4330 for (i=0;i<ins_local_primal_size;i++) { 4331 dnz[i] = ins_local_primal_size; 4332 } 4333 } else { 4334 PetscMPIInt send_size; 4335 PetscMPIInt *send_buffer; 4336 PetscInt *aux_ins_indices; 4337 PetscInt ii,jj; 4338 MPI_Request *requests; 4339 4340 ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr); 4341 /* reusing pcbddc->local_primal_displacements and pcbddc->replicated_primal_size */ 4342 ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr); 4343 ierr = PetscMalloc((count_recv+1)*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr); 4344 pcbddc->replicated_primal_size = count_recv; 4345 j = 0; 4346 for (i=0;i<count_recv;i++) { 4347 pcbddc->local_primal_displacements[i] = j; 4348 j += pcbddc->local_primal_sizes[ranks_recv[i]]; 4349 } 4350 pcbddc->local_primal_displacements[count_recv] = j; 4351 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 4352 /* allocate auxiliary space */ 4353 ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr); 4354 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr); 4355 ierr = PetscMemzero(aux_ins_indices,pcbddc->coarse_size*sizeof(PetscInt));CHKERRQ(ierr); 4356 /* allocate stuffs for message massing */ 4357 ierr = PetscMalloc((count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr); 4358 for (i=0;i<count_recv+1;i++) { requests[i]=MPI_REQUEST_NULL; } 4359 /* send indices to be inserted */ 4360 for (i=0;i<count_recv;i++) { 4361 send_size = pcbddc->local_primal_sizes[ranks_recv[i]]; 4362 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); 4363 } 4364 if (rank_coarse_proc_send_to != MPI_PROC_NULL) { 4365 send_size = pcbddc->local_primal_size; 4366 ierr = PetscMalloc(send_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr); 4367 for (i=0;i<send_size;i++) { 4368 send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i]; 4369 } 4370 ierr = MPI_Isend(send_buffer,send_size,MPIU_INT,rank_coarse_proc_send_to,999,prec_comm,&requests[count_recv]);CHKERRQ(ierr); 4371 } 4372 ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4373 if (rank_coarse_proc_send_to != MPI_PROC_NULL) { 4374 ierr = PetscFree(send_buffer);CHKERRQ(ierr); 4375 } 4376 j = 0; 4377 for (i=0;i<count_recv;i++) { 4378 ii = pcbddc->local_primal_displacements[i+1]-pcbddc->local_primal_displacements[i]; 4379 localsizes2[i] = ii*ii; 4380 localdispl2[i] = j; 4381 j += localsizes2[i]; 4382 jj = pcbddc->local_primal_displacements[i]; 4383 /* it counts the coarse subdomains sharing the coarse node */ 4384 for (k=0;k<ii;k++) { 4385 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]] += 1; 4386 } 4387 } 4388 /* temp_coarse_mat_vals used to store matrix values to be received */ 4389 ierr = PetscMalloc(j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr); 4390 /* evaluate how many values I will insert in coarse mat */ 4391 ins_local_primal_size = 0; 4392 for (i=0;i<pcbddc->coarse_size;i++) { 4393 if (aux_ins_indices[i]) { 4394 ins_local_primal_size++; 4395 } 4396 } 4397 /* evaluate indices I will insert in coarse mat */ 4398 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4399 j = 0; 4400 for (i=0;i<pcbddc->coarse_size;i++) { 4401 if (aux_ins_indices[i]) { 4402 ins_local_primal_indices[j] = i; 4403 j++; 4404 } 4405 } 4406 /* processes partecipating in coarse problem receive matrix data from their friends */ 4407 for (i=0;i<count_recv;i++) { 4408 ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr); 4409 } 4410 if (rank_coarse_proc_send_to != MPI_PROC_NULL) { 4411 send_size = pcbddc->local_primal_size*pcbddc->local_primal_size; 4412 ierr = MPI_Isend(&coarse_submat_vals[0],send_size,MPIU_SCALAR,rank_coarse_proc_send_to,666,prec_comm,&requests[count_recv]);CHKERRQ(ierr); 4413 } 4414 ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4415 /* nonzeros */ 4416 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr); 4417 ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr); 4418 /* use aux_ins_indices to realize a global to local mapping */ 4419 j=0; 4420 for (i=0;i<pcbddc->coarse_size;i++) { 4421 if (aux_ins_indices[i]==0) { 4422 aux_ins_indices[i]=-1; 4423 } else { 4424 aux_ins_indices[i]=j; 4425 j++; 4426 } 4427 } 4428 for (i=0;i<count_recv;i++) { 4429 j = pcbddc->local_primal_sizes[ranks_recv[i]]; 4430 for (k=0;k<j;k++) { 4431 dnz[aux_ins_indices[pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]+k]]] += j; 4432 } 4433 } 4434 /* check */ 4435 for (i=0;i<ins_local_primal_size;i++) { 4436 if (dnz[i] > ins_local_primal_size) { 4437 dnz[i] = ins_local_primal_size; 4438 } 4439 } 4440 ierr = PetscFree(requests);CHKERRQ(ierr); 4441 ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr); 4442 if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); } 4443 } 4444 /* create local to global mapping needed by coarse MATIS */ 4445 if (coarse_comm != MPI_COMM_NULL) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);} 4446 coarse_comm = prec_comm; 4447 active_rank = rank_prec_comm; 4448 ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr); 4449 ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr); 4450 ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr); 4451 } else if (pcbddc->coarse_problem_type==PARALLEL_BDDC) { 4452 /* arrays for values insertion */ 4453 ins_local_primal_size = pcbddc->local_primal_size; 4454 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4455 ierr = PetscMalloc(ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr); 4456 for (j=0;j<ins_local_primal_size;j++) { 4457 ins_local_primal_indices[j]=pcbddc->local_primal_indices[j]; 4458 for (i=0;i<ins_local_primal_size;i++) { 4459 ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i]; 4460 } 4461 } 4462 } 4463 break; 4464 } 4465 4466 case (GATHERS_BDDC): 4467 { 4468 PetscMPIInt mysize,mysize2; 4469 PetscMPIInt *send_buffer; 4470 4471 if (rank_prec_comm==active_rank) { 4472 ierr = PetscMalloc (pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 4473 ierr = PetscMalloc (pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr); 4474 ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr); 4475 ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr); 4476 /* arrays for values insertion */ 4477 for (i=0;i<size_prec_comm;i++) localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i]; 4478 localdispl2[0]=0; 4479 for (i=1;i<size_prec_comm;i++) localdispl2[i]=localsizes2[i-1]+localdispl2[i-1]; 4480 j = 0; 4481 for (i=0;i<size_prec_comm;i++) j+=localsizes2[i]; 4482 ierr = PetscMalloc (j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr); 4483 } 4484 4485 mysize =pcbddc->local_primal_size; 4486 mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size; 4487 ierr = PetscMalloc(mysize*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr); 4488 for (i=0; i<mysize; i++) send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i]; 4489 4490 if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC) { 4491 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); 4492 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); 4493 } else { 4494 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); 4495 ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr); 4496 } 4497 ierr = PetscFree(send_buffer);CHKERRQ(ierr); 4498 break; 4499 }/* switch on coarse problem and communications associated with finished */ 4500 } 4501 4502 /* Now create and fill up coarse matrix */ 4503 if (rank_prec_comm == active_rank) { 4504 4505 Mat matis_coarse_local_mat; 4506 4507 if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) { 4508 ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr); 4509 ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size);CHKERRQ(ierr); 4510 ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr); 4511 ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr); 4512 ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */ 4513 ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); 4514 } else { 4515 ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr); 4516 ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr); 4517 ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr); 4518 ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr); 4519 ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */ 4520 ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); 4521 } 4522 /* preallocation */ 4523 if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) { 4524 4525 PetscInt lrows,lcols; 4526 4527 ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr); 4528 ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr); 4529 4530 if (pcbddc->coarse_problem_type == PARALLEL_BDDC) { 4531 4532 Vec vec_dnz,vec_onz; 4533 PetscScalar *my_dnz,*my_onz,*array; 4534 PetscInt *mat_ranges,*row_ownership; 4535 PetscInt coarse_index_row,coarse_index_col,owner; 4536 4537 ierr = VecCreate(prec_comm,&vec_dnz);CHKERRQ(ierr); 4538 ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,pcbddc->coarse_size);CHKERRQ(ierr); 4539 ierr = VecSetType(vec_dnz,VECMPI);CHKERRQ(ierr); 4540 ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr); 4541 4542 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_dnz);CHKERRQ(ierr); 4543 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_onz);CHKERRQ(ierr); 4544 ierr = PetscMemzero(my_dnz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr); 4545 ierr = PetscMemzero(my_onz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr); 4546 4547 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&row_ownership);CHKERRQ(ierr); 4548 ierr = MatGetOwnershipRanges(pcbddc->coarse_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr); 4549 for (i=0; i<size_prec_comm; i++) { 4550 for (j=mat_ranges[i]; j<mat_ranges[i+1]; j++) { 4551 row_ownership[j]=i; 4552 } 4553 } 4554 4555 for (i=0; i<pcbddc->local_primal_size; i++) { 4556 coarse_index_row = pcbddc->local_primal_indices[i]; 4557 owner = row_ownership[coarse_index_row]; 4558 for (j=i; j<pcbddc->local_primal_size; j++) { 4559 owner = row_ownership[coarse_index_row]; 4560 coarse_index_col = pcbddc->local_primal_indices[j]; 4561 if (coarse_index_col > mat_ranges[owner]-1 && coarse_index_col < mat_ranges[owner+1]) { 4562 my_dnz[i] += 1.0; 4563 } else { 4564 my_onz[i] += 1.0; 4565 } 4566 if (i != j) { 4567 owner = row_ownership[coarse_index_col]; 4568 if (coarse_index_row > mat_ranges[owner]-1 && coarse_index_row < mat_ranges[owner+1]) { 4569 my_dnz[j] += 1.0; 4570 } else { 4571 my_onz[j] += 1.0; 4572 } 4573 } 4574 } 4575 } 4576 ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr); 4577 ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr); 4578 if (pcbddc->local_primal_size) { 4579 ierr = VecSetValues(vec_dnz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr); 4580 ierr = VecSetValues(vec_onz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_onz,ADD_VALUES);CHKERRQ(ierr); 4581 } 4582 ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr); 4583 ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr); 4584 ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr); 4585 ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr); 4586 j = mat_ranges[rank_prec_comm+1]-mat_ranges[rank_prec_comm]; 4587 ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr); 4588 for (i=0; i<j; i++) dnz[i] = (PetscInt)array[i]; 4589 4590 ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr); 4591 ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr); 4592 for (i=0;i<j;i++) onz[i] = (PetscInt)array[i]; 4593 4594 ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr); 4595 ierr = PetscFree(my_dnz);CHKERRQ(ierr); 4596 ierr = PetscFree(my_onz);CHKERRQ(ierr); 4597 ierr = PetscFree(row_ownership);CHKERRQ(ierr); 4598 ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr); 4599 ierr = VecDestroy(&vec_onz);CHKERRQ(ierr); 4600 } else { 4601 for (k=0;k<size_prec_comm;k++) { 4602 offset=pcbddc->local_primal_displacements[k]; 4603 offset2=localdispl2[k]; 4604 ins_local_primal_size = pcbddc->local_primal_sizes[k]; 4605 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4606 for (j=0;j<ins_local_primal_size;j++) { 4607 ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j]; 4608 } 4609 for (j=0;j<ins_local_primal_size;j++) { 4610 ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr); 4611 } 4612 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4613 } 4614 } 4615 4616 /* check */ 4617 for (i=0;i<lrows;i++) { 4618 if (dnz[i]>lcols) dnz[i]=lcols; 4619 if (onz[i]>pcbddc->coarse_size-lcols) onz[i]=pcbddc->coarse_size-lcols; 4620 } 4621 ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,0,dnz);CHKERRQ(ierr); 4622 ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,0,dnz,0,onz);CHKERRQ(ierr); 4623 ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr); 4624 } else { 4625 ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,0,dnz);CHKERRQ(ierr); 4626 ierr = PetscFree(dnz);CHKERRQ(ierr); 4627 } 4628 4629 /* insert values */ 4630 if (pcbddc->coarse_problem_type == PARALLEL_BDDC) { 4631 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); 4632 } else if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4633 if (pcbddc->coarsening_ratio == 1) { 4634 ins_coarse_mat_vals = coarse_submat_vals; 4635 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); 4636 } else { 4637 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4638 for (k=0; k<pcbddc->replicated_primal_size; k++) { 4639 offset = pcbddc->local_primal_displacements[k]; 4640 offset2 = localdispl2[k]; 4641 ins_local_primal_size = pcbddc->local_primal_displacements[k+1]-pcbddc->local_primal_displacements[k]; 4642 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4643 for (j=0; j<ins_local_primal_size; j++) { 4644 ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j]; 4645 } 4646 ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2]; 4647 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); 4648 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4649 } 4650 } 4651 ins_local_primal_indices = 0; 4652 ins_coarse_mat_vals = 0; 4653 } else { 4654 for (k=0; k<size_prec_comm; k++) { 4655 offset =pcbddc->local_primal_displacements[k]; 4656 offset2 =localdispl2[k]; 4657 ins_local_primal_size = pcbddc->local_primal_sizes[k]; 4658 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4659 for (j=0; j<ins_local_primal_size; j++) { 4660 ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j]; 4661 } 4662 ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2]; 4663 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); 4664 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4665 } 4666 ins_local_primal_indices = 0; 4667 ins_coarse_mat_vals = 0; 4668 } 4669 ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 4670 ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 4671 /* symmetry of coarse matrix */ 4672 if (issym) { 4673 ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr); 4674 } 4675 ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr); 4676 } 4677 4678 /* create loc to glob scatters if needed */ 4679 if (pcbddc->coarse_communications_type == SCATTERS_BDDC) { 4680 IS local_IS,global_IS; 4681 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr); 4682 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr); 4683 ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 4684 ierr = ISDestroy(&local_IS);CHKERRQ(ierr); 4685 ierr = ISDestroy(&global_IS);CHKERRQ(ierr); 4686 } 4687 4688 /* free memory no longer needed */ 4689 if (coarse_ISLG) { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); } 4690 if (ins_local_primal_indices) { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); } 4691 if (ins_coarse_mat_vals) { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr); } 4692 if (localsizes2) { ierr = PetscFree(localsizes2);CHKERRQ(ierr); } 4693 if (localdispl2) { ierr = PetscFree(localdispl2);CHKERRQ(ierr); } 4694 if (temp_coarse_mat_vals) { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr); } 4695 4696 /* Eval coarse null space */ 4697 if (pcbddc->NullSpace) { 4698 const Vec *nsp_vecs; 4699 PetscInt nsp_size,coarse_nsp_size; 4700 PetscBool nsp_has_cnst; 4701 PetscReal test_null; 4702 Vec *coarse_nsp_vecs; 4703 4704 coarse_nsp_size = 0; 4705 coarse_nsp_vecs = 0; 4706 ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr); 4707 if (rank_prec_comm == active_rank) { 4708 ierr = PetscMalloc((nsp_size+1)*sizeof(Vec),&coarse_nsp_vecs);CHKERRQ(ierr); 4709 for (i=0; i<nsp_size+1; i++) { 4710 ierr = VecDuplicate(pcbddc->coarse_vec,&coarse_nsp_vecs[i]);CHKERRQ(ierr); 4711 } 4712 } 4713 if (nsp_has_cnst) { 4714 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 4715 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 4716 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4717 ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4718 if (rank_prec_comm == active_rank) { 4719 ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4720 ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&test_null);CHKERRQ(ierr); 4721 if (test_null > 1.0e-12 && pcbddc->dbg_flag) { 4722 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Constant coarse null space error % 1.14e\n",test_null);CHKERRQ(ierr); 4723 } 4724 ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr); 4725 coarse_nsp_size++; 4726 } 4727 } 4728 for (i=0; i<nsp_size; i++) { 4729 ierr = VecScatterBegin(matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4730 ierr = VecScatterEnd (matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4731 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 4732 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4733 ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4734 if (rank_prec_comm == active_rank) { 4735 ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4736 ierr = VecNorm(pcbddc->coarse_rhs,NORM_2,&test_null);CHKERRQ(ierr); 4737 if (test_null > 1.0e-12 && pcbddc->dbg_flag) { 4738 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Vec %d coarse null space error % 1.14e\n",i,test_null);CHKERRQ(ierr); 4739 } 4740 ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr); 4741 coarse_nsp_size++; 4742 } 4743 } 4744 if (coarse_nsp_size > 0) { 4745 /* TODO orthonormalize vecs */ 4746 ierr = VecNormalize(coarse_nsp_vecs[0],NULL);CHKERRQ(ierr); 4747 ierr = MatNullSpaceCreate(coarse_comm,PETSC_FALSE,coarse_nsp_size,coarse_nsp_vecs,&pcbddc->CoarseNullSpace);CHKERRQ(ierr); 4748 for (i=0; i<nsp_size+1; i++) { 4749 ierr = VecDestroy(&coarse_nsp_vecs[i]);CHKERRQ(ierr); 4750 } 4751 } 4752 ierr = PetscFree(coarse_nsp_vecs);CHKERRQ(ierr); 4753 } 4754 4755 /* KSP for coarse problem */ 4756 if (rank_prec_comm == active_rank) { 4757 PetscBool isbddc=PETSC_FALSE; 4758 4759 ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr); 4760 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr); 4761 ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 4762 ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr); 4763 ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr); 4764 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 4765 ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr); 4766 /* Allow user's customization */ 4767 ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr); 4768 /* Set Up PC for coarse problem BDDC */ 4769 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4770 i = pcbddc->current_level+1; 4771 ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr); 4772 ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr); 4773 ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr); 4774 ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr); 4775 if (pcbddc->CoarseNullSpace) { ierr = PCBDDCSetNullSpace(pc_temp,pcbddc->CoarseNullSpace);CHKERRQ(ierr); } 4776 if (dbg_flag) { 4777 ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr); 4778 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 4779 } 4780 } 4781 ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr); 4782 ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr); 4783 4784 ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&j);CHKERRQ(ierr); 4785 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 4786 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 4787 if (j == 1) { 4788 ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr); 4789 if (isbddc) { 4790 ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr); 4791 } 4792 } 4793 } 4794 /* Check coarse problem if requested */ 4795 if (dbg_flag && rank_prec_comm == active_rank) { 4796 KSP check_ksp; 4797 PC check_pc; 4798 Vec check_vec; 4799 PetscReal abs_infty_error,infty_error,lambda_min,lambda_max; 4800 KSPType check_ksp_type; 4801 4802 /* Create ksp object suitable for extreme eigenvalues' estimation */ 4803 ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr); 4804 ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 4805 ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr); 4806 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4807 if (issym) check_ksp_type = KSPCG; 4808 else check_ksp_type = KSPGMRES; 4809 ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr); 4810 } else { 4811 check_ksp_type = KSPPREONLY; 4812 } 4813 ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr); 4814 ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr); 4815 ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr); 4816 ierr = KSPSetUp(check_ksp);CHKERRQ(ierr); 4817 /* create random vec */ 4818 ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr); 4819 ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr); 4820 if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,check_vec,NULL);CHKERRQ(ierr); } 4821 ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4822 /* solve coarse problem */ 4823 ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr); 4824 if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_vec,NULL);CHKERRQ(ierr); } 4825 /* check coarse problem residual error */ 4826 ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr); 4827 ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr); 4828 ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4829 ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr); 4830 ierr = VecDestroy(&check_vec);CHKERRQ(ierr); 4831 /* get eigenvalue estimation if inexact */ 4832 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4833 ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr); 4834 ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr); 4835 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr); 4836 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr); 4837 } 4838 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error : %1.14e\n",infty_error);CHKERRQ(ierr); 4839 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr); 4840 ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr); 4841 } 4842 if (dbg_flag) { ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); } 4843 PetscFunctionReturn(0); 4844 } 4845 4846 #undef __FUNCT__ 4847 #define __FUNCT__ "PCBDDCManageLocalBoundaries" 4848 static PetscErrorCode PCBDDCManageLocalBoundaries(PC pc) 4849 { 4850 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 4851 PC_IS *pcis = (PC_IS*)pc->data; 4852 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 4853 PCBDDCGraph mat_graph=pcbddc->mat_graph; 4854 PetscInt *is_indices,*auxis; 4855 PetscInt bs,ierr,i,j,s,k,iindex,neumann_bsize,dirichlet_bsize; 4856 PetscInt total_counts,nodes_touched,where_values=1,vertex_size; 4857 PetscMPIInt adapt_interface=0,adapt_interface_reduced=0,NEUMANNCNT=0; 4858 PetscBool same_set; 4859 MPI_Comm interface_comm=((PetscObject)pc)->comm; 4860 PetscBool use_faces =PETSC_FALSE,use_edges=PETSC_FALSE; 4861 const PetscInt *neumann_nodes; 4862 const PetscInt *dirichlet_nodes; 4863 IS used_IS,*custom_ISForDofs; 4864 PetscScalar *array; 4865 PetscScalar *array2; 4866 PetscViewer viewer=pcbddc->dbg_viewer; 4867 PetscInt *queue_in_global_numbering; 4868 4869 PetscFunctionBegin; 4870 /* Setup local adjacency graph */ 4871 mat_graph->nvtxs=pcis->n; 4872 if (!mat_graph->xadj) NEUMANNCNT = 1; 4873 ierr = PCBDDCSetupLocalAdjacencyGraph(pc);CHKERRQ(ierr); 4874 4875 i = mat_graph->nvtxs; 4876 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); 4877 ierr = PetscMalloc2(i,PetscInt,&mat_graph->which_dof,i,PetscBool,&mat_graph->touched);CHKERRQ(ierr); 4878 ierr = PetscMemzero(mat_graph->where,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4879 ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4880 ierr = PetscMemzero(mat_graph->which_dof,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4881 ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4882 ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr); 4883 4884 /* Setting dofs splitting in mat_graph->which_dof 4885 Get information about dofs' splitting if provided by the user 4886 Otherwise it assumes a constant block size */ 4887 vertex_size=0; 4888 if (!pcbddc->n_ISForDofs) { 4889 ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr); 4890 ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr); 4891 for (i=0; i<bs; i++) { 4892 ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr); 4893 } 4894 ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr); 4895 vertex_size=1; 4896 /* remove my references to IS objects */ 4897 for (i=0; i<bs; i++) { 4898 ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr); 4899 } 4900 ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr); 4901 } 4902 for (i=0; i<pcbddc->n_ISForDofs; i++) { 4903 ierr = ISGetSize(pcbddc->ISForDofs[i],&k);CHKERRQ(ierr); 4904 ierr = ISGetIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr); 4905 for (j=0; j<k; j++) mat_graph->which_dof[is_indices[j]]=i; 4906 ierr = ISRestoreIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr); 4907 } 4908 /* use mat block size as vertex size if it has not yet set */ 4909 if (!vertex_size) { 4910 ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr); 4911 } 4912 4913 /* count number of neigh per node */ 4914 total_counts=0; 4915 for (i=1; i<pcis->n_neigh; i++) { 4916 s = pcis->n_shared[i]; 4917 total_counts += s; 4918 for (j=0;j<s;j++) mat_graph->count[pcis->shared[i][j]] += 1; 4919 } 4920 4921 /* Take into account Neumann data -> it increments number of sharing subdomains for nodes lying on the interface */ 4922 ierr = PCBDDCGetNeumannBoundaries(pc,&used_IS);CHKERRQ(ierr); 4923 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 4924 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4925 if (used_IS) { 4926 ierr = ISGetSize(used_IS,&neumann_bsize);CHKERRQ(ierr); 4927 ierr = ISGetIndices(used_IS,&neumann_nodes);CHKERRQ(ierr); 4928 for (i=0; i<neumann_bsize; i++) { 4929 iindex = neumann_nodes[i]; 4930 if (mat_graph->count[iindex] > NEUMANNCNT && array[iindex]==0.0) { 4931 mat_graph->count[iindex]+=1; 4932 total_counts++; 4933 array[iindex]=array[iindex]+1.0; 4934 } 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); 4935 } 4936 } 4937 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4938 /* allocate space for storing the set of neighbours for each node */ 4939 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt*),&mat_graph->neighbours_set);CHKERRQ(ierr); 4940 if (mat_graph->nvtxs) { ierr = PetscMalloc(total_counts*sizeof(PetscInt),&mat_graph->neighbours_set[0]);CHKERRQ(ierr); } 4941 for (i=1; i<mat_graph->nvtxs; i++) mat_graph->neighbours_set[i]=mat_graph->neighbours_set[i-1]+mat_graph->count[i-1]; 4942 ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4943 for (i=1; i<pcis->n_neigh; i++) { 4944 s=pcis->n_shared[i]; 4945 for (j=0; j<s; j++) { 4946 k=pcis->shared[i][j]; 4947 4948 mat_graph->neighbours_set[k][mat_graph->count[k]] = pcis->neigh[i]; 4949 4950 mat_graph->count[k]+=1; 4951 } 4952 } 4953 /* Check consistency of Neumann nodes */ 4954 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 4955 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4956 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4957 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4958 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4959 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4960 /* set -1 fake neighbour to mimic Neumann boundary */ 4961 if (used_IS) { 4962 for (i=0; i<neumann_bsize; i++) { 4963 iindex = neumann_nodes[i]; 4964 if (mat_graph->count[iindex] > NEUMANNCNT) { 4965 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]); 4966 mat_graph->neighbours_set[iindex][mat_graph->count[iindex]] = -1; 4967 4968 mat_graph->count[iindex]+=1; 4969 } 4970 } 4971 ierr = ISRestoreIndices(used_IS,&neumann_nodes);CHKERRQ(ierr); 4972 } 4973 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4974 /* sort set of sharing subdomains */ 4975 for (i=0;i<mat_graph->nvtxs;i++) { 4976 ierr = PetscSortInt(mat_graph->count[i],mat_graph->neighbours_set[i]);CHKERRQ(ierr); 4977 } 4978 4979 /* remove interior nodes and dirichlet boundary nodes from the next search into the graph */ 4980 for (i=0;i<mat_graph->nvtxs;i++) mat_graph->touched[i]=PETSC_FALSE; 4981 nodes_touched=0; 4982 4983 ierr = PCBDDCGetDirichletBoundaries(pc,&used_IS);CHKERRQ(ierr); 4984 ierr = VecSet(pcis->vec2_N,0.0);CHKERRQ(ierr); 4985 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4986 ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 4987 if (used_IS) { 4988 ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr); 4989 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"); 4990 ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 4991 for (i=0; i<dirichlet_bsize; i++) { 4992 iindex = dirichlet_nodes[i]; 4993 if (mat_graph->count[iindex] && !mat_graph->touched[iindex]) { 4994 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); 4995 mat_graph->touched[iindex] = PETSC_TRUE; 4996 mat_graph->where[iindex] = 0; 4997 nodes_touched++; 4998 array2[iindex] = array2[iindex]+1.0; 4999 } 5000 } 5001 ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 5002 } 5003 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 5004 ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 5005 5006 /* Check consistency of Dirichlet nodes */ 5007 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 5008 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 5009 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5010 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5011 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5012 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5013 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 5014 ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5015 ierr = VecScatterEnd (matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5016 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5017 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5018 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 5019 ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 5020 if (used_IS) { 5021 ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr); 5022 ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 5023 for (i=0; i<dirichlet_bsize; i++) { 5024 iindex=dirichlet_nodes[i]; 5025 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]); 5026 } 5027 ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 5028 } 5029 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 5030 ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 5031 5032 for (i=0; i<mat_graph->nvtxs; i++) { 5033 if (!mat_graph->count[i]) { /* interior nodes */ 5034 mat_graph->touched[i] = PETSC_TRUE; 5035 mat_graph->where[i] = 0; 5036 nodes_touched++; 5037 } 5038 } 5039 mat_graph->ncmps = 0; 5040 5041 i=0; 5042 while (nodes_touched<mat_graph->nvtxs) { 5043 /* find first untouched node in local ordering */ 5044 while (mat_graph->touched[i]) i++; 5045 mat_graph->touched[i]=PETSC_TRUE; 5046 mat_graph->where[i] =where_values; 5047 nodes_touched++; 5048 /* now find all other nodes having the same set of sharing subdomains */ 5049 for (j=i+1; j<mat_graph->nvtxs; j++) { 5050 /* check for same number of sharing subdomains and dof number */ 5051 if (!mat_graph->touched[j] && mat_graph->count[i]==mat_graph->count[j] && mat_graph->which_dof[i] == mat_graph->which_dof[j]) { 5052 /* check for same set of sharing subdomains */ 5053 same_set=PETSC_TRUE; 5054 for (k=0; k<mat_graph->count[j]; k++) { 5055 if (mat_graph->neighbours_set[i][k] != mat_graph->neighbours_set[j][k]) { 5056 same_set=PETSC_FALSE; 5057 } 5058 } 5059 /* I found a friend of mine */ 5060 if (same_set) { 5061 mat_graph->where[j] = where_values; 5062 mat_graph->touched[j] = PETSC_TRUE; 5063 nodes_touched++; 5064 } 5065 } 5066 } 5067 where_values++; 5068 } 5069 where_values--; if (where_values<0) where_values=0; 5070 ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr); 5071 /* Find connected components defined on the shared interface */ 5072 if (where_values) { 5073 ierr = PCBDDCFindConnectedComponents(mat_graph, where_values);CHKERRQ(ierr); 5074 } 5075 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&queue_in_global_numbering);CHKERRQ(ierr); 5076 /* check consistency of connected components among neighbouring subdomains -> it adapt them in case it is needed */ 5077 for (i=0;i<where_values;i++) { 5078 /* We are not sure that on a given subset of the local interface, 5079 two connected components will be the same among sharing subdomains */ 5080 if (mat_graph->where_ncmps[i]>1) { 5081 adapt_interface=1; 5082 break; 5083 } 5084 } 5085 5086 ierr = MPI_Allreduce(&adapt_interface,&adapt_interface_reduced,1,MPIU_INT,MPI_LOR,interface_comm);CHKERRQ(ierr); 5087 if (pcbddc->dbg_flag && adapt_interface_reduced) { 5088 ierr = PetscViewerASCIIPrintf(viewer,"Adapting interface\n");CHKERRQ(ierr); 5089 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 5090 } 5091 if (where_values && adapt_interface_reduced) { 5092 PetscInt sum_requests=0,my_rank; 5093 PetscInt buffer_size,start_of_recv,size_of_recv,start_of_send; 5094 PetscInt temp_buffer_size,ins_val,global_where_counter; 5095 PetscInt *cum_recv_counts; 5096 PetscInt *where_to_nodes_indices; 5097 PetscInt *petsc_buffer; 5098 PetscMPIInt *recv_buffer; 5099 PetscMPIInt *recv_buffer_where; 5100 PetscMPIInt *send_buffer; 5101 PetscMPIInt size_of_send; 5102 PetscInt *sizes_of_sends; 5103 MPI_Request *send_requests; 5104 MPI_Request *recv_requests; 5105 PetscInt *where_cc_adapt; 5106 PetscInt **temp_buffer; 5107 PetscInt *nodes_to_temp_buffer_indices; 5108 PetscInt *add_to_where; 5109 PetscInt *aux_new_xadj,*new_xadj,*new_adjncy; 5110 5111 /* Retrict adjacency graph using information from connected components */ 5112 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&aux_new_xadj);CHKERRQ(ierr); 5113 for (i=0; i<mat_graph->nvtxs; i++) aux_new_xadj[i]=1; 5114 for (i=0;i<mat_graph->ncmps;i++) { 5115 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5116 for (j=0;j<k;j++) aux_new_xadj[mat_graph->queue[mat_graph->cptr[i]+j]]=k; 5117 } 5118 j = 0; 5119 for (i=0;i<mat_graph->nvtxs;i++) j += aux_new_xadj[i]; 5120 5121 ierr = PetscMalloc((mat_graph->nvtxs+1)*sizeof(PetscInt),&new_xadj);CHKERRQ(ierr); 5122 ierr = PetscMalloc(j*sizeof(PetscInt),&new_adjncy);CHKERRQ(ierr); 5123 new_xadj[0]=0; 5124 for (i=0;i<mat_graph->nvtxs;i++) { 5125 new_xadj[i+1]=new_xadj[i]+aux_new_xadj[i]; 5126 if (aux_new_xadj[i]==1) new_adjncy[new_xadj[i]]=i; 5127 } 5128 ierr = PetscFree(aux_new_xadj);CHKERRQ(ierr); 5129 for (i=0; i<mat_graph->ncmps; i++) { 5130 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5131 for (j=0; j<k; j++) { 5132 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); 5133 } 5134 } 5135 ierr = PCBDDCSetLocalAdjacencyGraph(pc,mat_graph->nvtxs,new_xadj,new_adjncy,PETSC_OWN_POINTER);CHKERRQ(ierr); 5136 /* For consistency among neughbouring procs, I need to sort (by global ordering) each connected component */ 5137 for (i=0; i<mat_graph->ncmps; i++) { 5138 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5139 ierr = ISLocalToGlobalMappingApply(matis->mapping,k,&mat_graph->queue[mat_graph->cptr[i]],&queue_in_global_numbering[mat_graph->cptr[i]]);CHKERRQ(ierr); 5140 ierr = PetscSortIntWithArray(k,&queue_in_global_numbering[mat_graph->cptr[i]],&mat_graph->queue[mat_graph->cptr[i]]);CHKERRQ(ierr); 5141 } 5142 /* allocate some space */ 5143 ierr = MPI_Comm_rank(interface_comm,&my_rank);CHKERRQ(ierr); 5144 ierr = PetscMalloc((where_values+1)*sizeof(PetscInt),&cum_recv_counts);CHKERRQ(ierr); 5145 ierr = PetscMemzero(cum_recv_counts,(where_values+1)*sizeof(PetscInt));CHKERRQ(ierr); 5146 ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_to_nodes_indices);CHKERRQ(ierr); 5147 /* first count how many neighbours per connected component I will receive from */ 5148 cum_recv_counts[0]=0; 5149 for (i=1; i<where_values+1; i++) { 5150 j=0; 5151 while (mat_graph->where[j] != i) j++; 5152 where_to_nodes_indices[i-1]=j; 5153 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 */ 5154 else cum_recv_counts[i]=cum_recv_counts[i-1]+mat_graph->count[j]-1; 5155 } 5156 ierr = PetscMalloc(2*cum_recv_counts[where_values]*sizeof(PetscMPIInt),&recv_buffer_where);CHKERRQ(ierr); 5157 ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&send_requests);CHKERRQ(ierr); 5158 ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&recv_requests);CHKERRQ(ierr); 5159 for (i=0; i<cum_recv_counts[where_values]; i++) { 5160 send_requests[i]=MPI_REQUEST_NULL; 5161 recv_requests[i]=MPI_REQUEST_NULL; 5162 } 5163 /* exchange with my neighbours the number of my connected components on the shared interface */ 5164 for (i=0; i<where_values; i++) { 5165 j = where_to_nodes_indices[i]; 5166 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 5167 for (; k<mat_graph->count[j]; k++) { 5168 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); 5169 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); 5170 sum_requests++; 5171 } 5172 } 5173 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5174 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5175 /* determine the connected component I need to adapt */ 5176 ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_cc_adapt);CHKERRQ(ierr); 5177 ierr = PetscMemzero(where_cc_adapt,where_values*sizeof(PetscInt));CHKERRQ(ierr); 5178 for (i=0; i<where_values; i++) { 5179 for (j=cum_recv_counts[i]; j<cum_recv_counts[i+1]; j++) { 5180 /* The first condition is natural (i.e someone has a different number of cc than me), the second one is just to be safe */ 5181 if (mat_graph->where_ncmps[i]!=recv_buffer_where[j] || mat_graph->where_ncmps[i] > 1) { 5182 where_cc_adapt[i]=PETSC_TRUE; 5183 break; 5184 } 5185 } 5186 } 5187 buffer_size = 0; 5188 for (i=0; i<where_values; i++) { 5189 if (where_cc_adapt[i]) { 5190 for (j=i; j<mat_graph->ncmps; j++) { 5191 if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */ 5192 buffer_size += 1 + mat_graph->cptr[j+1]-mat_graph->cptr[j]; 5193 } 5194 } 5195 } 5196 } 5197 ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr); 5198 /* now get from neighbours their ccs (in global numbering) and adapt them (in case it is needed) */ 5199 /* first determine how much data to send (size of each queue plus the global indices) and communicate it to neighbours */ 5200 ierr = PetscMalloc(where_values*sizeof(PetscInt),&sizes_of_sends);CHKERRQ(ierr); 5201 ierr = PetscMemzero(sizes_of_sends,where_values*sizeof(PetscInt));CHKERRQ(ierr); 5202 5203 sum_requests = 0; 5204 start_of_send = 0; 5205 start_of_recv = cum_recv_counts[where_values]; 5206 for (i=0; i<where_values; i++) { 5207 if (where_cc_adapt[i]) { 5208 size_of_send=0; 5209 for (j=i; j<mat_graph->ncmps; j++) { 5210 if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */ 5211 send_buffer[start_of_send+size_of_send]=mat_graph->cptr[j+1]-mat_graph->cptr[j]; 5212 size_of_send += 1; 5213 for (k=0; k<mat_graph->cptr[j+1]-mat_graph->cptr[j]; k++) { 5214 send_buffer[start_of_send+size_of_send+k]=queue_in_global_numbering[mat_graph->cptr[j]+k]; 5215 } 5216 size_of_send=size_of_send+mat_graph->cptr[j+1]-mat_graph->cptr[j]; 5217 } 5218 } 5219 j = where_to_nodes_indices[i]; 5220 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 5221 sizes_of_sends[i]=size_of_send; 5222 for (; k<mat_graph->count[j]; k++) { 5223 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); 5224 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); 5225 sum_requests++; 5226 } 5227 start_of_send+=size_of_send; 5228 } 5229 } 5230 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5231 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5232 5233 buffer_size=0; 5234 5235 for (k=0;k<sum_requests;k++) buffer_size += recv_buffer_where[start_of_recv+k]; 5236 ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&recv_buffer);CHKERRQ(ierr); 5237 /* now exchange the data */ 5238 start_of_recv = 0; 5239 start_of_send = 0; 5240 sum_requests = 0; 5241 for (i=0; i<where_values; i++) { 5242 if (where_cc_adapt[i]) { 5243 size_of_send = sizes_of_sends[i]; 5244 5245 j = where_to_nodes_indices[i]; 5246 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 5247 for (; k<mat_graph->count[j]; k++) { 5248 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); 5249 size_of_recv = recv_buffer_where[cum_recv_counts[where_values]+sum_requests]; 5250 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); 5251 start_of_recv+=size_of_recv; 5252 sum_requests++; 5253 } 5254 start_of_send+=size_of_send; 5255 } 5256 } 5257 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5258 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5259 ierr = PetscMalloc(buffer_size*sizeof(PetscInt),&petsc_buffer);CHKERRQ(ierr); 5260 for (k=0;k<start_of_recv;k++) petsc_buffer[k]=(PetscInt)recv_buffer[k]; 5261 for (j=0;j<buffer_size;) { 5262 ierr = ISGlobalToLocalMappingApply(matis->mapping,IS_GTOLM_MASK,petsc_buffer[j],&petsc_buffer[j+1],&petsc_buffer[j],&petsc_buffer[j+1]);CHKERRQ(ierr); 5263 k = petsc_buffer[j]+1; 5264 j += k; 5265 } 5266 sum_requests = cum_recv_counts[where_values]; 5267 start_of_recv = 0; 5268 5269 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&nodes_to_temp_buffer_indices);CHKERRQ(ierr); 5270 global_where_counter=0; 5271 for (i=0; i<where_values; i++) { 5272 if (where_cc_adapt[i]) { 5273 temp_buffer_size=0; 5274 /* find nodes on the shared interface we need to adapt */ 5275 for (j=0; j<mat_graph->nvtxs; j++) { 5276 if (mat_graph->where[j]==i+1) { 5277 nodes_to_temp_buffer_indices[j]=temp_buffer_size; 5278 temp_buffer_size++; 5279 } else { 5280 nodes_to_temp_buffer_indices[j]=-1; 5281 } 5282 } 5283 5284 /* allocate some temporary space */ 5285 ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt*),&temp_buffer);CHKERRQ(ierr); 5286 ierr = PetscMalloc(temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt),&temp_buffer[0]);CHKERRQ(ierr); 5287 ierr = PetscMemzero(temp_buffer[0],temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt));CHKERRQ(ierr); 5288 for (j=1; j<temp_buffer_size; j++) { 5289 temp_buffer[j]=temp_buffer[j-1]+cum_recv_counts[i+1]-cum_recv_counts[i]; 5290 } 5291 /* analyze contributions from neighbouring subdomains for i-th conn comp 5292 temp buffer structure: 5293 supposing part of the interface has dimension 5 (global nodes 0,1,2,3,4) 5294 3 neighs procs with structured connected components: 5295 neigh 0: [0 1 4], [2 3]; (2 connected components) 5296 neigh 1: [0 1], [2 3 4]; (2 connected components) 5297 neigh 2: [0 4], [1], [2 3]; (3 connected components) 5298 tempbuffer (row-oriented) should be filled as: 5299 [ 0, 0, 0; 5300 0, 0, 1; 5301 1, 1, 2; 5302 1, 1, 2; 5303 0, 1, 0; ]; 5304 This way we can simply recover the resulting structure account for possible intersections of ccs among neighs. 5305 The mat_graph->where array will be modified to reproduce the following 4 connected components [0], [1], [2 3], [4]; 5306 */ 5307 for (j=0;j<cum_recv_counts[i+1]-cum_recv_counts[i];j++) { 5308 ins_val=0; 5309 size_of_recv=recv_buffer_where[sum_requests]; /* total size of recv from neighs */ 5310 for (buffer_size=0;buffer_size<size_of_recv;) { /* loop until all data from neighs has been taken into account */ 5311 for (k=1;k<petsc_buffer[buffer_size+start_of_recv]+1;k++) { /* filling properly temp_buffer using data from a single recv */ 5312 temp_buffer[nodes_to_temp_buffer_indices[petsc_buffer[start_of_recv+buffer_size+k]]][j] = ins_val; 5313 } 5314 buffer_size+=k; 5315 ins_val++; 5316 } 5317 start_of_recv+=size_of_recv; 5318 sum_requests++; 5319 } 5320 ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt),&add_to_where);CHKERRQ(ierr); 5321 ierr = PetscMemzero(add_to_where,temp_buffer_size*sizeof(PetscInt));CHKERRQ(ierr); 5322 for (j=0; j<temp_buffer_size; j++) { 5323 if (!add_to_where[j]) { /* found a new cc */ 5324 global_where_counter++; 5325 add_to_where[j]=global_where_counter; 5326 for (k=j+1; k<temp_buffer_size; k++) { /* check for other nodes in new cc */ 5327 same_set=PETSC_TRUE; 5328 for (s=0; s<cum_recv_counts[i+1]-cum_recv_counts[i]; s++) { 5329 if (temp_buffer[j][s]!=temp_buffer[k][s]) { 5330 same_set=PETSC_FALSE; 5331 break; 5332 } 5333 } 5334 if (same_set) add_to_where[k] = global_where_counter; 5335 } 5336 } 5337 } 5338 /* insert new data in where array */ 5339 temp_buffer_size=0; 5340 for (j=0;j<mat_graph->nvtxs;j++) { 5341 if (mat_graph->where[j]==i+1) { 5342 mat_graph->where[j]=where_values+add_to_where[temp_buffer_size]; 5343 temp_buffer_size++; 5344 } 5345 } 5346 ierr = PetscFree(temp_buffer[0]);CHKERRQ(ierr); 5347 ierr = PetscFree(temp_buffer);CHKERRQ(ierr); 5348 ierr = PetscFree(add_to_where);CHKERRQ(ierr); 5349 } 5350 } 5351 ierr = PetscFree(nodes_to_temp_buffer_indices);CHKERRQ(ierr); 5352 ierr = PetscFree(sizes_of_sends);CHKERRQ(ierr); 5353 ierr = PetscFree(send_requests);CHKERRQ(ierr); 5354 ierr = PetscFree(recv_requests);CHKERRQ(ierr); 5355 ierr = PetscFree(petsc_buffer);CHKERRQ(ierr); 5356 ierr = PetscFree(recv_buffer);CHKERRQ(ierr); 5357 ierr = PetscFree(recv_buffer_where);CHKERRQ(ierr); 5358 ierr = PetscFree(send_buffer);CHKERRQ(ierr); 5359 ierr = PetscFree(cum_recv_counts);CHKERRQ(ierr); 5360 ierr = PetscFree(where_to_nodes_indices);CHKERRQ(ierr); 5361 ierr = PetscFree(where_cc_adapt);CHKERRQ(ierr); 5362 5363 /* We are ready to evaluate consistent connected components on each part of the shared interface */ 5364 if (global_where_counter) { 5365 for (i=0;i<mat_graph->nvtxs;i++) mat_graph->touched[i]=PETSC_FALSE; 5366 global_where_counter=0; 5367 for (i=0;i<mat_graph->nvtxs;i++) { 5368 if (mat_graph->where[i] && !mat_graph->touched[i]) { 5369 global_where_counter++; 5370 for (j=i+1;j<mat_graph->nvtxs;j++) { 5371 if (!mat_graph->touched[j] && mat_graph->where[j]==mat_graph->where[i]) { 5372 mat_graph->where[j] = global_where_counter; 5373 mat_graph->touched[j] = PETSC_TRUE; 5374 } 5375 } 5376 mat_graph->where[i] = global_where_counter; 5377 mat_graph->touched[i] = PETSC_TRUE; 5378 } 5379 } 5380 where_values=global_where_counter; 5381 } 5382 if (global_where_counter) { 5383 ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr); 5384 ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 5385 ierr = PetscFree(mat_graph->where_ncmps);CHKERRQ(ierr); 5386 ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr); 5387 ierr = PCBDDCFindConnectedComponents(mat_graph, where_values); 5388 } 5389 } /* Finished adapting interface */ 5390 5391 /* For consistency among neughbouring procs, I need to sort (by global ordering) each connected component */ 5392 for (i=0; i<mat_graph->ncmps; i++) { 5393 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5394 ierr = ISLocalToGlobalMappingApply(matis->mapping,k,&mat_graph->queue[mat_graph->cptr[i]],&queue_in_global_numbering[mat_graph->cptr[i]]);CHKERRQ(ierr); 5395 ierr = PetscSortIntWithArray(k,&queue_in_global_numbering[mat_graph->cptr[i]],&mat_graph->queue[mat_graph->cptr[i]]);CHKERRQ(ierr); 5396 } 5397 5398 PetscInt nfc = 0; 5399 PetscInt nec = 0; 5400 PetscInt nvc = 0; 5401 PetscBool twodim_flag = PETSC_FALSE; 5402 for (i=0; i<mat_graph->ncmps; i++) { 5403 if (mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size) { 5404 if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1) nfc++; /* 1 neigh Neumann fake included */ 5405 else nec++; /* note that nec will be zero in 2d */ 5406 } else { 5407 nvc+=mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5408 } 5409 } 5410 if (!nec) { /* we are in a 2d case -> no faces, only edges */ 5411 nec = nfc; 5412 nfc = 0; 5413 twodim_flag = PETSC_TRUE; 5414 } 5415 /* allocate IS arrays for faces, edges. Vertices need a single index set. */ 5416 k=0; 5417 for (i=0; i<mat_graph->ncmps; i++) { 5418 j=mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5419 if (j > k) k=j; 5420 5421 if (j<=vertex_size) k+=vertex_size; 5422 } 5423 ierr = PetscMalloc(k*sizeof(PetscInt),&auxis);CHKERRQ(ierr); 5424 if (!pcbddc->vertices_flag && !pcbddc->edges_flag) { 5425 ierr = PetscMalloc(nfc*sizeof(IS),&pcbddc->ISForFaces);CHKERRQ(ierr); 5426 use_faces = PETSC_TRUE; 5427 } 5428 if (!pcbddc->vertices_flag && !pcbddc->faces_flag) { 5429 ierr = PetscMalloc(nec*sizeof(IS),&pcbddc->ISForEdges);CHKERRQ(ierr); 5430 use_edges = PETSC_TRUE; 5431 } 5432 nfc=0; 5433 nec=0; 5434 for (i=0; i<mat_graph->ncmps; i++) { 5435 if (mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size) { 5436 for (j=0; j<mat_graph->cptr[i+1]-mat_graph->cptr[i]; j++) { 5437 auxis[j]=mat_graph->queue[mat_graph->cptr[i]+j]; 5438 } 5439 if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1) { 5440 if (twodim_flag) { 5441 if (use_edges) { 5442 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr); 5443 nec++; 5444 } 5445 } else { 5446 if (use_faces) { 5447 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForFaces[nfc]);CHKERRQ(ierr); 5448 nfc++; 5449 } 5450 } 5451 } else { 5452 if (use_edges) { 5453 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr); 5454 nec++; 5455 } 5456 } 5457 } 5458 } 5459 pcbddc->n_ISForFaces = nfc; 5460 pcbddc->n_ISForEdges = nec; 5461 5462 nvc = 0; 5463 if (!pcbddc->constraints_flag) { 5464 for (i=0; i<mat_graph->ncmps; i++) { 5465 if (mat_graph->cptr[i+1]-mat_graph->cptr[i] <= vertex_size) { 5466 for (j = mat_graph->cptr[i]; j<mat_graph->cptr[i+1]; j++) { 5467 auxis[nvc]=mat_graph->queue[j]; 5468 nvc++; 5469 } 5470 } 5471 } 5472 } 5473 5474 /* sort vertex set (by local ordering) */ 5475 ierr = PetscSortInt(nvc,auxis);CHKERRQ(ierr); 5476 ierr = ISCreateGeneral(PETSC_COMM_SELF,nvc,auxis,PETSC_COPY_VALUES,&pcbddc->ISForVertices);CHKERRQ(ierr); 5477 if (pcbddc->dbg_flag) { 5478 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 5479 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Details from PCBDDCManageLocalBoundaries for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 5480 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Matrix graph has %d connected components", mat_graph->ncmps);CHKERRQ(ierr); 5481 for (i=0; i<mat_graph->ncmps; i++) { 5482 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\nDetails for connected component number %02d: size %04d, count %01d. Nodes follow.\n", 5483 i,mat_graph->cptr[i+1]-mat_graph->cptr[i],mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]);CHKERRQ(ierr); 5484 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"subdomains: "); 5485 for (j=0; j<mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]; j++) { 5486 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d ",mat_graph->neighbours_set[mat_graph->queue[mat_graph->cptr[i]]][j]);CHKERRQ(ierr); 5487 } 5488 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n"); 5489 for (j=mat_graph->cptr[i]; j<mat_graph->cptr[i+1]; j++) { 5490 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d (%d), ",mat_graph->queue[j],queue_in_global_numbering[j]);CHKERRQ(ierr); 5491 } 5492 } 5493 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n--------------------------------------------------------------\n");CHKERRQ(ierr); 5494 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local vertices\n",PetscGlobalRank,nvc);CHKERRQ(ierr); 5495 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local faces\n",PetscGlobalRank,nfc);CHKERRQ(ierr); 5496 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local edges\n",PetscGlobalRank,nec);CHKERRQ(ierr); 5497 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 5498 } 5499 ierr = PetscFree(auxis);CHKERRQ(ierr); 5500 ierr = PetscFree(queue_in_global_numbering);CHKERRQ(ierr); 5501 PetscFunctionReturn(0); 5502 } 5503 5504 /* -------------------------------------------------------------------------- */ 5505 5506 /* The following code has been adapted from function IsConnectedSubdomain contained 5507 in source file contig.c of METIS library (version 5.0.1) 5508 It finds connected components of each partition labeled from 1 to n_dist */ 5509 5510 #undef __FUNCT__ 5511 #define __FUNCT__ "PCBDDCFindConnectedComponents" 5512 static PetscErrorCode PCBDDCFindConnectedComponents(PCBDDCGraph graph, PetscInt n_dist) 5513 { 5514 PetscInt i, j, k, nvtxs, first, last, nleft, ncmps,pid,cum_queue,n,ncmps_pid; 5515 PetscInt *xadj, *adjncy, *where, *queue; 5516 PetscInt *cptr; 5517 PetscBool *touched; 5518 5519 PetscFunctionBegin; 5520 nvtxs = graph->nvtxs; 5521 xadj = graph->xadj; 5522 adjncy = graph->adjncy; 5523 where = graph->where; 5524 touched = graph->touched; 5525 queue = graph->queue; 5526 cptr = graph->cptr; 5527 5528 for (i=0; i<nvtxs; i++) touched[i] = PETSC_FALSE; 5529 5530 cum_queue = 0; 5531 ncmps = 0; 5532 5533 for (n=0; n<n_dist; n++) { 5534 pid = n+1; /* partition labeled by 0 is discarded */ 5535 nleft = 0; 5536 for (i=0; i<nvtxs; i++) { 5537 if (where[i] == pid) nleft++; 5538 } 5539 for (i=0; i<nvtxs; i++) { 5540 if (where[i] == pid) break; 5541 } 5542 touched[i] = PETSC_TRUE; 5543 queue[cum_queue] = i; 5544 first = 0; last = 1; 5545 5546 cptr[ncmps] = cum_queue; /* This actually points to queue */ 5547 ncmps_pid = 0; 5548 5549 while (first != nleft) { 5550 if (first == last) { /* Find another starting vertex */ 5551 cptr[++ncmps] = first+cum_queue; 5552 ncmps_pid++; 5553 for (i=0; i<nvtxs; i++) { 5554 if (where[i] == pid && !touched[i]) break; 5555 } 5556 queue[cum_queue+last] = i; 5557 last++; 5558 touched[i] = PETSC_TRUE; 5559 } 5560 i = queue[cum_queue+first]; 5561 first++; 5562 for (j=xadj[i]; j<xadj[i+1]; j++) { 5563 k = adjncy[j]; 5564 if (where[k] == pid && !touched[k]) { 5565 queue[cum_queue+last] = k; 5566 last++; 5567 touched[k] = PETSC_TRUE; 5568 } 5569 } 5570 } 5571 cptr[++ncmps] = first+cum_queue; 5572 ncmps_pid++; 5573 cum_queue = cptr[ncmps]; 5574 graph->where_ncmps[n] = ncmps_pid; 5575 } 5576 graph->ncmps = ncmps; 5577 PetscFunctionReturn(0); 5578 } 5579