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