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