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 2191 PetscFunctionReturn(0); 2192 } 2193 2194 #undef __FUNCT__ 2195 #define __FUNCT__ "PCBDDCSetupFETIDPPCContext" 2196 static PetscErrorCode PCBDDCSetupFETIDPPCContext(Mat fetimat, FETIDPPC_ctx *fetidppc_ctx) 2197 { 2198 FETIDPMat_ctx *mat_ctx; 2199 PetscErrorCode ierr; 2200 2201 PetscFunctionBegin; 2202 ierr = MatShellGetContext(fetimat,&mat_ctx);CHKERRQ(ierr); 2203 /* get references from objects created when setting up feti mat context */ 2204 ierr = PetscObjectReference((PetscObject)mat_ctx->lambda_local);CHKERRQ(ierr); 2205 fetidppc_ctx->lambda_local = mat_ctx->lambda_local; 2206 ierr = PetscObjectReference((PetscObject)mat_ctx->B_Ddelta);CHKERRQ(ierr); 2207 fetidppc_ctx->B_Ddelta = mat_ctx->B_Ddelta; 2208 ierr = PetscObjectReference((PetscObject)mat_ctx->l2g_lambda);CHKERRQ(ierr); 2209 fetidppc_ctx->l2g_lambda = mat_ctx->l2g_lambda; 2210 PetscFunctionReturn(0); 2211 } 2212 2213 #undef __FUNCT__ 2214 #define __FUNCT__ "FETIDPMatMult" 2215 static PetscErrorCode FETIDPMatMult(Mat fetimat, Vec x, Vec y) 2216 { 2217 FETIDPMat_ctx *mat_ctx; 2218 PC_IS *pcis; 2219 PetscErrorCode ierr; 2220 2221 PetscFunctionBegin; 2222 ierr = MatShellGetContext(fetimat,&mat_ctx);CHKERRQ(ierr); 2223 pcis = (PC_IS*)mat_ctx->pc->data; 2224 /* Application of B_delta^T */ 2225 ierr = VecScatterBegin(mat_ctx->l2g_lambda,x,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2226 ierr = VecScatterEnd(mat_ctx->l2g_lambda,x,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2227 ierr = MatMultTranspose(mat_ctx->B_delta,mat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr); 2228 /* Application of \widetilde{S}^-1 */ 2229 ierr = VecSet(pcis->vec1_D,0.0);CHKERRQ(ierr); 2230 ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr); 2231 /* Application of B_delta */ 2232 ierr = MatMult(mat_ctx->B_delta,pcis->vec1_B,mat_ctx->lambda_local);CHKERRQ(ierr); 2233 ierr = VecSet(y,0.0);CHKERRQ(ierr); 2234 ierr = VecScatterBegin(mat_ctx->l2g_lambda,mat_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2235 ierr = VecScatterEnd(mat_ctx->l2g_lambda,mat_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2236 PetscFunctionReturn(0); 2237 } 2238 2239 #undef __FUNCT__ 2240 #define __FUNCT__ "FETIDPPCApply" 2241 static PetscErrorCode FETIDPPCApply(PC fetipc, Vec x, Vec y) 2242 { 2243 FETIDPPC_ctx *pc_ctx; 2244 PC_IS *pcis; 2245 PetscErrorCode ierr; 2246 2247 PetscFunctionBegin; 2248 ierr = PCShellGetContext(fetipc,(void**)&pc_ctx); 2249 pcis = (PC_IS*)pc_ctx->pc->data; 2250 /* Application of B_Ddelta^T */ 2251 ierr = VecScatterBegin(pc_ctx->l2g_lambda,x,pc_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2252 ierr = VecScatterEnd(pc_ctx->l2g_lambda,x,pc_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2253 ierr = VecSet(pcis->vec2_B,0.0);CHKERRQ(ierr); 2254 ierr = MatMultTranspose(pc_ctx->B_Ddelta,pc_ctx->lambda_local,pcis->vec2_B);CHKERRQ(ierr); 2255 /* Application of S */ 2256 ierr = PCISApplySchur(pc_ctx->pc,pcis->vec2_B,pcis->vec1_B,(Vec)0,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 2257 /* Application of B_Ddelta */ 2258 ierr = MatMult(pc_ctx->B_Ddelta,pcis->vec1_B,pc_ctx->lambda_local);CHKERRQ(ierr); 2259 ierr = VecSet(y,0.0);CHKERRQ(ierr); 2260 ierr = VecScatterBegin(pc_ctx->l2g_lambda,pc_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2261 ierr = VecScatterEnd(pc_ctx->l2g_lambda,pc_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2262 PetscFunctionReturn(0); 2263 } 2264 2265 #undef __FUNCT__ 2266 #define __FUNCT__ "PCBDDCSetupLocalAdjacencyGraph" 2267 static PetscErrorCode PCBDDCSetupLocalAdjacencyGraph(PC pc) 2268 { 2269 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 2270 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 2271 PetscInt nvtxs; 2272 const PetscInt *xadj,*adjncy; 2273 Mat mat_adj; 2274 PetscBool symmetrize_rowij=PETSC_TRUE,compressed_rowij=PETSC_FALSE,flg_row=PETSC_TRUE; 2275 PCBDDCGraph mat_graph=pcbddc->mat_graph; 2276 PetscErrorCode ierr; 2277 2278 PetscFunctionBegin; 2279 /* get CSR adjacency from local matrix if user has not yet provided local graph using PCBDDCSetLocalAdjacencyGraph function */ 2280 if (!mat_graph->xadj) { 2281 ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr); 2282 ierr = MatGetRowIJ(mat_adj,0,symmetrize_rowij,compressed_rowij,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 2283 if (!flg_row) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ()\n"); 2284 /* Get adjacency into BDDC workspace */ 2285 ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr); 2286 ierr = MatRestoreRowIJ(mat_adj,0,symmetrize_rowij,compressed_rowij,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 2287 if (!flg_row) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ()\n"); 2288 ierr = MatDestroy(&mat_adj);CHKERRQ(ierr); 2289 } 2290 PetscFunctionReturn(0); 2291 } 2292 /* -------------------------------------------------------------------------- */ 2293 #undef __FUNCT__ 2294 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner" 2295 static PetscErrorCode PCBDDCApplyInterfacePreconditioner(PC pc) 2296 { 2297 PetscErrorCode ierr; 2298 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 2299 PC_IS* pcis = (PC_IS*) (pc->data); 2300 const PetscScalar zero = 0.0; 2301 2302 PetscFunctionBegin; 2303 /* Application of PHI^T */ 2304 ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 2305 if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 2306 2307 /* Scatter data of coarse_rhs */ 2308 if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); } 2309 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2310 2311 /* Local solution on R nodes */ 2312 ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); 2313 ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2314 ierr = VecScatterEnd (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2315 if (pcbddc->inexact_prec_type) { 2316 ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2317 ierr = VecScatterEnd (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2318 } 2319 ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr); 2320 ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 2321 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2322 ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2323 if (pcbddc->inexact_prec_type) { 2324 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2325 ierr = VecScatterEnd (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2326 } 2327 2328 /* Coarse solution */ 2329 ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2330 if (pcbddc->coarse_rhs) { 2331 if (pcbddc->CoarseNullSpace) { 2332 ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_rhs,PETSC_NULL);CHKERRQ(ierr); 2333 } 2334 ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr); 2335 if (pcbddc->CoarseNullSpace) { 2336 ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_vec,PETSC_NULL);CHKERRQ(ierr); 2337 } 2338 } 2339 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2340 ierr = PCBDDCScatterCoarseDataEnd (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2341 2342 /* Sum contributions from two levels */ 2343 ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 2344 if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 2345 PetscFunctionReturn(0); 2346 } 2347 /* -------------------------------------------------------------------------- */ 2348 #undef __FUNCT__ 2349 #define __FUNCT__ "PCBDDCSolveSaddlePoint" 2350 static PetscErrorCode PCBDDCSolveSaddlePoint(PC pc) 2351 { 2352 PetscErrorCode ierr; 2353 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 2354 2355 PetscFunctionBegin; 2356 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 2357 if (pcbddc->local_auxmat1) { 2358 ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr); 2359 ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr); 2360 } 2361 PetscFunctionReturn(0); 2362 } 2363 /* -------------------------------------------------------------------------- */ 2364 #undef __FUNCT__ 2365 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin" 2366 static PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode) 2367 { 2368 PetscErrorCode ierr; 2369 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 2370 2371 PetscFunctionBegin; 2372 switch (pcbddc->coarse_communications_type) { 2373 case SCATTERS_BDDC: 2374 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr); 2375 break; 2376 case GATHERS_BDDC: 2377 break; 2378 } 2379 PetscFunctionReturn(0); 2380 } 2381 /* -------------------------------------------------------------------------- */ 2382 #undef __FUNCT__ 2383 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd" 2384 static PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode) 2385 { 2386 PetscErrorCode ierr; 2387 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 2388 PetscScalar* array_to; 2389 PetscScalar* array_from; 2390 MPI_Comm comm=((PetscObject)pc)->comm; 2391 PetscInt i; 2392 2393 PetscFunctionBegin; 2394 switch (pcbddc->coarse_communications_type) { 2395 case SCATTERS_BDDC: 2396 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr); 2397 break; 2398 case GATHERS_BDDC: 2399 if (vec_from) VecGetArray(vec_from,&array_from); 2400 if (vec_to) VecGetArray(vec_to,&array_to); 2401 switch (pcbddc->coarse_problem_type) { 2402 case SEQUENTIAL_BDDC: 2403 if (smode == SCATTER_FORWARD) { 2404 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); 2405 if (vec_to) { 2406 if (imode == ADD_VALUES) { 2407 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2408 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i]; 2409 } 2410 } else { 2411 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2412 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i]; 2413 } 2414 } 2415 } 2416 } else { 2417 if (vec_from) { 2418 if (imode == ADD_VALUES) { 2419 printf("Scatter mode %d, insert mode %d for case %d not implemented!\n",smode,imode,pcbddc->coarse_problem_type); 2420 } 2421 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2422 pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]]; 2423 } 2424 } 2425 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); 2426 } 2427 break; 2428 case REPLICATED_BDDC: 2429 if (smode == SCATTER_FORWARD) { 2430 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); 2431 if (imode == ADD_VALUES) { 2432 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2433 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i]; 2434 } 2435 } else { 2436 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2437 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i]; 2438 } 2439 } 2440 } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */ 2441 if (imode == ADD_VALUES) { 2442 for (i=0;i<pcbddc->local_primal_size;i++) { 2443 array_to[i]+=array_from[pcbddc->local_primal_indices[i]]; 2444 } 2445 } else { 2446 for (i=0;i<pcbddc->local_primal_size;i++) { 2447 array_to[i]=array_from[pcbddc->local_primal_indices[i]]; 2448 } 2449 } 2450 } 2451 break; 2452 case MULTILEVEL_BDDC: 2453 break; 2454 case PARALLEL_BDDC: 2455 break; 2456 } 2457 if (vec_from) VecRestoreArray(vec_from,&array_from); 2458 if (vec_to) VecRestoreArray(vec_to,&array_to); 2459 break; 2460 } 2461 PetscFunctionReturn(0); 2462 } 2463 /* -------------------------------------------------------------------------- */ 2464 #undef __FUNCT__ 2465 #define __FUNCT__ "PCBDDCCreateConstraintMatrix" 2466 static PetscErrorCode PCBDDCCreateConstraintMatrix(PC pc) 2467 { 2468 PetscErrorCode ierr; 2469 PC_IS* pcis = (PC_IS*)(pc->data); 2470 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2471 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 2472 PetscInt *nnz,*is_indices; 2473 PetscScalar *temp_quadrature_constraint; 2474 PetscInt *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B,*local_to_B; 2475 PetscInt local_primal_size,i,j,k,total_counts,max_size_of_constraint; 2476 PetscInt n_constraints,n_vertices,size_of_constraint; 2477 PetscScalar quad_value; 2478 PetscBool nnsp_has_cnst=PETSC_FALSE,use_nnsp_true=pcbddc->use_nnsp_true; 2479 PetscInt nnsp_size=0,nnsp_addone=0,temp_constraints,temp_start_ptr; 2480 IS *used_IS; 2481 MatType impMatType=MATSEQAIJ; 2482 PetscBLASInt Bs,Bt,lwork,lierr; 2483 PetscReal tol=1.0e-8; 2484 MatNullSpace nearnullsp; 2485 const Vec *nearnullvecs; 2486 Vec *localnearnullsp; 2487 PetscScalar *work,*temp_basis,*array_vector,*correlation_mat; 2488 PetscReal *rwork,*singular_vals; 2489 PetscBLASInt Bone=1,*ipiv; 2490 Vec temp_vec; 2491 Mat temp_mat; 2492 KSP temp_ksp; 2493 PC temp_pc; 2494 PetscInt s,start_constraint,dual_dofs; 2495 PetscBool compute_submatrix,useksp=PETSC_FALSE; 2496 PetscInt *aux_primal_permutation,*aux_primal_numbering; 2497 PetscBool boolforface,*change_basis; 2498 /* some ugly conditional declarations */ 2499 #if defined(PETSC_MISSING_LAPACK_GESVD) 2500 PetscScalar dot_result; 2501 PetscScalar one=1.0,zero=0.0; 2502 PetscInt ii; 2503 PetscScalar *singular_vectors; 2504 PetscBLASInt *iwork,*ifail; 2505 PetscReal dummy_real,abs_tol; 2506 PetscBLASInt eigs_found; 2507 #if defined(PETSC_USE_COMPLEX) 2508 PetscScalar val1,val2; 2509 #endif 2510 #endif 2511 PetscBLASInt dummy_int; 2512 PetscScalar dummy_scalar; 2513 2514 PetscFunctionBegin; 2515 /* check if near null space is attached to global mat */ 2516 ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr); 2517 if (nearnullsp) { 2518 ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr); 2519 } else { /* if near null space is not provided it uses constants */ 2520 nnsp_has_cnst = PETSC_TRUE; 2521 use_nnsp_true = PETSC_TRUE; 2522 } 2523 if (nnsp_has_cnst) { 2524 nnsp_addone = 1; 2525 } 2526 /* 2527 Evaluate maximum storage size needed by the procedure 2528 - temp_indices will contain start index of each constraint stored as follows 2529 - temp_indices_to_constraint [temp_indices[i],...,temp[indices[i+1]-1] will contain the indices (in local numbering) on which the constraint acts 2530 - 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 2531 - temp_quadrature_constraint [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself 2532 */ 2533 2534 total_counts = pcbddc->n_ISForFaces+pcbddc->n_ISForEdges; 2535 total_counts *= (nnsp_addone+nnsp_size); 2536 ierr = ISGetSize(pcbddc->ISForVertices,&n_vertices);CHKERRQ(ierr); 2537 total_counts += n_vertices; 2538 ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr); 2539 ierr = PetscMalloc((total_counts+1)*sizeof(PetscBool),&change_basis);CHKERRQ(ierr); 2540 total_counts = 0; 2541 max_size_of_constraint = 0; 2542 for (i=0;i<pcbddc->n_ISForEdges+pcbddc->n_ISForFaces;i++) { 2543 if (i<pcbddc->n_ISForEdges) { 2544 used_IS = &pcbddc->ISForEdges[i]; 2545 } else { 2546 used_IS = &pcbddc->ISForFaces[i-pcbddc->n_ISForEdges]; 2547 } 2548 ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr); 2549 total_counts += j; 2550 if (j>max_size_of_constraint) max_size_of_constraint=j; 2551 } 2552 total_counts *= (nnsp_addone+nnsp_size); 2553 total_counts += n_vertices; 2554 ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr); 2555 ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr); 2556 ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr); 2557 ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr); 2558 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2559 for (i=0;i<pcis->n;i++) { 2560 local_to_B[i]=-1; 2561 } 2562 for (i=0;i<pcis->n_B;i++) { 2563 local_to_B[is_indices[i]]=i; 2564 } 2565 ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2566 2567 /* First we issue queries to allocate optimal workspace for LAPACKgesvd or LAPACKsyev/LAPACKheev */ 2568 rwork = 0; 2569 work = 0; 2570 singular_vals = 0; 2571 temp_basis = 0; 2572 correlation_mat = 0; 2573 if (!pcbddc->use_nnsp_true) { 2574 PetscScalar temp_work; 2575 #if defined(PETSC_MISSING_LAPACK_GESVD) 2576 /* POD */ 2577 PetscInt max_n; 2578 max_n = nnsp_addone+nnsp_size; 2579 /* using some techniques borrowed from Proper Orthogonal Decomposition */ 2580 ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr); 2581 ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&singular_vectors);CHKERRQ(ierr); 2582 ierr = PetscMalloc(max_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 2583 ierr = PetscMalloc(max_size_of_constraint*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr); 2584 #if defined(PETSC_USE_COMPLEX) 2585 ierr = PetscMalloc(3*max_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 2586 #endif 2587 ierr = PetscMalloc(5*max_n*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); 2588 ierr = PetscMalloc(max_n*sizeof(PetscBLASInt),&ifail);CHKERRQ(ierr); 2589 /* now we evaluate the optimal workspace using query with lwork=-1 */ 2590 ierr = PetscBLASIntCast(max_n,&Bt);CHKERRQ(ierr); 2591 lwork =-1; 2592 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2593 #if !defined(PETSC_USE_COMPLEX) 2594 abs_tol=1.e-8; 2595 LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int, 2596 &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,&temp_work,&lwork,iwork,ifail,&lierr); 2597 #else 2598 SETERRQ(((PetscObject) pc)->comm, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1"); 2599 #endif 2600 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEVX Lapack routine %d",(int)lierr); 2601 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2602 #else /* on missing GESVD */ 2603 /* SVD */ 2604 PetscInt max_n,min_n; 2605 max_n = max_size_of_constraint; 2606 min_n = nnsp_addone+nnsp_size; 2607 if (max_size_of_constraint < (nnsp_addone+nnsp_size)) { 2608 min_n = max_size_of_constraint; 2609 max_n = nnsp_addone+nnsp_size; 2610 } 2611 ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 2612 #if defined(PETSC_USE_COMPLEX) 2613 ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 2614 #endif 2615 /* now we evaluate the optimal workspace using query with lwork=-1 */ 2616 lwork =-1; 2617 ierr = PetscBLASIntCast(max_n,&Bs);CHKERRQ(ierr); 2618 ierr = PetscBLASIntCast(min_n,&Bt);CHKERRQ(ierr); 2619 dummy_int = Bs; 2620 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2621 #if !defined(PETSC_USE_COMPLEX) 2622 LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals, 2623 &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr); 2624 #else 2625 LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals, 2626 &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr); 2627 #endif 2628 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SVD Lapack routine %d",(int)lierr); 2629 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2630 #endif 2631 /* Allocate optimal workspace */ 2632 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr); 2633 total_counts = (PetscInt)lwork; 2634 ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&work);CHKERRQ(ierr); 2635 } 2636 /* get local part of global near null space vectors */ 2637 ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr); 2638 for (k=0;k<nnsp_size;k++) { 2639 ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr); 2640 ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2641 ierr = VecScatterEnd (matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2642 } 2643 /* Now we can loop on constraining sets */ 2644 total_counts=0; 2645 temp_indices[0]=0; 2646 /* vertices */ 2647 PetscBool used_vertex; 2648 ierr = ISGetIndices(pcbddc->ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2649 if (nnsp_has_cnst) { /* consider all vertices */ 2650 for (i=0;i<n_vertices;i++) { 2651 temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i]; 2652 temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 2653 temp_quadrature_constraint[temp_indices[total_counts]]=1.0; 2654 temp_indices[total_counts+1]=temp_indices[total_counts]+1; 2655 change_basis[total_counts]=PETSC_FALSE; 2656 total_counts++; 2657 } 2658 } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */ 2659 for (i=0;i<n_vertices;i++) { 2660 used_vertex=PETSC_FALSE; 2661 k=0; 2662 while (!used_vertex && k<nnsp_size) { 2663 ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2664 if (PetscAbsScalar(array_vector[is_indices[i]])>0.0) { 2665 temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i]; 2666 temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 2667 temp_quadrature_constraint[temp_indices[total_counts]]=1.0; 2668 temp_indices[total_counts+1]=temp_indices[total_counts]+1; 2669 change_basis[total_counts]=PETSC_FALSE; 2670 total_counts++; 2671 used_vertex=PETSC_TRUE; 2672 } 2673 ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2674 k++; 2675 } 2676 } 2677 } 2678 ierr = ISRestoreIndices(pcbddc->ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2679 n_vertices=total_counts; 2680 /* edges and faces */ 2681 for (i=0;i<pcbddc->n_ISForEdges+pcbddc->n_ISForFaces;i++) { 2682 if (i<pcbddc->n_ISForEdges) { 2683 used_IS = &pcbddc->ISForEdges[i]; 2684 boolforface = pcbddc->usechangeofbasis; 2685 } else { 2686 used_IS = &pcbddc->ISForFaces[i-pcbddc->n_ISForEdges]; 2687 boolforface = pcbddc->usechangeonfaces; 2688 } 2689 temp_constraints = 0; /* zero the number of constraints I have on this conn comp */ 2690 temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */ 2691 ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr); 2692 ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2693 if (nnsp_has_cnst) { 2694 temp_constraints++; 2695 quad_value = (PetscScalar) (1.0/PetscSqrtReal((PetscReal)size_of_constraint)); 2696 for (j=0;j<size_of_constraint;j++) { 2697 temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j]; 2698 temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 2699 temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value; 2700 } 2701 temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 2702 change_basis[total_counts]=boolforface; 2703 total_counts++; 2704 } 2705 for (k=0;k<nnsp_size;k++) { 2706 ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2707 for (j=0;j<size_of_constraint;j++) { 2708 temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j]; 2709 temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 2710 temp_quadrature_constraint[temp_indices[total_counts]+j]=array_vector[is_indices[j]]; 2711 } 2712 ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2713 quad_value = 1.0; 2714 if (use_nnsp_true) { /* check if array is null on the connected component in case use_nnsp_true has been requested */ 2715 ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr); 2716 quad_value = BLASasum_(&Bs,&temp_quadrature_constraint[temp_indices[total_counts]],&Bone); 2717 } 2718 if (quad_value > 0.0) { /* keep indices and values */ 2719 temp_constraints++; 2720 temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 2721 change_basis[total_counts]=boolforface; 2722 total_counts++; 2723 } 2724 } 2725 ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2726 /* perform SVD on the constraint if use_nnsp_true has not be requested by the user */ 2727 if (!use_nnsp_true) { 2728 ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr); 2729 ierr = PetscBLASIntCast(temp_constraints,&Bt);CHKERRQ(ierr); 2730 2731 #if defined(PETSC_MISSING_LAPACK_GESVD) 2732 ierr = PetscMemzero(correlation_mat,Bt*Bt*sizeof(PetscScalar));CHKERRQ(ierr); 2733 /* Store upper triangular part of correlation matrix */ 2734 for (j=0;j<temp_constraints;j++) { 2735 for (k=0;k<j+1;k++) { 2736 #if defined(PETSC_USE_COMPLEX) 2737 /* hand made complex dot product -> replace */ 2738 dot_result = 0.0; 2739 for (ii=0; ii<size_of_constraint; ii++) { 2740 val1 = temp_quadrature_constraint[temp_indices[temp_start_ptr+j]+ii]; 2741 val2 = temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]; 2742 dot_result += val1*PetscConj(val2); 2743 } 2744 #else 2745 dot_result = BLASdot_(&Bs,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Bone, 2746 &temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Bone); 2747 #endif 2748 correlation_mat[j*temp_constraints+k]=dot_result; 2749 } 2750 } 2751 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2752 #if !defined(PETSC_USE_COMPLEX) 2753 /* LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,work,&lwork,&lierr); */ 2754 LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int, 2755 &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,work,&lwork,iwork,ifail,&lierr); 2756 #else 2757 /* LAPACK call is missing here! TODO */ 2758 SETERRQ(((PetscObject) pc)->comm, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1"); 2759 #endif 2760 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEVX Lapack routine %d",(int)lierr); 2761 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2762 /* retain eigenvalues greater than tol: note that lapack SYEV gives eigs in ascending order */ 2763 j=0; 2764 while (j < Bt && singular_vals[j] < tol) j++; 2765 total_counts=total_counts-j; 2766 if (j<temp_constraints) { 2767 for (k=j;k<Bt;k++) { singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]); } 2768 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2769 BLASgemm_("N","N",&Bs,&Bt,&Bt,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,correlation_mat,&Bt,&zero,temp_basis,&Bs); 2770 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2771 /* copy POD basis into used quadrature memory */ 2772 for (k=0;k<Bt-j;k++) { 2773 for (ii=0;ii<size_of_constraint;ii++) { 2774 temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[Bt-1-k]*temp_basis[(Bt-1-k)*size_of_constraint+ii]; 2775 } 2776 } 2777 } 2778 2779 #else /* on missing GESVD */ 2780 PetscInt min_n = temp_constraints; 2781 if (min_n > size_of_constraint) min_n = size_of_constraint; 2782 dummy_int = Bs; 2783 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2784 #if !defined(PETSC_USE_COMPLEX) 2785 LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals, 2786 &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr); 2787 #else 2788 LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals, 2789 &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr); 2790 #endif 2791 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SVD Lapack routine %d",(int)lierr); 2792 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2793 /* retain eigenvalues greater than tol: note that lapack SVD gives eigs in descending order */ 2794 j=0; 2795 while (j < min_n && singular_vals[min_n-j-1] < tol) j++; 2796 total_counts = total_counts-(PetscInt)Bt+(min_n-j); 2797 #endif 2798 } 2799 } 2800 2801 n_constraints=total_counts-n_vertices; 2802 local_primal_size = total_counts; 2803 /* set quantities in pcbddc data structure */ 2804 pcbddc->n_vertices = n_vertices; 2805 pcbddc->n_constraints = n_constraints; 2806 pcbddc->local_primal_size = local_primal_size; 2807 2808 /* Create constraint matrix */ 2809 /* The constraint matrix is used to compute the l2g map of primal dofs */ 2810 /* so we need to set it up properly either with or without change of basis */ 2811 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 2812 ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr); 2813 ierr = MatSetSizes(pcbddc->ConstraintMatrix,local_primal_size,pcis->n,local_primal_size,pcis->n);CHKERRQ(ierr); 2814 /* compute a local numbering of constraints : vertices first then constraints */ 2815 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 2816 ierr = VecGetArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr); 2817 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr); 2818 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_permutation);CHKERRQ(ierr); 2819 total_counts=0; 2820 /* find vertices: subdomain corners plus dofs with basis changed */ 2821 for (i=0;i<local_primal_size;i++) { 2822 size_of_constraint=temp_indices[i+1]-temp_indices[i]; 2823 if (change_basis[i] || size_of_constraint == 1) { 2824 k=0; 2825 while (k < size_of_constraint && array_vector[temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]] != 0.0) { 2826 k=k+1; 2827 } 2828 j=temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]; 2829 array_vector[j] = 1.0; 2830 aux_primal_numbering[total_counts]=j; 2831 aux_primal_permutation[total_counts]=total_counts; 2832 total_counts++; 2833 } 2834 } 2835 ierr = VecRestoreArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr); 2836 /* permute indices in order to have a sorted set of vertices */ 2837 ierr = PetscSortIntWithPermutation(total_counts,aux_primal_numbering,aux_primal_permutation); 2838 /* nonzero structure */ 2839 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 2840 for (i=0;i<total_counts;i++) { 2841 nnz[i]=1; 2842 } 2843 j=total_counts; 2844 for (i=n_vertices;i<local_primal_size;i++) { 2845 if (!change_basis[i]) { 2846 nnz[j]=temp_indices[i+1]-temp_indices[i]; 2847 j++; 2848 } 2849 } 2850 ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr); 2851 ierr = PetscFree(nnz);CHKERRQ(ierr); 2852 /* set values in constraint matrix */ 2853 for (i=0;i<total_counts;i++) { 2854 j = aux_primal_permutation[i]; 2855 k = aux_primal_numbering[j]; 2856 ierr = MatSetValue(pcbddc->ConstraintMatrix,i,k,1.0,INSERT_VALUES);CHKERRQ(ierr); 2857 } 2858 for (i=n_vertices;i<local_primal_size;i++) { 2859 if (!change_basis[i]) { 2860 size_of_constraint=temp_indices[i+1]-temp_indices[i]; 2861 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); 2862 total_counts++; 2863 } 2864 } 2865 ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr); 2866 ierr = PetscFree(aux_primal_permutation);CHKERRQ(ierr); 2867 /* assembling */ 2868 ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2869 ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2870 2871 /* Create matrix for change of basis. We don't need it in case pcbddc->usechangeofbasis is FALSE */ 2872 if (pcbddc->usechangeofbasis) { 2873 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 2874 ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr); 2875 ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr); 2876 /* work arrays */ 2877 /* we need to reuse these arrays, so we free them */ 2878 ierr = PetscFree(temp_basis);CHKERRQ(ierr); 2879 ierr = PetscFree(work);CHKERRQ(ierr); 2880 ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 2881 ierr = PetscMalloc((nnsp_addone+nnsp_size)*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr); 2882 ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscScalar),&work);CHKERRQ(ierr); 2883 ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscBLASInt),&ipiv);CHKERRQ(ierr); 2884 for (i=0;i<pcis->n_B;i++) { 2885 nnz[i]=1; 2886 } 2887 /* Overestimated nonzeros per row */ 2888 k=1; 2889 for (i=pcbddc->n_vertices;i<local_primal_size;i++) { 2890 if (change_basis[i]) { 2891 size_of_constraint = temp_indices[i+1]-temp_indices[i]; 2892 if (k < size_of_constraint) { 2893 k = size_of_constraint; 2894 } 2895 for (j=0;j<size_of_constraint;j++) { 2896 nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint; 2897 } 2898 } 2899 } 2900 ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr); 2901 ierr = PetscFree(nnz);CHKERRQ(ierr); 2902 /* Temporary array to store indices */ 2903 ierr = PetscMalloc(k*sizeof(PetscInt),&is_indices);CHKERRQ(ierr); 2904 /* Set initial identity in the matrix */ 2905 for (i=0;i<pcis->n_B;i++) { 2906 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr); 2907 } 2908 /* Now we loop on the constraints which need a change of basis */ 2909 /* Change of basis matrix is evaluated as the FIRST APPROACH in */ 2910 /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (6.2.1) */ 2911 temp_constraints = 0; 2912 if (pcbddc->n_vertices < local_primal_size) { 2913 temp_start_ptr = temp_indices_to_constraint_B[temp_indices[pcbddc->n_vertices]]; 2914 } 2915 for (i=pcbddc->n_vertices;i<local_primal_size;i++) { 2916 if (change_basis[i]) { 2917 compute_submatrix = PETSC_FALSE; 2918 useksp = PETSC_FALSE; 2919 if (temp_start_ptr == temp_indices_to_constraint_B[temp_indices[i]]) { 2920 temp_constraints++; 2921 if (i == local_primal_size -1 || temp_start_ptr != temp_indices_to_constraint_B[temp_indices[i+1]]) { 2922 compute_submatrix = PETSC_TRUE; 2923 } 2924 } 2925 if (compute_submatrix) { 2926 if (temp_constraints > 1 || pcbddc->use_nnsp_true) { 2927 useksp = PETSC_TRUE; 2928 } 2929 size_of_constraint = temp_indices[i+1]-temp_indices[i]; 2930 if (useksp) { /* experimental */ 2931 ierr = MatCreate(PETSC_COMM_SELF,&temp_mat);CHKERRQ(ierr); 2932 ierr = MatSetType(temp_mat,impMatType);CHKERRQ(ierr); 2933 ierr = MatSetSizes(temp_mat,size_of_constraint,size_of_constraint,size_of_constraint,size_of_constraint);CHKERRQ(ierr); 2934 ierr = MatSeqAIJSetPreallocation(temp_mat,size_of_constraint,PETSC_NULL);CHKERRQ(ierr); 2935 } 2936 /* First _size_of_constraint-temp_constraints_ columns */ 2937 dual_dofs = size_of_constraint-temp_constraints; 2938 start_constraint = i+1-temp_constraints; 2939 for (s=0;s<dual_dofs;s++) { 2940 is_indices[0] = s; 2941 for (j=0;j<temp_constraints;j++) { 2942 for (k=0;k<temp_constraints;k++) { 2943 temp_basis[j*temp_constraints+k]=temp_quadrature_constraint[temp_indices[start_constraint+k]+s+j+1]; 2944 } 2945 work[j]=-temp_quadrature_constraint[temp_indices[start_constraint+j]+s]; 2946 is_indices[j+1]=s+j+1; 2947 } 2948 Bt = temp_constraints; 2949 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2950 LAPACKgesv_(&Bt,&Bone,temp_basis,&Bt,ipiv,work,&Bt,&lierr); 2951 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESV Lapack routine %d",(int)lierr); 2952 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2953 j = temp_indices_to_constraint_B[temp_indices[start_constraint]+s]; 2954 ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,temp_constraints,&temp_indices_to_constraint_B[temp_indices[start_constraint]+s+1],1,&j,work,INSERT_VALUES);CHKERRQ(ierr); 2955 if (useksp) { 2956 /* temp mat with transposed rows and columns */ 2957 ierr = MatSetValues(temp_mat,1,&s,temp_constraints,&is_indices[1],work,INSERT_VALUES);CHKERRQ(ierr); 2958 ierr = MatSetValue(temp_mat,is_indices[0],is_indices[0],1.0,INSERT_VALUES);CHKERRQ(ierr); 2959 } 2960 } 2961 if (useksp) { 2962 /* last rows of temp_mat */ 2963 for (j=0;j<size_of_constraint;j++) { 2964 is_indices[j] = j; 2965 } 2966 for (s=0;s<temp_constraints;s++) { 2967 k = s + dual_dofs; 2968 ierr = MatSetValues(temp_mat,1,&k,size_of_constraint,is_indices,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr); 2969 } 2970 ierr = MatAssemblyBegin(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2971 ierr = MatAssemblyEnd(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2972 ierr = MatGetVecs(temp_mat,&temp_vec,PETSC_NULL);CHKERRQ(ierr); 2973 ierr = KSPCreate(PETSC_COMM_SELF,&temp_ksp);CHKERRQ(ierr); 2974 ierr = KSPSetOperators(temp_ksp,temp_mat,temp_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 2975 ierr = KSPSetType(temp_ksp,KSPPREONLY);CHKERRQ(ierr); 2976 ierr = KSPGetPC(temp_ksp,&temp_pc);CHKERRQ(ierr); 2977 ierr = PCSetType(temp_pc,PCLU);CHKERRQ(ierr); 2978 ierr = KSPSetUp(temp_ksp);CHKERRQ(ierr); 2979 for (s=0;s<temp_constraints;s++) { 2980 ierr = VecSet(temp_vec,0.0);CHKERRQ(ierr); 2981 ierr = VecSetValue(temp_vec,s+dual_dofs,1.0,INSERT_VALUES);CHKERRQ(ierr); 2982 ierr = VecAssemblyBegin(temp_vec);CHKERRQ(ierr); 2983 ierr = VecAssemblyEnd(temp_vec);CHKERRQ(ierr); 2984 ierr = KSPSolve(temp_ksp,temp_vec,temp_vec);CHKERRQ(ierr); 2985 ierr = VecGetArray(temp_vec,&array_vector);CHKERRQ(ierr); 2986 j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1]; 2987 /* last columns of change of basis matrix associated to new primal dofs */ 2988 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); 2989 ierr = VecRestoreArray(temp_vec,&array_vector);CHKERRQ(ierr); 2990 } 2991 ierr = MatDestroy(&temp_mat);CHKERRQ(ierr); 2992 ierr = KSPDestroy(&temp_ksp);CHKERRQ(ierr); 2993 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 2994 } else { 2995 /* last columns of change of basis matrix associated to new primal dofs */ 2996 for (s=0;s<temp_constraints;s++) { 2997 j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1]; 2998 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); 2999 } 3000 } 3001 /* prepare for the next cycle */ 3002 temp_constraints = 0; 3003 if (i != local_primal_size -1) { 3004 temp_start_ptr = temp_indices_to_constraint_B[temp_indices[i+1]]; 3005 } 3006 } 3007 } 3008 } 3009 /* assembling */ 3010 ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3011 ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3012 ierr = PetscFree(ipiv);CHKERRQ(ierr); 3013 ierr = PetscFree(is_indices);CHKERRQ(ierr); 3014 } 3015 /* free workspace no longer needed */ 3016 ierr = PetscFree(rwork);CHKERRQ(ierr); 3017 ierr = PetscFree(work);CHKERRQ(ierr); 3018 ierr = PetscFree(temp_basis);CHKERRQ(ierr); 3019 ierr = PetscFree(singular_vals);CHKERRQ(ierr); 3020 ierr = PetscFree(correlation_mat);CHKERRQ(ierr); 3021 ierr = PetscFree(temp_indices);CHKERRQ(ierr); 3022 ierr = PetscFree(change_basis);CHKERRQ(ierr); 3023 ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr); 3024 ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr); 3025 ierr = PetscFree(local_to_B);CHKERRQ(ierr); 3026 ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr); 3027 #if defined(PETSC_MISSING_LAPACK_GESVD) 3028 ierr = PetscFree(iwork);CHKERRQ(ierr); 3029 ierr = PetscFree(ifail);CHKERRQ(ierr); 3030 ierr = PetscFree(singular_vectors);CHKERRQ(ierr); 3031 #endif 3032 for (k=0;k<nnsp_size;k++) { 3033 ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr); 3034 } 3035 ierr = PetscFree(localnearnullsp);CHKERRQ(ierr); 3036 PetscFunctionReturn(0); 3037 } 3038 /* -------------------------------------------------------------------------- */ 3039 #undef __FUNCT__ 3040 #define __FUNCT__ "PCBDDCCoarseSetUp" 3041 static PetscErrorCode PCBDDCCoarseSetUp(PC pc) 3042 { 3043 PetscErrorCode ierr; 3044 PC_IS* pcis = (PC_IS*)(pc->data); 3045 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 3046 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 3047 Mat change_mat_all; 3048 IS is_R_local; 3049 IS is_V_local; 3050 IS is_C_local; 3051 IS is_aux1; 3052 IS is_aux2; 3053 VecType impVecType; 3054 MatType impMatType; 3055 PetscInt n_R=0; 3056 PetscInt n_D=0; 3057 PetscInt n_B=0; 3058 PetscScalar zero=0.0; 3059 PetscScalar one=1.0; 3060 PetscScalar m_one=-1.0; 3061 PetscScalar* array; 3062 PetscScalar *coarse_submat_vals; 3063 PetscInt *idx_R_local; 3064 PetscInt *idx_V_B; 3065 PetscScalar *coarsefunctions_errors; 3066 PetscScalar *constraints_errors; 3067 /* auxiliary indices */ 3068 PetscInt i,j,k; 3069 /* for verbose output of bddc */ 3070 PetscViewer viewer=pcbddc->dbg_viewer; 3071 PetscBool dbg_flag=pcbddc->dbg_flag; 3072 /* for counting coarse dofs */ 3073 PetscInt n_vertices,n_constraints; 3074 PetscInt size_of_constraint; 3075 PetscInt *row_cmat_indices; 3076 PetscScalar *row_cmat_values; 3077 PetscInt *vertices,*nnz,*is_indices,*temp_indices; 3078 3079 PetscFunctionBegin; 3080 /* Set Non-overlapping dimensions */ 3081 n_B = pcis->n_B; n_D = pcis->n - n_B; 3082 /* Set types for local objects needed by BDDC precondtioner */ 3083 impMatType = MATSEQDENSE; 3084 impVecType = VECSEQ; 3085 /* get vertex indices from constraint matrix */ 3086 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&vertices);CHKERRQ(ierr); 3087 n_vertices=0; 3088 for (i=0;i<pcbddc->local_primal_size;i++) { 3089 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr); 3090 if (size_of_constraint == 1) { 3091 vertices[n_vertices]=row_cmat_indices[0]; 3092 n_vertices++; 3093 } 3094 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr); 3095 } 3096 /* Set number of constraints */ 3097 n_constraints = pcbddc->local_primal_size-n_vertices; 3098 3099 /* vertices in boundary numbering */ 3100 if (n_vertices) { 3101 ierr = VecSet(pcis->vec1_N,m_one);CHKERRQ(ierr); 3102 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3103 for (i=0; i<n_vertices; i++) { array[ vertices[i] ] = i; } 3104 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3105 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3106 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3107 ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr); 3108 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3109 for (i=0; i<n_vertices; i++) { 3110 j=0; 3111 while (array[j] != i) {j++;} 3112 idx_V_B[i]=j; 3113 } 3114 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3115 } 3116 3117 /* transform local matrices if needed */ 3118 if (pcbddc->usechangeofbasis) { 3119 ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 3120 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3121 for (i=0;i<n_D;i++) { 3122 nnz[is_indices[i]]=1; 3123 } 3124 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3125 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3126 k=1; 3127 for (i=0;i<n_B;i++) { 3128 ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 3129 nnz[is_indices[i]]=j; 3130 if (k < j) { 3131 k = j; 3132 } 3133 ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 3134 } 3135 ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3136 /* assemble change of basis matrix on the whole set of local dofs */ 3137 ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr); 3138 ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr); 3139 ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr); 3140 ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr); 3141 ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr); 3142 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3143 for (i=0;i<n_D;i++) { 3144 ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr); 3145 } 3146 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3147 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 3148 for (i=0;i<n_B;i++) { 3149 ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3150 for (k=0;k<j;k++) { 3151 temp_indices[k]=is_indices[row_cmat_indices[k]]; 3152 } 3153 ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr); 3154 ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3155 } 3156 ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3157 ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3158 ierr = MatPtAP(matis->A,change_mat_all,MAT_INITIAL_MATRIX,1.0,&pcbddc->local_mat);CHKERRQ(ierr); 3159 ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr); 3160 ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr); 3161 ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr); 3162 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_IB);CHKERRQ(ierr); 3163 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_BI);CHKERRQ(ierr); 3164 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_BB);CHKERRQ(ierr); 3165 ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr); 3166 ierr = PetscFree(nnz);CHKERRQ(ierr); 3167 ierr = PetscFree(temp_indices);CHKERRQ(ierr); 3168 } else { 3169 /* without change of basis, the local matrix is unchanged */ 3170 ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr); 3171 pcbddc->local_mat = matis->A; 3172 } 3173 /* Change global null space passed in by the user if change of basis has been performed */ 3174 if (pcbddc->NullSpace && pcbddc->usechangeofbasis) { 3175 ierr = PCBDDCAdaptNullSpace(pc);CHKERRQ(ierr); 3176 } 3177 3178 /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */ 3179 ierr = VecSet(pcis->vec1_N,one);CHKERRQ(ierr); 3180 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3181 for (i=0;i<n_vertices;i++) { array[ vertices[i] ] = zero; } 3182 ierr = PetscMalloc((pcis->n - n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr); 3183 for (i=0, n_R=0; i<pcis->n; i++) { if (array[i] == one) { idx_R_local[n_R] = i; n_R++; } } 3184 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3185 if (dbg_flag) { 3186 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3187 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3188 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr); 3189 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr); 3190 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); 3191 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr); 3192 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3193 } 3194 3195 /* Allocate needed vectors */ 3196 ierr = VecDuplicate(pcis->vec1_global,&pcbddc->original_rhs);CHKERRQ(ierr); 3197 ierr = VecDuplicate(pcis->vec1_global,&pcbddc->temp_solution);CHKERRQ(ierr); 3198 ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr); 3199 ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_R);CHKERRQ(ierr); 3200 ierr = VecSetSizes(pcbddc->vec1_R,n_R,n_R);CHKERRQ(ierr); 3201 ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr); 3202 ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr); 3203 ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_P);CHKERRQ(ierr); 3204 ierr = VecSetSizes(pcbddc->vec1_P,pcbddc->local_primal_size,pcbddc->local_primal_size);CHKERRQ(ierr); 3205 ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr); 3206 3207 /* Creating some index sets needed */ 3208 /* For submatrices */ 3209 ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&is_R_local);CHKERRQ(ierr); 3210 if (n_vertices) { 3211 ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_OWN_POINTER,&is_V_local);CHKERRQ(ierr); 3212 } 3213 if (n_constraints) { 3214 ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_C_local);CHKERRQ(ierr); 3215 } 3216 3217 /* For VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */ 3218 { 3219 PetscInt *aux_array1; 3220 PetscInt *aux_array2; 3221 PetscInt *idx_I_local; 3222 3223 ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr); 3224 ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr); 3225 3226 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&idx_I_local);CHKERRQ(ierr); 3227 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3228 for (i=0; i<n_D; i++) { array[idx_I_local[i]] = 0; } 3229 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&idx_I_local);CHKERRQ(ierr); 3230 for (i=0, j=0; i<n_R; i++) { if (array[idx_R_local[i]] == one) { aux_array1[j] = i; j++; } } 3231 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3232 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr); 3233 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3234 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3235 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3236 for (i=0, j=0; i<n_B; i++) { if (array[i] == one) { aux_array2[j] = i; j++; } } 3237 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3238 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_COPY_VALUES,&is_aux2);CHKERRQ(ierr); 3239 ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr); 3240 ierr = PetscFree(aux_array1);CHKERRQ(ierr); 3241 ierr = PetscFree(aux_array2);CHKERRQ(ierr); 3242 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3243 ierr = ISDestroy(&is_aux2);CHKERRQ(ierr); 3244 3245 if (pcbddc->inexact_prec_type || dbg_flag) { 3246 ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr); 3247 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3248 for (i=0, j=0; i<n_R; i++) { if (array[idx_R_local[i]] == zero) { aux_array1[j] = i; j++; } } 3249 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3250 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr); 3251 ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr); 3252 ierr = PetscFree(aux_array1);CHKERRQ(ierr); 3253 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3254 } 3255 } 3256 3257 /* Creating PC contexts for local Dirichlet and Neumann problems */ 3258 { 3259 Mat A_RR; 3260 PC pc_temp; 3261 /* Matrix for Dirichlet problem is A_II -> we already have it from pcis.c code */ 3262 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr); 3263 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr); 3264 ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,SAME_PRECONDITIONER);CHKERRQ(ierr); 3265 ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr); 3266 ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr); 3267 /* default */ 3268 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 3269 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 3270 /* Allow user's customization */ 3271 ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr); 3272 /* umfpack interface has a bug when matrix dimension is zero */ 3273 if (!n_D) { 3274 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 3275 } 3276 /* Set Up KSP for Dirichlet problem of BDDC */ 3277 ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr); 3278 /* set ksp_D into pcis data */ 3279 ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr); 3280 ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr); 3281 pcis->ksp_D = pcbddc->ksp_D; 3282 /* Matrix for Neumann problem is A_RR -> we need to create it */ 3283 ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr); 3284 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr); 3285 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr); 3286 ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,SAME_PRECONDITIONER);CHKERRQ(ierr); 3287 ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr); 3288 ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr); 3289 /* default */ 3290 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 3291 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 3292 /* Allow user's customization */ 3293 ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr); 3294 /* umfpack interface has a bug when matrix dimension is zero */ 3295 if (!pcis->n) { 3296 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 3297 } 3298 /* Set Up KSP for Neumann problem of BDDC */ 3299 ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr); 3300 /* check Dirichlet and Neumann solvers and adapt them is a nullspace correction is needed */ 3301 { 3302 Vec temp_vec; 3303 PetscReal value; 3304 PetscMPIInt use_exact,use_exact_reduced; 3305 3306 ierr = VecDuplicate(pcis->vec1_D,&temp_vec);CHKERRQ(ierr); 3307 ierr = VecSetRandom(pcis->vec1_D,PETSC_NULL);CHKERRQ(ierr); 3308 ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 3309 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,temp_vec);CHKERRQ(ierr); 3310 ierr = VecAXPY(temp_vec,m_one,pcis->vec1_D);CHKERRQ(ierr); 3311 ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr); 3312 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 3313 use_exact = 1; 3314 if (PetscAbsReal(value) > 1.e-4) { 3315 use_exact = 0; 3316 } 3317 ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,((PetscObject)pc)->comm);CHKERRQ(ierr); 3318 pcbddc->use_exact_dirichlet = (PetscBool) use_exact_reduced; 3319 if (dbg_flag) { 3320 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3321 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3322 ierr = PetscViewerASCIIPrintf(viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr); 3323 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr); 3324 } 3325 if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->inexact_prec_type) { 3326 ierr = PCBDDCAdaptLocalProblem(pc,pcis->is_I_local); 3327 } 3328 ierr = VecDuplicate(pcbddc->vec1_R,&temp_vec);CHKERRQ(ierr); 3329 ierr = VecSetRandom(pcbddc->vec1_R,PETSC_NULL);CHKERRQ(ierr); 3330 ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 3331 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,temp_vec);CHKERRQ(ierr); 3332 ierr = VecAXPY(temp_vec,m_one,pcbddc->vec1_R);CHKERRQ(ierr); 3333 ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr); 3334 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 3335 use_exact = 1; 3336 if (PetscAbsReal(value) > 1.e-4) { 3337 use_exact = 0; 3338 } 3339 ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,((PetscObject)pc)->comm);CHKERRQ(ierr); 3340 if (dbg_flag) { 3341 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for Neumann solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr); 3342 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3343 } 3344 if (pcbddc->NullSpace && !use_exact_reduced) { 3345 ierr = PCBDDCAdaptLocalProblem(pc,is_R_local); 3346 } 3347 } 3348 /* free Neumann problem's matrix */ 3349 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 3350 } 3351 3352 /* Assemble all remaining stuff needed to apply BDDC */ 3353 { 3354 Mat A_RV,A_VR,A_VV; 3355 Mat M1; 3356 Mat C_CR; 3357 Mat AUXMAT; 3358 Vec vec1_C; 3359 Vec vec2_C; 3360 Vec vec1_V; 3361 Vec vec2_V; 3362 PetscInt *nnz; 3363 PetscInt *auxindices; 3364 PetscInt index; 3365 PetscScalar* array2; 3366 MatFactorInfo matinfo; 3367 3368 /* Allocating some extra storage just to be safe */ 3369 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 3370 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr); 3371 for (i=0;i<pcis->n;i++) {auxindices[i]=i;} 3372 3373 /* some work vectors on vertices and/or constraints */ 3374 if (n_vertices) { 3375 ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr); 3376 ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr); 3377 ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr); 3378 ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr); 3379 } 3380 if (n_constraints) { 3381 ierr = VecCreate(PETSC_COMM_SELF,&vec1_C);CHKERRQ(ierr); 3382 ierr = VecSetSizes(vec1_C,n_constraints,n_constraints);CHKERRQ(ierr); 3383 ierr = VecSetType(vec1_C,impVecType);CHKERRQ(ierr); 3384 ierr = VecDuplicate(vec1_C,&vec2_C);CHKERRQ(ierr); 3385 ierr = VecDuplicate(vec1_C,&pcbddc->vec1_C);CHKERRQ(ierr); 3386 } 3387 /* Precompute stuffs needed for preprocessing and application of BDDC*/ 3388 if (n_constraints) { 3389 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr); 3390 ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,n_R,n_constraints);CHKERRQ(ierr); 3391 ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr); 3392 ierr = MatSeqDenseSetPreallocation(pcbddc->local_auxmat2,PETSC_NULL);CHKERRQ(ierr); 3393 3394 /* Create Constraint matrix on R nodes: C_{CR} */ 3395 ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_C_local,is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr); 3396 ierr = ISDestroy(&is_C_local);CHKERRQ(ierr); 3397 3398 /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */ 3399 for (i=0;i<n_constraints;i++) { 3400 ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); 3401 /* Get row of constraint matrix in R numbering */ 3402 ierr = VecGetArray(pcbddc->vec1_R,&array);CHKERRQ(ierr); 3403 ierr = MatGetRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3404 for (j=0;j<size_of_constraint;j++) { array[ row_cmat_indices[j] ] = - row_cmat_values[j]; } 3405 ierr = MatRestoreRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3406 ierr = VecRestoreArray(pcbddc->vec1_R,&array);CHKERRQ(ierr); 3407 /* Solve for row of constraint matrix in R numbering */ 3408 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 3409 /* Set values */ 3410 ierr = VecGetArray(pcbddc->vec2_R,&array);CHKERRQ(ierr); 3411 ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3412 ierr = VecRestoreArray(pcbddc->vec2_R,&array);CHKERRQ(ierr); 3413 } 3414 ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3415 ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3416 3417 /* Assemble AUXMAT = (LUFactor)(-C_{CR} A_{RR}^{-1} C^T_{CR})^{-1} */ 3418 ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&AUXMAT);CHKERRQ(ierr); 3419 ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr); 3420 ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,0,1,&is_aux1);CHKERRQ(ierr); 3421 ierr = MatLUFactor(AUXMAT,is_aux1,is_aux1,&matinfo);CHKERRQ(ierr); 3422 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3423 3424 /* Assemble explicitly M1 = (C_{CR} A_{RR}^{-1} C^T_{CR})^{-1} needed in preproc */ 3425 ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr); 3426 ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr); 3427 ierr = MatSetType(M1,impMatType);CHKERRQ(ierr); 3428 ierr = MatSeqDenseSetPreallocation(M1,PETSC_NULL);CHKERRQ(ierr); 3429 for (i=0;i<n_constraints;i++) { 3430 ierr = VecSet(vec1_C,zero);CHKERRQ(ierr); 3431 ierr = VecSetValue(vec1_C,i,one,INSERT_VALUES);CHKERRQ(ierr); 3432 ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr); 3433 ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr); 3434 ierr = MatSolve(AUXMAT,vec1_C,vec2_C);CHKERRQ(ierr); 3435 ierr = VecScale(vec2_C,m_one);CHKERRQ(ierr); 3436 ierr = VecGetArray(vec2_C,&array);CHKERRQ(ierr); 3437 ierr = MatSetValues(M1,n_constraints,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3438 ierr = VecRestoreArray(vec2_C,&array);CHKERRQ(ierr); 3439 } 3440 ierr = MatAssemblyBegin(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3441 ierr = MatAssemblyEnd(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3442 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3443 /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */ 3444 ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr); 3445 3446 } 3447 3448 /* Get submatrices from subdomain matrix */ 3449 if (n_vertices) { 3450 ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_V_local,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr); 3451 ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr); 3452 ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_V_local,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr); 3453 } 3454 3455 /* Matrix of coarse basis functions (local) */ 3456 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr); 3457 ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr); 3458 ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr); 3459 ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_B,PETSC_NULL);CHKERRQ(ierr); 3460 if (pcbddc->inexact_prec_type || dbg_flag) { 3461 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr); 3462 ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr); 3463 ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr); 3464 ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_D,PETSC_NULL);CHKERRQ(ierr); 3465 } 3466 3467 if (dbg_flag) { 3468 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&coarsefunctions_errors);CHKERRQ(ierr); 3469 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&constraints_errors);CHKERRQ(ierr); 3470 } 3471 /* Subdomain contribution (Non-overlapping) to coarse matrix */ 3472 ierr = PetscMalloc ((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr); 3473 3474 /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */ 3475 for (i=0;i<n_vertices;i++) { 3476 ierr = VecSet(vec1_V,zero);CHKERRQ(ierr); 3477 ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr); 3478 ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr); 3479 ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr); 3480 /* solution of saddle point problem */ 3481 ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr); 3482 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 3483 ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr); 3484 if (n_constraints) { 3485 ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr); 3486 ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 3487 ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr); 3488 } 3489 ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); 3490 ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr); 3491 3492 /* Set values in coarse basis function and subdomain part of coarse_mat */ 3493 /* coarse basis functions */ 3494 ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 3495 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3496 ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3497 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3498 ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3499 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3500 ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr); 3501 if (pcbddc->inexact_prec_type || dbg_flag) { 3502 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3503 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3504 ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3505 ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3506 ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3507 } 3508 /* subdomain contribution to coarse matrix */ 3509 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3510 for (j=0;j<n_vertices;j++) { coarse_submat_vals[i*pcbddc->local_primal_size+j] = array[j]; } /* WARNING -> column major ordering */ 3511 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3512 if (n_constraints) { 3513 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3514 for (j=0;j<n_constraints;j++) { coarse_submat_vals[i*pcbddc->local_primal_size+j+n_vertices] = array[j]; } /* WARNING -> column major ordering */ 3515 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3516 } 3517 3518 if (dbg_flag) { 3519 /* assemble subdomain vector on nodes */ 3520 ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr); 3521 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3522 ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3523 for (j=0;j<n_R;j++) { array[idx_R_local[j]] = array2[j]; } 3524 array[ vertices[i] ] = one; 3525 ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3526 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3527 /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */ 3528 ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr); 3529 ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3530 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3531 for (j=0;j<n_vertices;j++) { array2[j]=array[j]; } 3532 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3533 if (n_constraints) { 3534 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3535 for (j=0;j<n_constraints;j++) { array2[j+n_vertices]=array[j]; } 3536 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3537 } 3538 ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3539 ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr); 3540 /* check saddle point solution */ 3541 ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr); 3542 ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr); 3543 ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr); 3544 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 3545 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3546 array[i]=array[i]+m_one; /* shift by the identity matrix */ 3547 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3548 ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr); 3549 } 3550 } 3551 3552 for (i=0;i<n_constraints;i++) { 3553 ierr = VecSet(vec2_C,zero);CHKERRQ(ierr); 3554 ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr); 3555 ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr); 3556 ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr); 3557 /* solution of saddle point problem */ 3558 ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr); 3559 ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr); 3560 ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr); 3561 if (n_vertices) { ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); } 3562 /* Set values in coarse basis function and subdomain part of coarse_mat */ 3563 /* coarse basis functions */ 3564 index=i+n_vertices; 3565 ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 3566 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3567 ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3568 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3569 ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr); 3570 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3571 if (pcbddc->inexact_prec_type || dbg_flag) { 3572 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3573 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3574 ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3575 ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr); 3576 ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3577 } 3578 /* subdomain contribution to coarse matrix */ 3579 if (n_vertices) { 3580 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3581 for (j=0;j<n_vertices;j++) {coarse_submat_vals[index*pcbddc->local_primal_size+j]=array[j];} /* WARNING -> column major ordering */ 3582 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3583 } 3584 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3585 for (j=0;j<n_constraints;j++) {coarse_submat_vals[index*pcbddc->local_primal_size+j+n_vertices]=array[j];} /* WARNING -> column major ordering */ 3586 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3587 3588 if (dbg_flag) { 3589 /* assemble subdomain vector on nodes */ 3590 ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr); 3591 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3592 ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3593 for (j=0;j<n_R;j++) { array[ idx_R_local[j] ] = array2[j]; } 3594 ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3595 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3596 /* assemble subdomain vector of lagrange multipliers */ 3597 ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr); 3598 ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3599 if (n_vertices) { 3600 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3601 for (j=0;j<n_vertices;j++) {array2[j]=-array[j];} 3602 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3603 } 3604 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3605 for (j=0;j<n_constraints;j++) {array2[j+n_vertices]=-array[j];} 3606 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3607 ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3608 /* check saddle point solution */ 3609 ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr); 3610 ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr); 3611 ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[index]);CHKERRQ(ierr); 3612 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 3613 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3614 array[index]=array[index]+m_one; /* shift by the identity matrix */ 3615 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3616 ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[index]);CHKERRQ(ierr); 3617 } 3618 } 3619 ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3620 ierr = MatAssemblyEnd (pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3621 if (pcbddc->inexact_prec_type || dbg_flag) { 3622 ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3623 ierr = MatAssemblyEnd (pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3624 } 3625 /* Checking coarse_sub_mat and coarse basis functios */ 3626 /* It shuld be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */ 3627 if (dbg_flag) { 3628 Mat coarse_sub_mat; 3629 Mat TM1,TM2,TM3,TM4; 3630 Mat coarse_phi_D,coarse_phi_B,A_II,A_BB,A_IB,A_BI; 3631 MatType checkmattype=MATSEQAIJ; 3632 PetscScalar value; 3633 3634 ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr); 3635 ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr); 3636 ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr); 3637 ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr); 3638 ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr); 3639 ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr); 3640 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr); 3641 ierr = MatConvert(coarse_sub_mat,checkmattype,MAT_REUSE_MATRIX,&coarse_sub_mat);CHKERRQ(ierr); 3642 3643 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3644 ierr = PetscViewerASCIIPrintf(viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr); 3645 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3646 ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr); 3647 ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr); 3648 ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 3649 ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr); 3650 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3651 ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 3652 ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr); 3653 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3654 ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3655 ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3656 ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3657 ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3658 ierr = MatNorm(TM1,NORM_INFINITY,&value);CHKERRQ(ierr); 3659 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"----------------------------------\n");CHKERRQ(ierr); 3660 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr); 3661 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"matrix error = % 1.14e\n",value);CHKERRQ(ierr); 3662 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"coarse functions errors\n");CHKERRQ(ierr); 3663 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); } 3664 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"constraints errors\n");CHKERRQ(ierr); 3665 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); } 3666 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3667 ierr = MatDestroy(&A_II);CHKERRQ(ierr); 3668 ierr = MatDestroy(&A_BB);CHKERRQ(ierr); 3669 ierr = MatDestroy(&A_IB);CHKERRQ(ierr); 3670 ierr = MatDestroy(&A_BI);CHKERRQ(ierr); 3671 ierr = MatDestroy(&TM1);CHKERRQ(ierr); 3672 ierr = MatDestroy(&TM2);CHKERRQ(ierr); 3673 ierr = MatDestroy(&TM3);CHKERRQ(ierr); 3674 ierr = MatDestroy(&TM4);CHKERRQ(ierr); 3675 ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr); 3676 ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr); 3677 ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr); 3678 ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr); 3679 ierr = PetscFree(constraints_errors);CHKERRQ(ierr); 3680 } 3681 /* free memory */ 3682 if (n_vertices) { 3683 ierr = VecDestroy(&vec1_V);CHKERRQ(ierr); 3684 ierr = VecDestroy(&vec2_V);CHKERRQ(ierr); 3685 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 3686 ierr = MatDestroy(&A_VR);CHKERRQ(ierr); 3687 ierr = MatDestroy(&A_VV);CHKERRQ(ierr); 3688 } 3689 if (n_constraints) { 3690 ierr = VecDestroy(&vec1_C);CHKERRQ(ierr); 3691 ierr = VecDestroy(&vec2_C);CHKERRQ(ierr); 3692 ierr = MatDestroy(&M1);CHKERRQ(ierr); 3693 ierr = MatDestroy(&C_CR);CHKERRQ(ierr); 3694 } 3695 ierr = PetscFree(auxindices);CHKERRQ(ierr); 3696 ierr = PetscFree(nnz);CHKERRQ(ierr); 3697 /* create coarse matrix and data structures for message passing associated actual choice of coarse problem type */ 3698 ierr = PCBDDCSetupCoarseEnvironment(pc,coarse_submat_vals);CHKERRQ(ierr); 3699 ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr); 3700 } 3701 /* free memory */ 3702 if (n_vertices) { 3703 ierr = PetscFree(idx_V_B);CHKERRQ(ierr); 3704 ierr = ISDestroy(&is_V_local);CHKERRQ(ierr); 3705 } 3706 ierr = ISDestroy(&is_R_local);CHKERRQ(ierr); 3707 3708 PetscFunctionReturn(0); 3709 } 3710 3711 /* -------------------------------------------------------------------------- */ 3712 3713 #undef __FUNCT__ 3714 #define __FUNCT__ "PCBDDCSetupCoarseEnvironment" 3715 static PetscErrorCode PCBDDCSetupCoarseEnvironment(PC pc,PetscScalar* coarse_submat_vals) 3716 { 3717 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 3718 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3719 PC_IS *pcis = (PC_IS*)pc->data; 3720 MPI_Comm prec_comm = ((PetscObject)pc)->comm; 3721 MPI_Comm coarse_comm; 3722 3723 /* common to all choiches */ 3724 PetscScalar *temp_coarse_mat_vals; 3725 PetscScalar *ins_coarse_mat_vals; 3726 PetscInt *ins_local_primal_indices; 3727 PetscMPIInt *localsizes2,*localdispl2; 3728 PetscMPIInt size_prec_comm; 3729 PetscMPIInt rank_prec_comm; 3730 PetscMPIInt active_rank=MPI_PROC_NULL; 3731 PetscMPIInt master_proc=0; 3732 PetscInt ins_local_primal_size; 3733 /* specific to MULTILEVEL_BDDC */ 3734 PetscMPIInt *ranks_recv; 3735 PetscMPIInt count_recv=0; 3736 PetscMPIInt rank_coarse_proc_send_to; 3737 PetscMPIInt coarse_color = MPI_UNDEFINED; 3738 ISLocalToGlobalMapping coarse_ISLG; 3739 /* some other variables */ 3740 PetscErrorCode ierr; 3741 MatType coarse_mat_type; 3742 PCType coarse_pc_type; 3743 KSPType coarse_ksp_type; 3744 PC pc_temp; 3745 PetscInt i,j,k; 3746 PetscInt max_it_coarse_ksp=1; /* don't increase this value */ 3747 /* verbose output viewer */ 3748 PetscViewer viewer=pcbddc->dbg_viewer; 3749 PetscBool dbg_flag=pcbddc->dbg_flag; 3750 3751 PetscInt offset,offset2; 3752 PetscMPIInt im_active,active_procs; 3753 PetscInt *dnz,*onz; 3754 3755 PetscBool setsym,issym=PETSC_FALSE; 3756 3757 PetscFunctionBegin; 3758 ins_local_primal_indices = 0; 3759 ins_coarse_mat_vals = 0; 3760 localsizes2 = 0; 3761 localdispl2 = 0; 3762 temp_coarse_mat_vals = 0; 3763 coarse_ISLG = 0; 3764 3765 ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr); 3766 ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr); 3767 ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr); 3768 3769 /* Assign global numbering to coarse dofs */ 3770 { 3771 PetscInt *auxlocal_primal; 3772 PetscInt *row_cmat_indices; 3773 PetscInt *aux_ordering; 3774 PetscInt *row_cmat_global_indices; 3775 PetscInt *dof_sizes,*dof_displs; 3776 PetscInt size_of_constraint; 3777 PetscBool *array_bool; 3778 PetscBool first_found; 3779 PetscInt first_index,old_index,s; 3780 PetscMPIInt mpi_local_primal_size; 3781 PetscScalar coarsesum,*array; 3782 3783 mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size; 3784 3785 /* Construct needed data structures for message passing */ 3786 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&pcbddc->local_primal_indices);CHKERRQ(ierr); 3787 j = 0; 3788 if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3789 j = size_prec_comm; 3790 } 3791 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr); 3792 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr); 3793 /* Gather local_primal_size information for all processes */ 3794 if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3795 ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr); 3796 } else { 3797 ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3798 } 3799 pcbddc->replicated_primal_size = 0; 3800 for (i=0; i<j; i++) { 3801 pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size ; 3802 pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i]; 3803 } 3804 3805 /* First let's count coarse dofs. 3806 This code fragment assumes that the number of local constraints per connected component 3807 is not greater than the number of nodes defined for the connected component 3808 (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */ 3809 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr); 3810 j = 0; 3811 for (i=0;i<pcbddc->local_primal_size;i++) { 3812 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 3813 if (j < size_of_constraint) { 3814 j = size_of_constraint; 3815 } 3816 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 3817 } 3818 ierr = PetscMalloc(j*sizeof(PetscInt),&aux_ordering);CHKERRQ(ierr); 3819 ierr = PetscMalloc(j*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr); 3820 ierr = PetscMalloc(pcis->n*sizeof(PetscBool),&array_bool);CHKERRQ(ierr); 3821 for (i=0;i<pcis->n;i++) { 3822 array_bool[i] = PETSC_FALSE; 3823 } 3824 for (i=0;i<pcbddc->local_primal_size;i++) { 3825 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr); 3826 for (j=0; j<size_of_constraint; j++) { 3827 aux_ordering[j] = j; 3828 } 3829 ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr); 3830 ierr = PetscSortIntWithPermutation(size_of_constraint,row_cmat_global_indices,aux_ordering);CHKERRQ(ierr); 3831 for (j=0; j<size_of_constraint; j++) { 3832 k = row_cmat_indices[aux_ordering[j]]; 3833 if (!array_bool[k]) { 3834 array_bool[k] = PETSC_TRUE; 3835 auxlocal_primal[i] = k; 3836 break; 3837 } 3838 } 3839 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr); 3840 } 3841 ierr = PetscFree(aux_ordering);CHKERRQ(ierr); 3842 ierr = PetscFree(array_bool);CHKERRQ(ierr); 3843 ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr); 3844 3845 /* Compute number of coarse dofs */ 3846 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 3847 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3848 for (i=0;i<pcbddc->local_primal_size;i++) { 3849 array[auxlocal_primal[i]]=1.0; 3850 } 3851 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3852 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 3853 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3854 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3855 ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr); 3856 pcbddc->coarse_size = (PetscInt)coarsesum; 3857 3858 /* Fill pcis->vec1_global with cumulative function for global numbering */ 3859 ierr = VecGetArray(pcis->vec1_global,&array);CHKERRQ(ierr); 3860 ierr = VecGetLocalSize(pcis->vec1_global,&s);CHKERRQ(ierr); 3861 k = 0; 3862 first_index = -1; 3863 first_found = PETSC_FALSE; 3864 for (i=0;i<s;i++) { 3865 if (!first_found && array[i] > 0.0) { 3866 first_found = PETSC_TRUE; 3867 first_index = i; 3868 } 3869 k += (PetscInt)array[i]; 3870 } 3871 j = (!rank_prec_comm ? size_prec_comm : 0); 3872 ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr); 3873 ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr); 3874 ierr = MPI_Gather(&k,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3875 if (!rank_prec_comm) { 3876 dof_displs[0]=0; 3877 for (i=1;i<size_prec_comm;i++) { 3878 dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1]; 3879 } 3880 } 3881 ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&k,1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3882 if (first_found) { 3883 array[first_index] += k; 3884 old_index = first_index; 3885 for (i=first_index+1;i<s;i++) { 3886 if (array[i] > 0.0) { 3887 array[i] += array[old_index]; 3888 old_index = i; 3889 } 3890 } 3891 } 3892 ierr = VecRestoreArray(pcis->vec1_global,&array);CHKERRQ(ierr); 3893 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 3894 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3895 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3896 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3897 for (i=0;i<pcbddc->local_primal_size;i++) { 3898 pcbddc->local_primal_indices[i] = (PetscInt)array[auxlocal_primal[i]]-1; 3899 } 3900 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3901 ierr = PetscFree(dof_displs);CHKERRQ(ierr); 3902 ierr = PetscFree(dof_sizes);CHKERRQ(ierr); 3903 3904 if (dbg_flag) { 3905 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3906 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3907 ierr = PetscViewerASCIIPrintf(viewer,"Check coarse indices\n");CHKERRQ(ierr); 3908 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 3909 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3910 for (i=0;i<pcbddc->local_primal_size;i++) { 3911 array[auxlocal_primal[i]]=1.0; 3912 } 3913 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3914 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 3915 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3916 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3917 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3918 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3919 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3920 for (i=0;i<pcis->n;i++) { 3921 if (array[i] == 1.0) { 3922 ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&j);CHKERRQ(ierr); 3923 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d: WRONG COARSE INDEX %d (local %d)\n",PetscGlobalRank,j,i);CHKERRQ(ierr); 3924 } 3925 } 3926 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3927 for (i=0;i<pcis->n;i++) { 3928 if (array[i] > 0.0) { 3929 array[i] = 1.0/array[i]; 3930 } 3931 } 3932 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3933 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 3934 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3935 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3936 ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr); 3937 ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem SHOULD be %lf\n",coarsesum);CHKERRQ(ierr); 3938 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3939 } 3940 ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr); 3941 } 3942 3943 if (dbg_flag) { 3944 ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem is %d\n",pcbddc->coarse_size);CHKERRQ(ierr); 3945 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3946 } 3947 3948 im_active = 0; 3949 if (pcis->n) { im_active = 1; } 3950 ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr); 3951 3952 /* adapt coarse problem type */ 3953 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3954 if (pcbddc->current_level < pcbddc->max_levels) { 3955 if ((active_procs/pcbddc->coarsening_ratio) < 2) { 3956 if (dbg_flag) { 3957 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); 3958 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3959 } 3960 pcbddc->coarse_problem_type = PARALLEL_BDDC; 3961 } 3962 } else { 3963 if (dbg_flag) { 3964 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); 3965 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3966 } 3967 pcbddc->coarse_problem_type = PARALLEL_BDDC; 3968 } 3969 } 3970 3971 switch (pcbddc->coarse_problem_type) { 3972 3973 case(MULTILEVEL_BDDC): /* we define a coarse mesh where subdomains are elements */ 3974 { 3975 /* we need additional variables */ 3976 MetisInt n_subdomains,n_parts,objval,ncon,faces_nvtxs; 3977 MetisInt *metis_coarse_subdivision; 3978 MetisInt options[METIS_NOPTIONS]; 3979 PetscMPIInt size_coarse_comm,rank_coarse_comm; 3980 PetscMPIInt procs_jumps_coarse_comm; 3981 PetscMPIInt *coarse_subdivision; 3982 PetscMPIInt *total_count_recv; 3983 PetscMPIInt *total_ranks_recv; 3984 PetscMPIInt *displacements_recv; 3985 PetscMPIInt *my_faces_connectivity; 3986 PetscMPIInt *petsc_faces_adjncy; 3987 MetisInt *faces_adjncy; 3988 MetisInt *faces_xadj; 3989 PetscMPIInt *number_of_faces; 3990 PetscMPIInt *faces_displacements; 3991 PetscInt *array_int; 3992 PetscMPIInt my_faces=0; 3993 PetscMPIInt total_faces=0; 3994 PetscInt ranks_stretching_ratio; 3995 3996 /* define some quantities */ 3997 pcbddc->coarse_communications_type = SCATTERS_BDDC; 3998 coarse_mat_type = MATIS; 3999 coarse_pc_type = PCBDDC; 4000 coarse_ksp_type = KSPRICHARDSON; 4001 4002 /* details of coarse decomposition */ 4003 n_subdomains = active_procs; 4004 n_parts = n_subdomains/pcbddc->coarsening_ratio; 4005 ranks_stretching_ratio = size_prec_comm/active_procs; 4006 procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio; 4007 4008 #if 0 4009 PetscMPIInt *old_ranks; 4010 PetscInt *new_ranks,*jj,*ii; 4011 MatPartitioning mat_part; 4012 IS coarse_new_decomposition,is_numbering; 4013 PetscViewer viewer_test; 4014 MPI_Comm test_coarse_comm; 4015 PetscMPIInt test_coarse_color; 4016 Mat mat_adj; 4017 /* Create new communicator for coarse problem splitting the old one */ 4018 /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards) 4019 key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */ 4020 test_coarse_color = (im_active ? 0 : MPI_UNDEFINED); 4021 test_coarse_comm = MPI_COMM_NULL; 4022 ierr = MPI_Comm_split(prec_comm,test_coarse_color,rank_prec_comm,&test_coarse_comm);CHKERRQ(ierr); 4023 if (im_active) { 4024 ierr = PetscMalloc(n_subdomains*sizeof(PetscMPIInt),&old_ranks); 4025 ierr = PetscMalloc(size_prec_comm*sizeof(PetscInt),&new_ranks); 4026 ierr = MPI_Comm_rank(test_coarse_comm,&rank_coarse_comm);CHKERRQ(ierr); 4027 ierr = MPI_Comm_size(test_coarse_comm,&j);CHKERRQ(ierr); 4028 ierr = MPI_Allgather(&rank_prec_comm,1,MPIU_INT,old_ranks,1,MPIU_INT,test_coarse_comm);CHKERRQ(ierr); 4029 for (i=0;i<size_prec_comm;i++) { 4030 new_ranks[i] = -1; 4031 } 4032 for (i=0;i<n_subdomains;i++) { 4033 new_ranks[old_ranks[i]] = i; 4034 } 4035 ierr = PetscViewerASCIIOpen(test_coarse_comm,"test_mat_part.out",&viewer_test);CHKERRQ(ierr); 4036 k = pcis->n_neigh-1; 4037 ierr = PetscMalloc(2*sizeof(PetscInt),&ii); 4038 ii[0]=0; 4039 ii[1]=k; 4040 ierr = PetscMalloc(k*sizeof(PetscInt),&jj); 4041 for (i=0;i<k;i++) { 4042 jj[i]=new_ranks[pcis->neigh[i+1]]; 4043 } 4044 ierr = PetscSortInt(k,jj);CHKERRQ(ierr); 4045 ierr = MatCreateMPIAdj(test_coarse_comm,1,n_subdomains,ii,jj,PETSC_NULL,&mat_adj);CHKERRQ(ierr); 4046 ierr = MatView(mat_adj,viewer_test);CHKERRQ(ierr); 4047 ierr = MatPartitioningCreate(test_coarse_comm,&mat_part);CHKERRQ(ierr); 4048 ierr = MatPartitioningSetAdjacency(mat_part,mat_adj);CHKERRQ(ierr); 4049 ierr = MatPartitioningSetFromOptions(mat_part);CHKERRQ(ierr); 4050 printf("Setting Nparts %d\n",n_parts); 4051 ierr = MatPartitioningSetNParts(mat_part,n_parts);CHKERRQ(ierr); 4052 ierr = MatPartitioningView(mat_part,viewer_test);CHKERRQ(ierr); 4053 ierr = MatPartitioningApply(mat_part,&coarse_new_decomposition);CHKERRQ(ierr); 4054 ierr = ISView(coarse_new_decomposition,viewer_test);CHKERRQ(ierr); 4055 ierr = ISPartitioningToNumbering(coarse_new_decomposition,&is_numbering);CHKERRQ(ierr); 4056 ierr = ISView(is_numbering,viewer_test);CHKERRQ(ierr); 4057 ierr = PetscViewerDestroy(&viewer_test);CHKERRQ(ierr); 4058 ierr = ISDestroy(&coarse_new_decomposition);CHKERRQ(ierr); 4059 ierr = ISDestroy(&is_numbering);CHKERRQ(ierr); 4060 ierr = MatPartitioningDestroy(&mat_part);CHKERRQ(ierr); 4061 ierr = PetscFree(old_ranks);CHKERRQ(ierr); 4062 ierr = PetscFree(new_ranks);CHKERRQ(ierr); 4063 ierr = MPI_Comm_free(&test_coarse_comm);CHKERRQ(ierr); 4064 } 4065 #endif 4066 4067 /* build CSR graph of subdomains' connectivity */ 4068 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr); 4069 ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr); 4070 for (i=1;i<pcis->n_neigh;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */ 4071 for (j=0;j<pcis->n_shared[i];j++) { 4072 array_int[ pcis->shared[i][j] ]+=1; 4073 } 4074 } 4075 for (i=1;i<pcis->n_neigh;i++) { 4076 for (j=0;j<pcis->n_shared[i];j++) { 4077 if (array_int[ pcis->shared[i][j] ] > 0) { 4078 my_faces++; 4079 break; 4080 } 4081 } 4082 } 4083 4084 ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr); 4085 ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr); 4086 my_faces=0; 4087 for (i=1;i<pcis->n_neigh;i++) { 4088 for (j=0;j<pcis->n_shared[i];j++) { 4089 if (array_int[ pcis->shared[i][j] ] > 0) { 4090 my_faces_connectivity[my_faces]=pcis->neigh[i]; 4091 my_faces++; 4092 break; 4093 } 4094 } 4095 } 4096 if (rank_prec_comm == master_proc) { 4097 ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr); 4098 ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr); 4099 ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr); 4100 ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr); 4101 ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr); 4102 } 4103 ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr); 4104 if (rank_prec_comm == master_proc) { 4105 faces_xadj[0]=0; 4106 faces_displacements[0]=0; 4107 j=0; 4108 for (i=1;i<size_prec_comm+1;i++) { 4109 faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1]; 4110 if (number_of_faces[i-1]) { 4111 j++; 4112 faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1]; 4113 } 4114 } 4115 } 4116 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); 4117 ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr); 4118 ierr = PetscFree(array_int);CHKERRQ(ierr); 4119 if (rank_prec_comm == master_proc) { 4120 for (i=0;i<total_faces;i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */ 4121 ierr = PetscFree(faces_displacements);CHKERRQ(ierr); 4122 ierr = PetscFree(number_of_faces);CHKERRQ(ierr); 4123 ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr); 4124 } 4125 4126 if (rank_prec_comm == master_proc) { 4127 PetscInt heuristic_for_metis=3; 4128 ncon=1; 4129 faces_nvtxs=n_subdomains; 4130 /* partition graoh induced by face connectivity */ 4131 ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr); 4132 ierr = METIS_SetDefaultOptions(options); 4133 /* we need a contiguous partition of the coarse mesh */ 4134 options[METIS_OPTION_CONTIG]=1; 4135 options[METIS_OPTION_NITER]=30; 4136 if (pcbddc->coarsening_ratio > 1) { 4137 if (n_subdomains>n_parts*heuristic_for_metis) { 4138 options[METIS_OPTION_IPTYPE]=METIS_IPTYPE_EDGE; 4139 options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT; 4140 ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision); 4141 if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphKway (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr); 4142 } else { 4143 ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision); 4144 if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphRecursive (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr); 4145 } 4146 } else { 4147 for (i=0;i<n_subdomains;i++) { 4148 metis_coarse_subdivision[i]=i; 4149 } 4150 } 4151 ierr = PetscFree(faces_xadj);CHKERRQ(ierr); 4152 ierr = PetscFree(faces_adjncy);CHKERRQ(ierr); 4153 ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr); 4154 /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */ 4155 for (i=0;i<size_prec_comm;i++) { coarse_subdivision[i]=MPI_PROC_NULL; } 4156 for (i=0;i<n_subdomains;i++) { coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]); } 4157 ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr); 4158 } 4159 4160 /* Create new communicator for coarse problem splitting the old one */ 4161 if (!(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts) { 4162 coarse_color=0; /* for communicator splitting */ 4163 active_rank=rank_prec_comm; /* for insertion of matrix values */ 4164 } 4165 /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards) 4166 key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */ 4167 ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr); 4168 4169 if (coarse_color == 0) { 4170 ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr); 4171 ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr); 4172 } else { 4173 rank_coarse_comm = MPI_PROC_NULL; 4174 } 4175 4176 /* master proc take care of arranging and distributing coarse information */ 4177 if (rank_coarse_comm == master_proc) { 4178 ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr); 4179 ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr); 4180 ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr); 4181 /* some initializations */ 4182 displacements_recv[0]=0; 4183 ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr); 4184 /* count from how many processes the j-th process of the coarse decomposition will receive data */ 4185 for (j=0;j<size_coarse_comm;j++) { 4186 for (i=0;i<size_prec_comm;i++) { 4187 if (coarse_subdivision[i]==j) { 4188 total_count_recv[j]++; 4189 } 4190 } 4191 } 4192 /* displacements needed for scatterv of total_ranks_recv */ 4193 for (i=1;i<size_coarse_comm;i++) { displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1]; } 4194 /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */ 4195 ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr); 4196 for (j=0;j<size_coarse_comm;j++) { 4197 for (i=0;i<size_prec_comm;i++) { 4198 if (coarse_subdivision[i]==j) { 4199 total_ranks_recv[displacements_recv[j]+total_count_recv[j]]=i; 4200 total_count_recv[j]+=1; 4201 } 4202 } 4203 } 4204 /* for (j=0;j<size_coarse_comm;j++) { 4205 printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]); 4206 for (i=0;i<total_count_recv[j];i++) { 4207 printf("%d ",total_ranks_recv[displacements_recv[j]+i]); 4208 } 4209 printf("\n"); 4210 } */ 4211 4212 /* identify new decomposition in terms of ranks in the old communicator */ 4213 for (i=0;i<n_subdomains;i++) { 4214 coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm; 4215 } 4216 /* printf("coarse_subdivision in old end new ranks\n"); 4217 for (i=0;i<size_prec_comm;i++) 4218 if (coarse_subdivision[i]!=MPI_PROC_NULL) { 4219 printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm); 4220 } else { 4221 printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]); 4222 } 4223 printf("\n"); */ 4224 } 4225 4226 /* Scatter new decomposition for send details */ 4227 ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr); 4228 /* Scatter receiving details to members of coarse decomposition */ 4229 if (coarse_color == 0) { 4230 ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr); 4231 ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr); 4232 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); 4233 } 4234 4235 /* printf("I will send my matrix data to proc %d\n",rank_coarse_proc_send_to); 4236 if (coarse_color == 0) { 4237 printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv); 4238 for (i=0;i<count_recv;i++) 4239 printf("%d ",ranks_recv[i]); 4240 printf("\n"); 4241 } */ 4242 4243 if (rank_prec_comm == master_proc) { 4244 ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr); 4245 ierr = PetscFree(total_count_recv);CHKERRQ(ierr); 4246 ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr); 4247 ierr = PetscFree(displacements_recv);CHKERRQ(ierr); 4248 } 4249 break; 4250 } 4251 4252 case(REPLICATED_BDDC): 4253 4254 pcbddc->coarse_communications_type = GATHERS_BDDC; 4255 coarse_mat_type = MATSEQAIJ; 4256 coarse_pc_type = PCLU; 4257 coarse_ksp_type = KSPPREONLY; 4258 coarse_comm = PETSC_COMM_SELF; 4259 active_rank = rank_prec_comm; 4260 break; 4261 4262 case(PARALLEL_BDDC): 4263 4264 pcbddc->coarse_communications_type = SCATTERS_BDDC; 4265 coarse_mat_type = MATMPIAIJ; 4266 coarse_pc_type = PCREDUNDANT; 4267 coarse_ksp_type = KSPPREONLY; 4268 coarse_comm = prec_comm; 4269 active_rank = rank_prec_comm; 4270 break; 4271 4272 case(SEQUENTIAL_BDDC): 4273 pcbddc->coarse_communications_type = GATHERS_BDDC; 4274 coarse_mat_type = MATSEQAIJ; 4275 coarse_pc_type = PCLU; 4276 coarse_ksp_type = KSPPREONLY; 4277 coarse_comm = PETSC_COMM_SELF; 4278 active_rank = master_proc; 4279 break; 4280 } 4281 4282 switch (pcbddc->coarse_communications_type) { 4283 4284 case(SCATTERS_BDDC): 4285 { 4286 if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) { 4287 4288 IS coarse_IS; 4289 4290 if (pcbddc->coarsening_ratio == 1) { 4291 ins_local_primal_size = pcbddc->local_primal_size; 4292 ins_local_primal_indices = pcbddc->local_primal_indices; 4293 if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); } 4294 /* nonzeros */ 4295 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr); 4296 ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr); 4297 for (i=0;i<ins_local_primal_size;i++) { 4298 dnz[i] = ins_local_primal_size; 4299 } 4300 } else { 4301 PetscMPIInt send_size; 4302 PetscMPIInt *send_buffer; 4303 PetscInt *aux_ins_indices; 4304 PetscInt ii,jj; 4305 MPI_Request *requests; 4306 4307 ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr); 4308 /* reusing pcbddc->local_primal_displacements and pcbddc->replicated_primal_size */ 4309 ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr); 4310 ierr = PetscMalloc((count_recv+1)*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr); 4311 pcbddc->replicated_primal_size = count_recv; 4312 j = 0; 4313 for (i=0;i<count_recv;i++) { 4314 pcbddc->local_primal_displacements[i] = j; 4315 j += pcbddc->local_primal_sizes[ranks_recv[i]]; 4316 } 4317 pcbddc->local_primal_displacements[count_recv] = j; 4318 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 4319 /* allocate auxiliary space */ 4320 ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr); 4321 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr); 4322 ierr = PetscMemzero(aux_ins_indices,pcbddc->coarse_size*sizeof(PetscInt));CHKERRQ(ierr); 4323 /* allocate stuffs for message massing */ 4324 ierr = PetscMalloc((count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr); 4325 for (i=0;i<count_recv+1;i++) { requests[i]=MPI_REQUEST_NULL; } 4326 /* send indices to be inserted */ 4327 for (i=0;i<count_recv;i++) { 4328 send_size = pcbddc->local_primal_sizes[ranks_recv[i]]; 4329 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); 4330 } 4331 if (rank_coarse_proc_send_to != MPI_PROC_NULL) { 4332 send_size = pcbddc->local_primal_size; 4333 ierr = PetscMalloc(send_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr); 4334 for (i=0;i<send_size;i++) { 4335 send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i]; 4336 } 4337 ierr = MPI_Isend(send_buffer,send_size,MPIU_INT,rank_coarse_proc_send_to,999,prec_comm,&requests[count_recv]);CHKERRQ(ierr); 4338 } 4339 ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4340 if (rank_coarse_proc_send_to != MPI_PROC_NULL) { 4341 ierr = PetscFree(send_buffer);CHKERRQ(ierr); 4342 } 4343 j = 0; 4344 for (i=0;i<count_recv;i++) { 4345 ii = pcbddc->local_primal_displacements[i+1]-pcbddc->local_primal_displacements[i]; 4346 localsizes2[i] = ii*ii; 4347 localdispl2[i] = j; 4348 j += localsizes2[i]; 4349 jj = pcbddc->local_primal_displacements[i]; 4350 /* it counts the coarse subdomains sharing the coarse node */ 4351 for (k=0;k<ii;k++) { 4352 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]] += 1; 4353 } 4354 } 4355 /* temp_coarse_mat_vals used to store matrix values to be received */ 4356 ierr = PetscMalloc(j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr); 4357 /* evaluate how many values I will insert in coarse mat */ 4358 ins_local_primal_size = 0; 4359 for (i=0;i<pcbddc->coarse_size;i++) { 4360 if (aux_ins_indices[i]) { 4361 ins_local_primal_size++; 4362 } 4363 } 4364 /* evaluate indices I will insert in coarse mat */ 4365 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4366 j = 0; 4367 for (i=0;i<pcbddc->coarse_size;i++) { 4368 if (aux_ins_indices[i]) { 4369 ins_local_primal_indices[j] = i; 4370 j++; 4371 } 4372 } 4373 /* processes partecipating in coarse problem receive matrix data from their friends */ 4374 for (i=0;i<count_recv;i++) { 4375 ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr); 4376 } 4377 if (rank_coarse_proc_send_to != MPI_PROC_NULL) { 4378 send_size = pcbddc->local_primal_size*pcbddc->local_primal_size; 4379 ierr = MPI_Isend(&coarse_submat_vals[0],send_size,MPIU_SCALAR,rank_coarse_proc_send_to,666,prec_comm,&requests[count_recv]);CHKERRQ(ierr); 4380 } 4381 ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4382 /* nonzeros */ 4383 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr); 4384 ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr); 4385 /* use aux_ins_indices to realize a global to local mapping */ 4386 j=0; 4387 for (i=0;i<pcbddc->coarse_size;i++) { 4388 if (aux_ins_indices[i]==0) { 4389 aux_ins_indices[i]=-1; 4390 } else { 4391 aux_ins_indices[i]=j; 4392 j++; 4393 } 4394 } 4395 for (i=0;i<count_recv;i++) { 4396 j = pcbddc->local_primal_sizes[ranks_recv[i]]; 4397 for (k=0;k<j;k++) { 4398 dnz[aux_ins_indices[pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]+k]]] += j; 4399 } 4400 } 4401 /* check */ 4402 for (i=0;i<ins_local_primal_size;i++) { 4403 if (dnz[i] > ins_local_primal_size) { 4404 dnz[i] = ins_local_primal_size; 4405 } 4406 } 4407 ierr = PetscFree(requests);CHKERRQ(ierr); 4408 ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr); 4409 if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); } 4410 } 4411 /* create local to global mapping needed by coarse MATIS */ 4412 if (coarse_comm != MPI_COMM_NULL) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);} 4413 coarse_comm = prec_comm; 4414 active_rank = rank_prec_comm; 4415 ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr); 4416 ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr); 4417 ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr); 4418 } else if (pcbddc->coarse_problem_type==PARALLEL_BDDC) { 4419 /* arrays for values insertion */ 4420 ins_local_primal_size = pcbddc->local_primal_size; 4421 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4422 ierr = PetscMalloc(ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr); 4423 for (j=0;j<ins_local_primal_size;j++) { 4424 ins_local_primal_indices[j]=pcbddc->local_primal_indices[j]; 4425 for (i=0;i<ins_local_primal_size;i++) { 4426 ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i]; 4427 } 4428 } 4429 } 4430 break; 4431 4432 } 4433 4434 case(GATHERS_BDDC): 4435 { 4436 4437 PetscMPIInt mysize,mysize2; 4438 PetscMPIInt *send_buffer; 4439 4440 if (rank_prec_comm==active_rank) { 4441 ierr = PetscMalloc (pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 4442 ierr = PetscMalloc (pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr); 4443 ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr); 4444 ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr); 4445 /* arrays for values insertion */ 4446 for (i=0;i<size_prec_comm;i++) { localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i]; } 4447 localdispl2[0]=0; 4448 for (i=1;i<size_prec_comm;i++) { localdispl2[i]=localsizes2[i-1]+localdispl2[i-1]; } 4449 j=0; 4450 for (i=0;i<size_prec_comm;i++) { j+=localsizes2[i]; } 4451 ierr = PetscMalloc (j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr); 4452 } 4453 4454 mysize=pcbddc->local_primal_size; 4455 mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size; 4456 ierr = PetscMalloc(mysize*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr); 4457 for (i=0;i<mysize;i++) { 4458 send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i]; 4459 } 4460 if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC) { 4461 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); 4462 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); 4463 } else { 4464 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); 4465 ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr); 4466 } 4467 ierr = PetscFree(send_buffer);CHKERRQ(ierr); 4468 break; 4469 }/* switch on coarse problem and communications associated with finished */ 4470 } 4471 4472 /* Now create and fill up coarse matrix */ 4473 if (rank_prec_comm == active_rank) { 4474 4475 Mat matis_coarse_local_mat; 4476 4477 if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) { 4478 ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr); 4479 ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size);CHKERRQ(ierr); 4480 ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr); 4481 ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr); 4482 ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */ 4483 ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); 4484 } else { 4485 ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr); 4486 ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr); 4487 ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr); 4488 ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr); 4489 ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */ 4490 ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); 4491 } 4492 /* preallocation */ 4493 if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) { 4494 4495 PetscInt lrows,lcols; 4496 4497 ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr); 4498 ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr); 4499 4500 if (pcbddc->coarse_problem_type == PARALLEL_BDDC) { 4501 4502 Vec vec_dnz,vec_onz; 4503 PetscScalar *my_dnz,*my_onz,*array; 4504 PetscInt *mat_ranges,*row_ownership; 4505 PetscInt coarse_index_row,coarse_index_col,owner; 4506 4507 ierr = VecCreate(prec_comm,&vec_dnz);CHKERRQ(ierr); 4508 ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,pcbddc->coarse_size);CHKERRQ(ierr); 4509 ierr = VecSetType(vec_dnz,VECMPI);CHKERRQ(ierr); 4510 ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr); 4511 4512 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_dnz);CHKERRQ(ierr); 4513 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_onz);CHKERRQ(ierr); 4514 ierr = PetscMemzero(my_dnz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr); 4515 ierr = PetscMemzero(my_onz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr); 4516 4517 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&row_ownership);CHKERRQ(ierr); 4518 ierr = MatGetOwnershipRanges(pcbddc->coarse_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr); 4519 for (i=0;i<size_prec_comm;i++) { 4520 for (j=mat_ranges[i];j<mat_ranges[i+1];j++) { 4521 row_ownership[j]=i; 4522 } 4523 } 4524 4525 for (i=0;i<pcbddc->local_primal_size;i++) { 4526 coarse_index_row = pcbddc->local_primal_indices[i]; 4527 owner = row_ownership[coarse_index_row]; 4528 for (j=i;j<pcbddc->local_primal_size;j++) { 4529 owner = row_ownership[coarse_index_row]; 4530 coarse_index_col = pcbddc->local_primal_indices[j]; 4531 if (coarse_index_col > mat_ranges[owner]-1 && coarse_index_col < mat_ranges[owner+1]) { 4532 my_dnz[i] += 1.0; 4533 } else { 4534 my_onz[i] += 1.0; 4535 } 4536 if (i != j) { 4537 owner = row_ownership[coarse_index_col]; 4538 if (coarse_index_row > mat_ranges[owner]-1 && coarse_index_row < mat_ranges[owner+1]) { 4539 my_dnz[j] += 1.0; 4540 } else { 4541 my_onz[j] += 1.0; 4542 } 4543 } 4544 } 4545 } 4546 ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr); 4547 ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr); 4548 if (pcbddc->local_primal_size) { 4549 ierr = VecSetValues(vec_dnz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr); 4550 ierr = VecSetValues(vec_onz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_onz,ADD_VALUES);CHKERRQ(ierr); 4551 } 4552 ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr); 4553 ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr); 4554 ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr); 4555 ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr); 4556 j = mat_ranges[rank_prec_comm+1]-mat_ranges[rank_prec_comm]; 4557 ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr); 4558 for (i=0;i<j;i++) { 4559 dnz[i] = (PetscInt)array[i]; 4560 } 4561 ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr); 4562 ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr); 4563 for (i=0;i<j;i++) { 4564 onz[i] = (PetscInt)array[i]; 4565 } 4566 ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr); 4567 ierr = PetscFree(my_dnz);CHKERRQ(ierr); 4568 ierr = PetscFree(my_onz);CHKERRQ(ierr); 4569 ierr = PetscFree(row_ownership);CHKERRQ(ierr); 4570 ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr); 4571 ierr = VecDestroy(&vec_onz);CHKERRQ(ierr); 4572 } else { 4573 for (k=0;k<size_prec_comm;k++) { 4574 offset=pcbddc->local_primal_displacements[k]; 4575 offset2=localdispl2[k]; 4576 ins_local_primal_size = pcbddc->local_primal_sizes[k]; 4577 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4578 for (j=0;j<ins_local_primal_size;j++) { 4579 ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j]; 4580 } 4581 for (j=0;j<ins_local_primal_size;j++) { 4582 ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr); 4583 } 4584 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4585 } 4586 } 4587 /* check */ 4588 for (i=0;i<lrows;i++) { 4589 if (dnz[i]>lcols) { 4590 dnz[i]=lcols; 4591 } 4592 if (onz[i]>pcbddc->coarse_size-lcols) { 4593 onz[i]=pcbddc->coarse_size-lcols; 4594 } 4595 } 4596 ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,PETSC_NULL,dnz);CHKERRQ(ierr); 4597 ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,PETSC_NULL,dnz,PETSC_NULL,onz);CHKERRQ(ierr); 4598 ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr); 4599 } else { 4600 ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,0,dnz);CHKERRQ(ierr); 4601 ierr = PetscFree(dnz);CHKERRQ(ierr); 4602 } 4603 /* insert values */ 4604 if (pcbddc->coarse_problem_type == PARALLEL_BDDC) { 4605 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); 4606 } else if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4607 if (pcbddc->coarsening_ratio == 1) { 4608 ins_coarse_mat_vals = coarse_submat_vals; 4609 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); 4610 } else { 4611 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4612 for (k=0;k<pcbddc->replicated_primal_size;k++) { 4613 offset = pcbddc->local_primal_displacements[k]; 4614 offset2 = localdispl2[k]; 4615 ins_local_primal_size = pcbddc->local_primal_displacements[k+1]-pcbddc->local_primal_displacements[k]; 4616 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4617 for (j=0;j<ins_local_primal_size;j++) { 4618 ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j]; 4619 } 4620 ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2]; 4621 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); 4622 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4623 } 4624 } 4625 ins_local_primal_indices = 0; 4626 ins_coarse_mat_vals = 0; 4627 } else { 4628 for (k=0;k<size_prec_comm;k++) { 4629 offset=pcbddc->local_primal_displacements[k]; 4630 offset2=localdispl2[k]; 4631 ins_local_primal_size = pcbddc->local_primal_sizes[k]; 4632 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4633 for (j=0;j<ins_local_primal_size;j++) { 4634 ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j]; 4635 } 4636 ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2]; 4637 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); 4638 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4639 } 4640 ins_local_primal_indices = 0; 4641 ins_coarse_mat_vals = 0; 4642 } 4643 ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 4644 ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 4645 /* symmetry of coarse matrix */ 4646 if (issym) { 4647 ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr); 4648 } 4649 ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr); 4650 } 4651 4652 /* create loc to glob scatters if needed */ 4653 if (pcbddc->coarse_communications_type == SCATTERS_BDDC) { 4654 IS local_IS,global_IS; 4655 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr); 4656 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr); 4657 ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 4658 ierr = ISDestroy(&local_IS);CHKERRQ(ierr); 4659 ierr = ISDestroy(&global_IS);CHKERRQ(ierr); 4660 } 4661 4662 /* free memory no longer needed */ 4663 if (coarse_ISLG) { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); } 4664 if (ins_local_primal_indices) { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); } 4665 if (ins_coarse_mat_vals) { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr); } 4666 if (localsizes2) { ierr = PetscFree(localsizes2);CHKERRQ(ierr); } 4667 if (localdispl2) { ierr = PetscFree(localdispl2);CHKERRQ(ierr); } 4668 if (temp_coarse_mat_vals) { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr); } 4669 4670 /* Eval coarse null space */ 4671 if (pcbddc->NullSpace) { 4672 const Vec *nsp_vecs; 4673 PetscInt nsp_size,coarse_nsp_size; 4674 PetscBool nsp_has_cnst; 4675 PetscReal test_null; 4676 Vec *coarse_nsp_vecs; 4677 4678 coarse_nsp_size = 0; 4679 coarse_nsp_vecs = 0; 4680 ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr); 4681 if (rank_prec_comm == active_rank) { 4682 ierr = PetscMalloc((nsp_size+1)*sizeof(Vec),&coarse_nsp_vecs);CHKERRQ(ierr); 4683 for (i=0;i<nsp_size+1;i++) { 4684 ierr = VecDuplicate(pcbddc->coarse_vec,&coarse_nsp_vecs[i]);CHKERRQ(ierr); 4685 } 4686 } 4687 if (nsp_has_cnst) { 4688 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 4689 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 4690 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4691 ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4692 if (rank_prec_comm == active_rank) { 4693 ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4694 ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&test_null);CHKERRQ(ierr); 4695 if (test_null > 1.0e-12 && pcbddc->dbg_flag) { 4696 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Constant coarse null space error % 1.14e\n",test_null);CHKERRQ(ierr); 4697 } 4698 ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr); 4699 coarse_nsp_size++; 4700 } 4701 } 4702 for (i=0;i<nsp_size;i++) { 4703 ierr = VecScatterBegin(matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4704 ierr = VecScatterEnd (matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4705 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 4706 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4707 ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4708 if (rank_prec_comm == active_rank) { 4709 ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4710 ierr = VecNorm(pcbddc->coarse_rhs,NORM_2,&test_null);CHKERRQ(ierr); 4711 if (test_null > 1.0e-12 && pcbddc->dbg_flag) { 4712 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Vec %d coarse null space error % 1.14e\n",i,test_null);CHKERRQ(ierr); 4713 } 4714 ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr); 4715 coarse_nsp_size++; 4716 } 4717 } 4718 if (coarse_nsp_size > 0) { 4719 /* TODO orthonormalize vecs */ 4720 ierr = VecNormalize(coarse_nsp_vecs[0],PETSC_NULL);CHKERRQ(ierr); 4721 ierr = MatNullSpaceCreate(coarse_comm,PETSC_FALSE,coarse_nsp_size,coarse_nsp_vecs,&pcbddc->CoarseNullSpace);CHKERRQ(ierr); 4722 for (i=0;i<nsp_size+1;i++) { 4723 ierr = VecDestroy(&coarse_nsp_vecs[i]);CHKERRQ(ierr); 4724 } 4725 } 4726 ierr = PetscFree(coarse_nsp_vecs);CHKERRQ(ierr); 4727 } 4728 4729 /* KSP for coarse problem */ 4730 if (rank_prec_comm == active_rank) { 4731 PetscBool isbddc=PETSC_FALSE; 4732 4733 ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr); 4734 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr); 4735 ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 4736 ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr); 4737 ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr); 4738 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 4739 ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr); 4740 /* Allow user's customization */ 4741 ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr); 4742 /* Set Up PC for coarse problem BDDC */ 4743 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4744 i = pcbddc->current_level+1; 4745 ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr); 4746 ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr); 4747 ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr); 4748 ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr); 4749 if (pcbddc->CoarseNullSpace) { ierr = PCBDDCSetNullSpace(pc_temp,pcbddc->CoarseNullSpace);CHKERRQ(ierr); } 4750 if (dbg_flag) { 4751 ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr); 4752 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 4753 } 4754 } 4755 ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr); 4756 ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr); 4757 4758 ierr = KSPGetTolerances(pcbddc->coarse_ksp,PETSC_NULL,PETSC_NULL,PETSC_NULL,&j);CHKERRQ(ierr); 4759 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 4760 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 4761 if (j == 1) { 4762 ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr); 4763 if (isbddc) { 4764 ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr); 4765 } 4766 } 4767 } 4768 /* Check coarse problem if requested */ 4769 if (dbg_flag && rank_prec_comm == active_rank) { 4770 KSP check_ksp; 4771 PC check_pc; 4772 Vec check_vec; 4773 PetscReal abs_infty_error,infty_error,lambda_min,lambda_max; 4774 KSPType check_ksp_type; 4775 4776 /* Create ksp object suitable for extreme eigenvalues' estimation */ 4777 ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr); 4778 ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 4779 ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr); 4780 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4781 if (issym) { 4782 check_ksp_type = KSPCG; 4783 } else { 4784 check_ksp_type = KSPGMRES; 4785 } 4786 ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr); 4787 } else { 4788 check_ksp_type = KSPPREONLY; 4789 } 4790 ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr); 4791 ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr); 4792 ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr); 4793 ierr = KSPSetUp(check_ksp);CHKERRQ(ierr); 4794 /* create random vec */ 4795 ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr); 4796 ierr = VecSetRandom(check_vec,PETSC_NULL);CHKERRQ(ierr); 4797 if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,check_vec,PETSC_NULL);CHKERRQ(ierr); } 4798 ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4799 /* solve coarse problem */ 4800 ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr); 4801 if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_vec,PETSC_NULL);CHKERRQ(ierr); } 4802 /* check coarse problem residual error */ 4803 ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr); 4804 ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr); 4805 ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4806 ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr); 4807 ierr = VecDestroy(&check_vec);CHKERRQ(ierr); 4808 /* get eigenvalue estimation if inexact */ 4809 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4810 ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr); 4811 ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr); 4812 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr); 4813 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr); 4814 } 4815 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error : %1.14e\n",infty_error);CHKERRQ(ierr); 4816 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr); 4817 ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr); 4818 } 4819 if (dbg_flag) { ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); } 4820 4821 PetscFunctionReturn(0); 4822 } 4823 4824 #undef __FUNCT__ 4825 #define __FUNCT__ "PCBDDCManageLocalBoundaries" 4826 static PetscErrorCode PCBDDCManageLocalBoundaries(PC pc) 4827 { 4828 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 4829 PC_IS *pcis = (PC_IS*)pc->data; 4830 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 4831 PCBDDCGraph mat_graph=pcbddc->mat_graph; 4832 PetscInt *is_indices,*auxis; 4833 PetscInt bs,ierr,i,j,s,k,iindex,neumann_bsize,dirichlet_bsize; 4834 PetscInt total_counts,nodes_touched,where_values=1,vertex_size; 4835 PetscMPIInt adapt_interface=0,adapt_interface_reduced=0,NEUMANNCNT=0; 4836 PetscBool same_set; 4837 MPI_Comm interface_comm=((PetscObject)pc)->comm; 4838 PetscBool use_faces=PETSC_FALSE,use_edges=PETSC_FALSE; 4839 const PetscInt *neumann_nodes; 4840 const PetscInt *dirichlet_nodes; 4841 IS used_IS,*custom_ISForDofs; 4842 PetscScalar *array; 4843 PetscScalar *array2; 4844 PetscViewer viewer=pcbddc->dbg_viewer; 4845 PetscInt *queue_in_global_numbering; 4846 4847 PetscFunctionBegin; 4848 /* Setup local adjacency graph */ 4849 mat_graph->nvtxs=pcis->n; 4850 if (!mat_graph->xadj) { NEUMANNCNT = 1; } 4851 ierr = PCBDDCSetupLocalAdjacencyGraph(pc);CHKERRQ(ierr); 4852 i = mat_graph->nvtxs; 4853 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); 4854 ierr = PetscMalloc2(i,PetscInt,&mat_graph->which_dof,i,PetscBool,&mat_graph->touched);CHKERRQ(ierr); 4855 ierr = PetscMemzero(mat_graph->where,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4856 ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4857 ierr = PetscMemzero(mat_graph->which_dof,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4858 ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4859 ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr); 4860 4861 /* Setting dofs splitting in mat_graph->which_dof 4862 Get information about dofs' splitting if provided by the user 4863 Otherwise it assumes a constant block size */ 4864 vertex_size=0; 4865 if (!pcbddc->n_ISForDofs) { 4866 ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr); 4867 ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr); 4868 for (i=0;i<bs;i++) { 4869 ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr); 4870 } 4871 ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr); 4872 vertex_size=1; 4873 /* remove my references to IS objects */ 4874 for (i=0;i<bs;i++) { 4875 ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr); 4876 } 4877 ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr); 4878 } 4879 for (i=0;i<pcbddc->n_ISForDofs;i++) { 4880 ierr = ISGetSize(pcbddc->ISForDofs[i],&k);CHKERRQ(ierr); 4881 ierr = ISGetIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr); 4882 for (j=0;j<k;j++) { 4883 mat_graph->which_dof[is_indices[j]]=i; 4884 } 4885 ierr = ISRestoreIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr); 4886 } 4887 /* use mat block size as vertex size if it has not yet set */ 4888 if (!vertex_size) { 4889 ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr); 4890 } 4891 4892 /* count number of neigh per node */ 4893 total_counts=0; 4894 for (i=1;i<pcis->n_neigh;i++) { 4895 s=pcis->n_shared[i]; 4896 total_counts+=s; 4897 for (j=0;j<s;j++) { 4898 mat_graph->count[pcis->shared[i][j]] += 1; 4899 } 4900 } 4901 /* Take into account Neumann data -> it increments number of sharing subdomains for nodes lying on the interface */ 4902 ierr = PCBDDCGetNeumannBoundaries(pc,&used_IS);CHKERRQ(ierr); 4903 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 4904 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4905 if (used_IS) { 4906 ierr = ISGetSize(used_IS,&neumann_bsize);CHKERRQ(ierr); 4907 ierr = ISGetIndices(used_IS,&neumann_nodes);CHKERRQ(ierr); 4908 for (i=0;i<neumann_bsize;i++) { 4909 iindex = neumann_nodes[i]; 4910 if (mat_graph->count[iindex] > NEUMANNCNT && array[iindex]==0.0) { 4911 mat_graph->count[iindex]+=1; 4912 total_counts++; 4913 array[iindex]=array[iindex]+1.0; 4914 } 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); 4915 } 4916 } 4917 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4918 /* allocate space for storing the set of neighbours for each node */ 4919 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt*),&mat_graph->neighbours_set);CHKERRQ(ierr); 4920 if (mat_graph->nvtxs) { ierr = PetscMalloc(total_counts*sizeof(PetscInt),&mat_graph->neighbours_set[0]);CHKERRQ(ierr); } 4921 for (i=1;i<mat_graph->nvtxs;i++) mat_graph->neighbours_set[i]=mat_graph->neighbours_set[i-1]+mat_graph->count[i-1]; 4922 ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4923 for (i=1;i<pcis->n_neigh;i++) { 4924 s=pcis->n_shared[i]; 4925 for (j=0;j<s;j++) { 4926 k=pcis->shared[i][j]; 4927 mat_graph->neighbours_set[k][mat_graph->count[k]] = pcis->neigh[i]; 4928 mat_graph->count[k]+=1; 4929 } 4930 } 4931 /* Check consistency of Neumann nodes */ 4932 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 4933 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4934 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4935 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4936 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4937 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4938 /* set -1 fake neighbour to mimic Neumann boundary */ 4939 if (used_IS) { 4940 for (i=0;i<neumann_bsize;i++) { 4941 iindex = neumann_nodes[i]; 4942 if (mat_graph->count[iindex] > NEUMANNCNT) { 4943 if (mat_graph->count[iindex]+1 != (PetscInt)array[iindex]) { 4944 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]); 4945 } 4946 mat_graph->neighbours_set[iindex][mat_graph->count[iindex]] = -1; 4947 mat_graph->count[iindex]+=1; 4948 } 4949 } 4950 ierr = ISRestoreIndices(used_IS,&neumann_nodes);CHKERRQ(ierr); 4951 } 4952 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4953 /* sort set of sharing subdomains */ 4954 for (i=0;i<mat_graph->nvtxs;i++) { ierr = PetscSortInt(mat_graph->count[i],mat_graph->neighbours_set[i]);CHKERRQ(ierr); } 4955 /* remove interior nodes and dirichlet boundary nodes from the next search into the graph */ 4956 for (i=0;i<mat_graph->nvtxs;i++) {mat_graph->touched[i]=PETSC_FALSE;} 4957 nodes_touched=0; 4958 ierr = PCBDDCGetDirichletBoundaries(pc,&used_IS);CHKERRQ(ierr); 4959 ierr = VecSet(pcis->vec2_N,0.0);CHKERRQ(ierr); 4960 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4961 ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 4962 if (used_IS) { 4963 ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr); 4964 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"); 4965 ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 4966 for (i=0;i<dirichlet_bsize;i++) { 4967 iindex=dirichlet_nodes[i]; 4968 if (mat_graph->count[iindex] && !mat_graph->touched[iindex]) { 4969 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); 4970 mat_graph->touched[iindex]=PETSC_TRUE; 4971 mat_graph->where[iindex]=0; 4972 nodes_touched++; 4973 array2[iindex]=array2[iindex]+1.0; 4974 } 4975 } 4976 ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 4977 } 4978 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4979 ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 4980 /* Check consistency of Dirichlet nodes */ 4981 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 4982 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 4983 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4984 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4985 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4986 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4987 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 4988 ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4989 ierr = VecScatterEnd (matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4990 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4991 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4992 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4993 ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 4994 if (used_IS) { 4995 ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr); 4996 ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 4997 for (i=0;i<dirichlet_bsize;i++) { 4998 iindex=dirichlet_nodes[i]; 4999 if (array[iindex]>1.0 && array[iindex]!=array2[iindex]) { 5000 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]); 5001 } 5002 } 5003 ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 5004 } 5005 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 5006 ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 5007 5008 for (i=0;i<mat_graph->nvtxs;i++) { 5009 if (!mat_graph->count[i]) { /* interior nodes */ 5010 mat_graph->touched[i]=PETSC_TRUE; 5011 mat_graph->where[i]=0; 5012 nodes_touched++; 5013 } 5014 } 5015 mat_graph->ncmps = 0; 5016 i=0; 5017 while (nodes_touched<mat_graph->nvtxs) { 5018 /* find first untouched node in local ordering */ 5019 while (mat_graph->touched[i]) i++; 5020 mat_graph->touched[i]=PETSC_TRUE; 5021 mat_graph->where[i]=where_values; 5022 nodes_touched++; 5023 /* now find all other nodes having the same set of sharing subdomains */ 5024 for (j=i+1;j<mat_graph->nvtxs;j++) { 5025 /* check for same number of sharing subdomains and dof number */ 5026 if (!mat_graph->touched[j] && mat_graph->count[i]==mat_graph->count[j] && mat_graph->which_dof[i] == mat_graph->which_dof[j]) { 5027 /* check for same set of sharing subdomains */ 5028 same_set=PETSC_TRUE; 5029 for (k=0;k<mat_graph->count[j];k++) { 5030 if (mat_graph->neighbours_set[i][k]!=mat_graph->neighbours_set[j][k]) { 5031 same_set=PETSC_FALSE; 5032 } 5033 } 5034 /* I found a friend of mine */ 5035 if (same_set) { 5036 mat_graph->where[j]=where_values; 5037 mat_graph->touched[j]=PETSC_TRUE; 5038 nodes_touched++; 5039 } 5040 } 5041 } 5042 where_values++; 5043 } 5044 where_values--; if (where_values<0) where_values=0; 5045 ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr); 5046 /* Find connected components defined on the shared interface */ 5047 if (where_values) { 5048 ierr = PCBDDCFindConnectedComponents(mat_graph, where_values); 5049 } 5050 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&queue_in_global_numbering);CHKERRQ(ierr); 5051 /* check consistency of connected components among neighbouring subdomains -> it adapt them in case it is needed */ 5052 for (i=0;i<where_values;i++) { 5053 /* We are not sure that on a given subset of the local interface, 5054 two connected components will be the same among sharing subdomains */ 5055 if (mat_graph->where_ncmps[i]>1) { 5056 adapt_interface=1; 5057 break; 5058 } 5059 } 5060 ierr = MPI_Allreduce(&adapt_interface,&adapt_interface_reduced,1,MPIU_INT,MPI_LOR,interface_comm);CHKERRQ(ierr); 5061 if (pcbddc->dbg_flag && adapt_interface_reduced) { 5062 ierr = PetscViewerASCIIPrintf(viewer,"Adapting interface\n");CHKERRQ(ierr); 5063 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 5064 } 5065 if (where_values && adapt_interface_reduced) { 5066 PetscInt sum_requests=0,my_rank; 5067 PetscInt buffer_size,start_of_recv,size_of_recv,start_of_send; 5068 PetscInt temp_buffer_size,ins_val,global_where_counter; 5069 PetscInt *cum_recv_counts; 5070 PetscInt *where_to_nodes_indices; 5071 PetscInt *petsc_buffer; 5072 PetscMPIInt *recv_buffer; 5073 PetscMPIInt *recv_buffer_where; 5074 PetscMPIInt *send_buffer; 5075 PetscMPIInt size_of_send; 5076 PetscInt *sizes_of_sends; 5077 MPI_Request *send_requests; 5078 MPI_Request *recv_requests; 5079 PetscInt *where_cc_adapt; 5080 PetscInt **temp_buffer; 5081 PetscInt *nodes_to_temp_buffer_indices; 5082 PetscInt *add_to_where; 5083 PetscInt *aux_new_xadj,*new_xadj,*new_adjncy; 5084 5085 /* Retrict adjacency graph using information from connected components */ 5086 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&aux_new_xadj);CHKERRQ(ierr); 5087 for (i=0;i<mat_graph->nvtxs;i++) { 5088 aux_new_xadj[i]=1; 5089 } 5090 for (i=0;i<mat_graph->ncmps;i++) { 5091 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5092 for (j=0;j<k;j++) { 5093 aux_new_xadj[mat_graph->queue[mat_graph->cptr[i]+j]]=k; 5094 } 5095 } 5096 j = 0; 5097 for (i=0;i<mat_graph->nvtxs;i++) { 5098 j += aux_new_xadj[i]; 5099 } 5100 ierr = PetscMalloc((mat_graph->nvtxs+1)*sizeof(PetscInt),&new_xadj);CHKERRQ(ierr); 5101 ierr = PetscMalloc(j*sizeof(PetscInt),&new_adjncy);CHKERRQ(ierr); 5102 new_xadj[0]=0; 5103 for (i=0;i<mat_graph->nvtxs;i++) { 5104 new_xadj[i+1]=new_xadj[i]+aux_new_xadj[i]; 5105 if (aux_new_xadj[i]==1) { 5106 new_adjncy[new_xadj[i]]=i; 5107 } 5108 } 5109 ierr = PetscFree(aux_new_xadj);CHKERRQ(ierr); 5110 for (i=0;i<mat_graph->ncmps;i++) { 5111 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5112 for (j=0;j<k;j++) { 5113 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); 5114 } 5115 } 5116 ierr = PCBDDCSetLocalAdjacencyGraph(pc,mat_graph->nvtxs,new_xadj,new_adjncy,PETSC_OWN_POINTER);CHKERRQ(ierr); 5117 /* For consistency among neughbouring procs, I need to sort (by global ordering) each connected component */ 5118 for (i=0;i<mat_graph->ncmps;i++) { 5119 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5120 ierr = ISLocalToGlobalMappingApply(matis->mapping,k,&mat_graph->queue[mat_graph->cptr[i]],&queue_in_global_numbering[mat_graph->cptr[i]]);CHKERRQ(ierr); 5121 ierr = PetscSortIntWithArray(k,&queue_in_global_numbering[mat_graph->cptr[i]],&mat_graph->queue[mat_graph->cptr[i]]);CHKERRQ(ierr); 5122 } 5123 /* allocate some space */ 5124 ierr = MPI_Comm_rank(interface_comm,&my_rank);CHKERRQ(ierr); 5125 ierr = PetscMalloc((where_values+1)*sizeof(PetscInt),&cum_recv_counts);CHKERRQ(ierr); 5126 ierr = PetscMemzero(cum_recv_counts,(where_values+1)*sizeof(PetscInt));CHKERRQ(ierr); 5127 ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_to_nodes_indices);CHKERRQ(ierr); 5128 /* first count how many neighbours per connected component I will receive from */ 5129 cum_recv_counts[0]=0; 5130 for (i=1;i<where_values+1;i++) { 5131 j=0; 5132 while (mat_graph->where[j] != i) { j++; } 5133 where_to_nodes_indices[i-1]=j; 5134 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 */ 5135 else { cum_recv_counts[i]=cum_recv_counts[i-1]+mat_graph->count[j]-1; } 5136 } 5137 ierr = PetscMalloc(2*cum_recv_counts[where_values]*sizeof(PetscMPIInt),&recv_buffer_where);CHKERRQ(ierr); 5138 ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&send_requests);CHKERRQ(ierr); 5139 ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&recv_requests);CHKERRQ(ierr); 5140 for (i=0;i<cum_recv_counts[where_values];i++) { 5141 send_requests[i]=MPI_REQUEST_NULL; 5142 recv_requests[i]=MPI_REQUEST_NULL; 5143 } 5144 /* exchange with my neighbours the number of my connected components on the shared interface */ 5145 for (i=0;i<where_values;i++) { 5146 j=where_to_nodes_indices[i]; 5147 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 5148 for (;k<mat_graph->count[j];k++) { 5149 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); 5150 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); 5151 sum_requests++; 5152 } 5153 } 5154 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5155 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5156 /* determine the connected component I need to adapt */ 5157 ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_cc_adapt);CHKERRQ(ierr); 5158 ierr = PetscMemzero(where_cc_adapt,where_values*sizeof(PetscInt));CHKERRQ(ierr); 5159 for (i=0;i<where_values;i++) { 5160 for (j=cum_recv_counts[i];j<cum_recv_counts[i+1];j++) { 5161 /* The first condition is natural (i.e someone has a different number of cc than me), the second one is just to be safe */ 5162 if (mat_graph->where_ncmps[i]!=recv_buffer_where[j] || mat_graph->where_ncmps[i] > 1) { 5163 where_cc_adapt[i]=PETSC_TRUE; 5164 break; 5165 } 5166 } 5167 } 5168 buffer_size = 0; 5169 for (i=0;i<where_values;i++) { 5170 if (where_cc_adapt[i]) { 5171 for (j=i;j<mat_graph->ncmps;j++) { 5172 if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */ 5173 buffer_size += 1 + mat_graph->cptr[j+1]-mat_graph->cptr[j]; 5174 } 5175 } 5176 } 5177 } 5178 ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr); 5179 /* now get from neighbours their ccs (in global numbering) and adapt them (in case it is needed) */ 5180 /* first determine how much data to send (size of each queue plus the global indices) and communicate it to neighbours */ 5181 ierr = PetscMalloc(where_values*sizeof(PetscInt),&sizes_of_sends);CHKERRQ(ierr); 5182 ierr = PetscMemzero(sizes_of_sends,where_values*sizeof(PetscInt));CHKERRQ(ierr); 5183 sum_requests=0; 5184 start_of_send=0; 5185 start_of_recv=cum_recv_counts[where_values]; 5186 for (i=0;i<where_values;i++) { 5187 if (where_cc_adapt[i]) { 5188 size_of_send=0; 5189 for (j=i;j<mat_graph->ncmps;j++) { 5190 if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */ 5191 send_buffer[start_of_send+size_of_send]=mat_graph->cptr[j+1]-mat_graph->cptr[j]; 5192 size_of_send+=1; 5193 for (k=0;k<mat_graph->cptr[j+1]-mat_graph->cptr[j];k++) { 5194 send_buffer[start_of_send+size_of_send+k]=queue_in_global_numbering[mat_graph->cptr[j]+k]; 5195 } 5196 size_of_send=size_of_send+mat_graph->cptr[j+1]-mat_graph->cptr[j]; 5197 } 5198 } 5199 j = where_to_nodes_indices[i]; 5200 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 5201 sizes_of_sends[i]=size_of_send; 5202 for (;k<mat_graph->count[j];k++) { 5203 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); 5204 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); 5205 sum_requests++; 5206 } 5207 start_of_send+=size_of_send; 5208 } 5209 } 5210 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5211 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5212 buffer_size=0; 5213 for (k=0;k<sum_requests;k++) { buffer_size+=recv_buffer_where[start_of_recv+k]; } 5214 ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&recv_buffer);CHKERRQ(ierr); 5215 /* now exchange the data */ 5216 start_of_recv=0; 5217 start_of_send=0; 5218 sum_requests=0; 5219 for (i=0;i<where_values;i++) { 5220 if (where_cc_adapt[i]) { 5221 size_of_send = sizes_of_sends[i]; 5222 j = where_to_nodes_indices[i]; 5223 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 5224 for (;k<mat_graph->count[j];k++) { 5225 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); 5226 size_of_recv=recv_buffer_where[cum_recv_counts[where_values]+sum_requests]; 5227 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); 5228 start_of_recv+=size_of_recv; 5229 sum_requests++; 5230 } 5231 start_of_send+=size_of_send; 5232 } 5233 } 5234 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5235 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 5236 ierr = PetscMalloc(buffer_size*sizeof(PetscInt),&petsc_buffer);CHKERRQ(ierr); 5237 for (k=0;k<start_of_recv;k++) { petsc_buffer[k]=(PetscInt)recv_buffer[k]; } 5238 for (j=0;j<buffer_size;) { 5239 ierr = ISGlobalToLocalMappingApply(matis->mapping,IS_GTOLM_MASK,petsc_buffer[j],&petsc_buffer[j+1],&petsc_buffer[j],&petsc_buffer[j+1]);CHKERRQ(ierr); 5240 k=petsc_buffer[j]+1; 5241 j+=k; 5242 } 5243 sum_requests=cum_recv_counts[where_values]; 5244 start_of_recv=0; 5245 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&nodes_to_temp_buffer_indices);CHKERRQ(ierr); 5246 global_where_counter=0; 5247 for (i=0;i<where_values;i++) { 5248 if (where_cc_adapt[i]) { 5249 temp_buffer_size=0; 5250 /* find nodes on the shared interface we need to adapt */ 5251 for (j=0;j<mat_graph->nvtxs;j++) { 5252 if (mat_graph->where[j]==i+1) { 5253 nodes_to_temp_buffer_indices[j]=temp_buffer_size; 5254 temp_buffer_size++; 5255 } else { 5256 nodes_to_temp_buffer_indices[j]=-1; 5257 } 5258 } 5259 /* allocate some temporary space */ 5260 ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt*),&temp_buffer);CHKERRQ(ierr); 5261 ierr = PetscMalloc(temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt),&temp_buffer[0]);CHKERRQ(ierr); 5262 ierr = PetscMemzero(temp_buffer[0],temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt));CHKERRQ(ierr); 5263 for (j=1;j<temp_buffer_size;j++) { 5264 temp_buffer[j]=temp_buffer[j-1]+cum_recv_counts[i+1]-cum_recv_counts[i]; 5265 } 5266 /* analyze contributions from neighbouring subdomains for i-th conn comp 5267 temp buffer structure: 5268 supposing part of the interface has dimension 5 (global nodes 0,1,2,3,4) 5269 3 neighs procs with structured connected components: 5270 neigh 0: [0 1 4], [2 3]; (2 connected components) 5271 neigh 1: [0 1], [2 3 4]; (2 connected components) 5272 neigh 2: [0 4], [1], [2 3]; (3 connected components) 5273 tempbuffer (row-oriented) should be filled as: 5274 [ 0, 0, 0; 5275 0, 0, 1; 5276 1, 1, 2; 5277 1, 1, 2; 5278 0, 1, 0; ]; 5279 This way we can simply recover the resulting structure account for possible intersections of ccs among neighs. 5280 The mat_graph->where array will be modified to reproduce the following 4 connected components [0], [1], [2 3], [4]; 5281 */ 5282 for (j=0;j<cum_recv_counts[i+1]-cum_recv_counts[i];j++) { 5283 ins_val=0; 5284 size_of_recv=recv_buffer_where[sum_requests]; /* total size of recv from neighs */ 5285 for (buffer_size=0;buffer_size<size_of_recv;) { /* loop until all data from neighs has been taken into account */ 5286 for (k=1;k<petsc_buffer[buffer_size+start_of_recv]+1;k++) { /* filling properly temp_buffer using data from a single recv */ 5287 temp_buffer[ nodes_to_temp_buffer_indices[ petsc_buffer[ start_of_recv+buffer_size+k ] ] ][j]=ins_val; 5288 } 5289 buffer_size+=k; 5290 ins_val++; 5291 } 5292 start_of_recv+=size_of_recv; 5293 sum_requests++; 5294 } 5295 ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt),&add_to_where);CHKERRQ(ierr); 5296 ierr = PetscMemzero(add_to_where,temp_buffer_size*sizeof(PetscInt));CHKERRQ(ierr); 5297 for (j=0;j<temp_buffer_size;j++) { 5298 if (!add_to_where[j]) { /* found a new cc */ 5299 global_where_counter++; 5300 add_to_where[j]=global_where_counter; 5301 for (k=j+1;k<temp_buffer_size;k++) { /* check for other nodes in new cc */ 5302 same_set=PETSC_TRUE; 5303 for (s=0;s<cum_recv_counts[i+1]-cum_recv_counts[i];s++) { 5304 if (temp_buffer[j][s]!=temp_buffer[k][s]) { 5305 same_set=PETSC_FALSE; 5306 break; 5307 } 5308 } 5309 if (same_set) { add_to_where[k]=global_where_counter; } 5310 } 5311 } 5312 } 5313 /* insert new data in where array */ 5314 temp_buffer_size=0; 5315 for (j=0;j<mat_graph->nvtxs;j++) { 5316 if (mat_graph->where[j]==i+1) { 5317 mat_graph->where[j]=where_values+add_to_where[temp_buffer_size]; 5318 temp_buffer_size++; 5319 } 5320 } 5321 ierr = PetscFree(temp_buffer[0]);CHKERRQ(ierr); 5322 ierr = PetscFree(temp_buffer);CHKERRQ(ierr); 5323 ierr = PetscFree(add_to_where);CHKERRQ(ierr); 5324 } 5325 } 5326 ierr = PetscFree(nodes_to_temp_buffer_indices);CHKERRQ(ierr); 5327 ierr = PetscFree(sizes_of_sends);CHKERRQ(ierr); 5328 ierr = PetscFree(send_requests);CHKERRQ(ierr); 5329 ierr = PetscFree(recv_requests);CHKERRQ(ierr); 5330 ierr = PetscFree(petsc_buffer);CHKERRQ(ierr); 5331 ierr = PetscFree(recv_buffer);CHKERRQ(ierr); 5332 ierr = PetscFree(recv_buffer_where);CHKERRQ(ierr); 5333 ierr = PetscFree(send_buffer);CHKERRQ(ierr); 5334 ierr = PetscFree(cum_recv_counts);CHKERRQ(ierr); 5335 ierr = PetscFree(where_to_nodes_indices);CHKERRQ(ierr); 5336 ierr = PetscFree(where_cc_adapt);CHKERRQ(ierr); 5337 /* We are ready to evaluate consistent connected components on each part of the shared interface */ 5338 if (global_where_counter) { 5339 for (i=0;i<mat_graph->nvtxs;i++) { mat_graph->touched[i]=PETSC_FALSE; } 5340 global_where_counter=0; 5341 for (i=0;i<mat_graph->nvtxs;i++) { 5342 if (mat_graph->where[i] && !mat_graph->touched[i]) { 5343 global_where_counter++; 5344 for (j=i+1;j<mat_graph->nvtxs;j++) { 5345 if (!mat_graph->touched[j] && mat_graph->where[j]==mat_graph->where[i]) { 5346 mat_graph->where[j]=global_where_counter; 5347 mat_graph->touched[j]=PETSC_TRUE; 5348 } 5349 } 5350 mat_graph->where[i]=global_where_counter; 5351 mat_graph->touched[i]=PETSC_TRUE; 5352 } 5353 } 5354 where_values=global_where_counter; 5355 } 5356 if (global_where_counter) { 5357 ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr); 5358 ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 5359 ierr = PetscFree(mat_graph->where_ncmps);CHKERRQ(ierr); 5360 ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr); 5361 ierr = PCBDDCFindConnectedComponents(mat_graph, where_values); 5362 } 5363 } /* Finished adapting interface */ 5364 /* For consistency among neughbouring procs, I need to sort (by global ordering) each connected component */ 5365 for (i=0;i<mat_graph->ncmps;i++) { 5366 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5367 ierr = ISLocalToGlobalMappingApply(matis->mapping,k,&mat_graph->queue[mat_graph->cptr[i]],&queue_in_global_numbering[mat_graph->cptr[i]]);CHKERRQ(ierr); 5368 ierr = PetscSortIntWithArray(k,&queue_in_global_numbering[mat_graph->cptr[i]],&mat_graph->queue[mat_graph->cptr[i]]);CHKERRQ(ierr); 5369 } 5370 5371 PetscInt nfc=0; 5372 PetscInt nec=0; 5373 PetscInt nvc=0; 5374 PetscBool twodim_flag=PETSC_FALSE; 5375 for (i=0; i<mat_graph->ncmps; i++) { 5376 if (mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size) { 5377 if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1) { /* 1 neigh Neumann fake included */ 5378 nfc++; 5379 } else { /* note that nec will be zero in 2d */ 5380 nec++; 5381 } 5382 } else { 5383 nvc+=mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5384 } 5385 } 5386 if (!nec) { /* we are in a 2d case -> no faces, only edges */ 5387 nec = nfc; 5388 nfc = 0; 5389 twodim_flag = PETSC_TRUE; 5390 } 5391 /* allocate IS arrays for faces, edges. Vertices need a single index set. */ 5392 k=0; 5393 for (i=0; i<mat_graph->ncmps; i++) { 5394 j=mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5395 if (j > k) { 5396 k=j; 5397 } 5398 if (j<=vertex_size) { 5399 k+=vertex_size; 5400 } 5401 } 5402 ierr = PetscMalloc(k*sizeof(PetscInt),&auxis);CHKERRQ(ierr); 5403 if (!pcbddc->vertices_flag && !pcbddc->edges_flag) { 5404 ierr = PetscMalloc(nfc*sizeof(IS),&pcbddc->ISForFaces);CHKERRQ(ierr); 5405 use_faces=PETSC_TRUE; 5406 } 5407 if (!pcbddc->vertices_flag && !pcbddc->faces_flag) { 5408 ierr = PetscMalloc(nec*sizeof(IS),&pcbddc->ISForEdges);CHKERRQ(ierr); 5409 use_edges=PETSC_TRUE; 5410 } 5411 nfc=0; 5412 nec=0; 5413 for (i=0; i<mat_graph->ncmps; i++) { 5414 if (mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size) { 5415 for (j=0;j<mat_graph->cptr[i+1]-mat_graph->cptr[i];j++) { 5416 auxis[j]=mat_graph->queue[mat_graph->cptr[i]+j]; 5417 } 5418 if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1) { 5419 if (twodim_flag) { 5420 if (use_edges) { 5421 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr); 5422 nec++; 5423 } 5424 } else { 5425 if (use_faces) { 5426 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForFaces[nfc]);CHKERRQ(ierr); 5427 nfc++; 5428 } 5429 } 5430 } else { 5431 if (use_edges) { 5432 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr); 5433 nec++; 5434 } 5435 } 5436 } 5437 } 5438 pcbddc->n_ISForFaces=nfc; 5439 pcbddc->n_ISForEdges=nec; 5440 nvc=0; 5441 if (!pcbddc->constraints_flag) { 5442 for (i=0; i<mat_graph->ncmps; i++) { 5443 if (mat_graph->cptr[i+1]-mat_graph->cptr[i] <= vertex_size) { 5444 for (j=mat_graph->cptr[i];j<mat_graph->cptr[i+1];j++) { 5445 auxis[nvc]=mat_graph->queue[j]; 5446 nvc++; 5447 } 5448 } 5449 } 5450 } 5451 /* sort vertex set (by local ordering) */ 5452 ierr = PetscSortInt(nvc,auxis);CHKERRQ(ierr); 5453 ierr = ISCreateGeneral(PETSC_COMM_SELF,nvc,auxis,PETSC_COPY_VALUES,&pcbddc->ISForVertices);CHKERRQ(ierr); 5454 if (pcbddc->dbg_flag) { 5455 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 5456 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Details from PCBDDCManageLocalBoundaries for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 5457 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Matrix graph has %d connected components", mat_graph->ncmps);CHKERRQ(ierr); 5458 for (i=0;i<mat_graph->ncmps;i++) { 5459 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\nDetails for connected component number %02d: size %04d, count %01d. Nodes follow.\n", 5460 i,mat_graph->cptr[i+1]-mat_graph->cptr[i],mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]);CHKERRQ(ierr); 5461 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"subdomains: "); 5462 for (j=0;j<mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]; j++) { 5463 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d ",mat_graph->neighbours_set[mat_graph->queue[mat_graph->cptr[i]]][j]); 5464 } 5465 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n"); 5466 for (j=mat_graph->cptr[i]; j<mat_graph->cptr[i+1]; j++) { 5467 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d (%d), ",mat_graph->queue[j],queue_in_global_numbering[j]);CHKERRQ(ierr); 5468 } 5469 } 5470 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n--------------------------------------------------------------\n");CHKERRQ(ierr); 5471 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local vertices\n",PetscGlobalRank,nvc);CHKERRQ(ierr); 5472 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local faces\n",PetscGlobalRank,nfc);CHKERRQ(ierr); 5473 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local edges\n",PetscGlobalRank,nec);CHKERRQ(ierr); 5474 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 5475 } 5476 ierr = PetscFree(auxis);CHKERRQ(ierr); 5477 ierr = PetscFree(queue_in_global_numbering);CHKERRQ(ierr); 5478 PetscFunctionReturn(0); 5479 } 5480 5481 /* -------------------------------------------------------------------------- */ 5482 5483 /* The following code has been adapted from function IsConnectedSubdomain contained 5484 in source file contig.c of METIS library (version 5.0.1) 5485 It finds connected components of each partition labeled from 1 to n_dist */ 5486 5487 #undef __FUNCT__ 5488 #define __FUNCT__ "PCBDDCFindConnectedComponents" 5489 static PetscErrorCode PCBDDCFindConnectedComponents(PCBDDCGraph graph, PetscInt n_dist) 5490 { 5491 PetscInt i, j, k, nvtxs, first, last, nleft, ncmps,pid,cum_queue,n,ncmps_pid; 5492 PetscInt *xadj, *adjncy, *where, *queue; 5493 PetscInt *cptr; 5494 PetscBool *touched; 5495 5496 PetscFunctionBegin; 5497 nvtxs = graph->nvtxs; 5498 xadj = graph->xadj; 5499 adjncy = graph->adjncy; 5500 where = graph->where; 5501 touched = graph->touched; 5502 queue = graph->queue; 5503 cptr = graph->cptr; 5504 5505 for (i=0; i<nvtxs; i++) { 5506 touched[i] = PETSC_FALSE; 5507 } 5508 5509 cum_queue=0; 5510 ncmps=0; 5511 5512 for (n=0; n<n_dist; n++) { 5513 pid = n+1; /* partition labeled by 0 is discarded */ 5514 nleft = 0; 5515 for (i=0; i<nvtxs; i++) { 5516 if (where[i] == pid) 5517 nleft++; 5518 } 5519 for (i=0; i<nvtxs; i++) { 5520 if (where[i] == pid) 5521 break; 5522 } 5523 touched[i] = PETSC_TRUE; 5524 queue[cum_queue] = i; 5525 first = 0; last = 1; 5526 cptr[ncmps] = cum_queue; /* This actually points to queue */ 5527 ncmps_pid = 0; 5528 while (first != nleft) { 5529 if (first == last) { /* Find another starting vertex */ 5530 cptr[++ncmps] = first+cum_queue; 5531 ncmps_pid++; 5532 for (i=0; i<nvtxs; i++) { 5533 if (where[i] == pid && !touched[i]) 5534 break; 5535 } 5536 queue[cum_queue+last] = i; 5537 last++; 5538 touched[i] = PETSC_TRUE; 5539 } 5540 i = queue[cum_queue+first]; 5541 first++; 5542 for (j=xadj[i]; j<xadj[i+1]; j++) { 5543 k = adjncy[j]; 5544 if (where[k] == pid && !touched[k]) { 5545 queue[cum_queue+last] = k; 5546 last++; 5547 touched[k] = PETSC_TRUE; 5548 } 5549 } 5550 } 5551 cptr[++ncmps] = first+cum_queue; 5552 ncmps_pid++; 5553 cum_queue=cptr[ncmps]; 5554 graph->where_ncmps[n] = ncmps_pid; 5555 } 5556 graph->ncmps = ncmps; 5557 5558 PetscFunctionReturn(0); 5559 } 5560