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