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