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