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