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