1 #define PETSCVEC_DLL 2 3 #include "petscvec.h" /*I "petscsys.h" I*/ 4 #include "src/vec/is/isimpl.h" /*I "petscis.h" I*/ 5 6 PetscCookie PETSCVEC_DLLEXPORT IS_LTOGM_COOKIE = -1; 7 8 #undef __FUNCT__ 9 #define __FUNCT__ "ISLocalToGlobalMappingGetSize" 10 /*@C 11 ISLocalToGlobalMappingGetSize - Gets the local size of a local to global mapping. 12 13 Not Collective 14 15 Input Parameter: 16 . ltog - local to global mapping 17 18 Output Parameter: 19 . n - the number of entries in the local mapping 20 21 Level: advanced 22 23 Concepts: mapping^local to global 24 25 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreate() 26 @*/ 27 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingGetSize(ISLocalToGlobalMapping mapping,PetscInt *n) 28 { 29 PetscFunctionBegin; 30 PetscValidHeaderSpecific(mapping,IS_LTOGM_COOKIE,1); 31 PetscValidIntPointer(n,2); 32 *n = mapping->n; 33 PetscFunctionReturn(0); 34 } 35 36 #undef __FUNCT__ 37 #define __FUNCT__ "ISLocalToGlobalMappingView" 38 /*@C 39 ISLocalToGlobalMappingView - View a local to global mapping 40 41 Not Collective 42 43 Input Parameters: 44 + ltog - local to global mapping 45 - viewer - viewer 46 47 Level: advanced 48 49 Concepts: mapping^local to global 50 51 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreate() 52 @*/ 53 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingView(ISLocalToGlobalMapping mapping,PetscViewer viewer) 54 { 55 PetscInt i; 56 PetscMPIInt rank; 57 PetscTruth iascii; 58 PetscErrorCode ierr; 59 60 PetscFunctionBegin; 61 PetscValidHeaderSpecific(mapping,IS_LTOGM_COOKIE,1); 62 if (!viewer) { 63 ierr = PetscViewerASCIIGetStdout(mapping->comm,&viewer);CHKERRQ(ierr); 64 } 65 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,2); 66 67 ierr = MPI_Comm_rank(mapping->comm,&rank);CHKERRQ(ierr); 68 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr); 69 if (iascii) { 70 for (i=0; i<mapping->n; i++) { 71 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %d %d\n",rank,i,mapping->indices[i]);CHKERRQ(ierr); 72 } 73 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 74 } else { 75 SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported for ISLocalToGlobalMapping",((PetscObject)viewer)->type_name); 76 } 77 78 PetscFunctionReturn(0); 79 } 80 81 #undef __FUNCT__ 82 #define __FUNCT__ "ISLocalToGlobalMappingCreateIS" 83 /*@ 84 ISLocalToGlobalMappingCreateIS - Creates a mapping between a local (0 to n) 85 ordering and a global parallel ordering. 86 87 Not collective 88 89 Input Parameter: 90 . is - index set containing the global numbers for each local 91 92 Output Parameter: 93 . mapping - new mapping data structure 94 95 Level: advanced 96 97 Concepts: mapping^local to global 98 99 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreate() 100 @*/ 101 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingCreateIS(IS is,ISLocalToGlobalMapping *mapping) 102 { 103 PetscErrorCode ierr; 104 PetscInt n,*indices; 105 MPI_Comm comm; 106 107 PetscFunctionBegin; 108 PetscValidHeaderSpecific(is,IS_COOKIE,1); 109 PetscValidPointer(mapping,2); 110 111 ierr = PetscObjectGetComm((PetscObject)is,&comm);CHKERRQ(ierr); 112 ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr); 113 ierr = ISGetIndices(is,&indices);CHKERRQ(ierr); 114 ierr = ISLocalToGlobalMappingCreate(comm,n,indices,mapping);CHKERRQ(ierr); 115 ierr = ISRestoreIndices(is,&indices);CHKERRQ(ierr); 116 117 PetscFunctionReturn(0); 118 } 119 120 121 #undef __FUNCT__ 122 #define __FUNCT__ "ISLocalToGlobalMappingCreate" 123 /*@ 124 ISLocalToGlobalMappingCreate - Creates a mapping between a local (0 to n) 125 ordering and a global parallel ordering. 126 127 Not Collective, but communicator may have more than one process 128 129 Input Parameters: 130 + comm - MPI communicator 131 . n - the number of local elements 132 - indices - the global index for each local element 133 134 Output Parameter: 135 . mapping - new mapping data structure 136 137 Level: advanced 138 139 Concepts: mapping^local to global 140 141 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreateNC() 142 @*/ 143 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingCreate(MPI_Comm cm,PetscInt n,const PetscInt indices[],ISLocalToGlobalMapping *mapping) 144 { 145 PetscErrorCode ierr; 146 PetscInt *in; 147 148 PetscFunctionBegin; 149 PetscValidIntPointer(indices,3); 150 PetscValidPointer(mapping,4); 151 ierr = PetscMalloc(n*sizeof(PetscInt),&in);CHKERRQ(ierr); 152 ierr = PetscMemcpy(in,indices,n*sizeof(PetscInt));CHKERRQ(ierr); 153 ierr = ISLocalToGlobalMappingCreateNC(cm,n,in,mapping);CHKERRQ(ierr); 154 PetscFunctionReturn(0); 155 } 156 157 #undef __FUNCT__ 158 #define __FUNCT__ "ISLocalToGlobalMappingCreateNC" 159 /*@C 160 ISLocalToGlobalMappingCreateNC - Creates a mapping between a local (0 to n) 161 ordering and a global parallel ordering. 162 163 Not Collective, but communicator may have more than one process 164 165 Input Parameters: 166 + comm - MPI communicator 167 . n - the number of local elements 168 - indices - the global index for each local element 169 170 Output Parameter: 171 . mapping - new mapping data structure 172 173 Level: developer 174 175 Notes: Does not copy the indices, just keeps the pointer to the indices. The ISLocalToGlobalMappingDestroy() 176 will free the space so it must be obtained with PetscMalloc() and it must not be freed elsewhere. 177 178 Concepts: mapping^local to global 179 180 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate() 181 @*/ 182 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingCreateNC(MPI_Comm cm,PetscInt n,const PetscInt indices[],ISLocalToGlobalMapping *mapping) 183 { 184 PetscErrorCode ierr; 185 186 PetscFunctionBegin; 187 if (n) { 188 PetscValidIntPointer(indices,3); 189 } 190 PetscValidPointer(mapping,4); 191 *mapping = PETSC_NULL; 192 #ifndef PETSC_USE_DYNAMIC_LIBRARIES 193 ierr = VecInitializePackage(PETSC_NULL);CHKERRQ(ierr); 194 #endif 195 if (IS_LTOGM_COOKIE == -1) { 196 ierr = PetscLogClassRegister(&IS_LTOGM_COOKIE,"IS Local to global mapping");CHKERRQ(ierr); 197 } 198 199 ierr = PetscHeaderCreate(*mapping,_p_ISLocalToGlobalMapping,int,IS_LTOGM_COOKIE,0,"ISLocalToGlobalMapping", 200 cm,ISLocalToGlobalMappingDestroy,ISLocalToGlobalMappingView);CHKERRQ(ierr); 201 ierr = PetscLogObjectMemory(*mapping,sizeof(struct _p_ISLocalToGlobalMapping)+n*sizeof(PetscInt));CHKERRQ(ierr); 202 203 (*mapping)->n = n; 204 (*mapping)->indices = (PetscInt*)indices; 205 206 /* 207 Do not create the global to local mapping. This is only created if 208 ISGlobalToLocalMapping() is called 209 */ 210 (*mapping)->globals = 0; 211 PetscFunctionReturn(0); 212 } 213 214 #undef __FUNCT__ 215 #define __FUNCT__ "ISLocalToGlobalMappingBlock" 216 /*@ 217 ISLocalToGlobalMappingBlock - Creates a blocked index version of an 218 ISLocalToGlobalMapping that is appropriate for MatSetLocalToGlobalMappingBlock() 219 and VecSetLocalToGlobalMappingBlock(). 220 221 Not Collective, but communicator may have more than one process 222 223 Input Parameters: 224 + inmap - original point-wise mapping 225 - bs - block size 226 227 Output Parameter: 228 . outmap - block based mapping; the indices are relative to BLOCKS, not individual vector or matrix entries. 229 230 Level: advanced 231 232 Concepts: mapping^local to global 233 234 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreate(), ISLocalToGlobalMappingCreateIS() 235 @*/ 236 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingBlock(ISLocalToGlobalMapping inmap,PetscInt bs,ISLocalToGlobalMapping *outmap) 237 { 238 PetscErrorCode ierr; 239 PetscInt *ii,i,n; 240 241 PetscFunctionBegin; 242 if (bs > 1) { 243 n = inmap->n/bs; 244 if (n*bs != inmap->n) SETERRQ(PETSC_ERR_ARG_INCOMP,"Pointwise mapping length is not divisible by block size"); 245 ierr = PetscMalloc(n*sizeof(PetscInt),&ii);CHKERRQ(ierr); 246 for (i=0; i<n; i++) { 247 ii[i] = inmap->indices[bs*i]/bs; 248 } 249 ierr = ISLocalToGlobalMappingCreate(inmap->comm,n,ii,outmap);CHKERRQ(ierr); 250 ierr = PetscFree(ii);CHKERRQ(ierr); 251 } else { 252 *outmap = inmap; 253 ierr = PetscObjectReference((PetscObject)inmap);CHKERRQ(ierr); 254 } 255 PetscFunctionReturn(0); 256 } 257 258 #undef __FUNCT__ 259 #define __FUNCT__ "ISLocalToGlobalMappingDestroy" 260 /*@ 261 ISLocalToGlobalMappingDestroy - Destroys a mapping between a local (0 to n) 262 ordering and a global parallel ordering. 263 264 Note Collective 265 266 Input Parameters: 267 . mapping - mapping data structure 268 269 Level: advanced 270 271 .seealso: ISLocalToGlobalMappingCreate() 272 @*/ 273 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingDestroy(ISLocalToGlobalMapping mapping) 274 { 275 PetscErrorCode ierr; 276 PetscFunctionBegin; 277 PetscValidPointer(mapping,1); 278 if (--mapping->refct > 0) PetscFunctionReturn(0); 279 if (mapping->refct < 0) { 280 SETERRQ(PETSC_ERR_PLIB,"Mapping already destroyed"); 281 } 282 283 ierr = PetscFree(mapping->indices);CHKERRQ(ierr); 284 ierr = PetscFree(mapping->globals);CHKERRQ(ierr); 285 ierr = PetscHeaderDestroy(mapping);CHKERRQ(ierr); 286 PetscFunctionReturn(0); 287 } 288 289 #undef __FUNCT__ 290 #define __FUNCT__ "ISLocalToGlobalMappingApplyIS" 291 /*@ 292 ISLocalToGlobalMappingApplyIS - Creates from an IS in the local numbering 293 a new index set using the global numbering defined in an ISLocalToGlobalMapping 294 context. 295 296 Not collective 297 298 Input Parameters: 299 + mapping - mapping between local and global numbering 300 - is - index set in local numbering 301 302 Output Parameters: 303 . newis - index set in global numbering 304 305 Level: advanced 306 307 Concepts: mapping^local to global 308 309 .seealso: ISLocalToGlobalMappingApply(), ISLocalToGlobalMappingCreate(), 310 ISLocalToGlobalMappingDestroy(), ISGlobalToLocalMappingApply() 311 @*/ 312 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingApplyIS(ISLocalToGlobalMapping mapping,IS is,IS *newis) 313 { 314 PetscErrorCode ierr; 315 PetscInt n,i,*idxin,*idxmap,*idxout,Nmax = mapping->n; 316 317 PetscFunctionBegin; 318 PetscValidPointer(mapping,1); 319 PetscValidHeaderSpecific(is,IS_COOKIE,2); 320 PetscValidPointer(newis,3); 321 322 ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr); 323 ierr = ISGetIndices(is,&idxin);CHKERRQ(ierr); 324 idxmap = mapping->indices; 325 326 ierr = PetscMalloc(n*sizeof(PetscInt),&idxout);CHKERRQ(ierr); 327 for (i=0; i<n; i++) { 328 if (idxin[i] >= Nmax) SETERRQ3(PETSC_ERR_ARG_OUTOFRANGE,"Local index %d too large %d (max) at %d",idxin[i],Nmax-1,i); 329 idxout[i] = idxmap[idxin[i]]; 330 } 331 ierr = ISRestoreIndices(is,&idxin);CHKERRQ(ierr); 332 ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxout,newis);CHKERRQ(ierr); 333 ierr = PetscFree(idxout);CHKERRQ(ierr); 334 PetscFunctionReturn(0); 335 } 336 337 /*MC 338 ISLocalToGlobalMappingApply - Takes a list of integers in a local numbering 339 and converts them to the global numbering. 340 341 Not collective 342 343 Input Parameters: 344 + mapping - the local to global mapping context 345 . N - number of integers 346 - in - input indices in local numbering 347 348 Output Parameter: 349 . out - indices in global numbering 350 351 Synopsis: 352 PetscErrorCode ISLocalToGlobalMappingApply(ISLocalToGlobalMapping mapping,int N,int in[],int out[]) 353 354 Notes: 355 The in and out array parameters may be identical. 356 357 Level: advanced 358 359 .seealso: ISLocalToGlobalMappingCreate(),ISLocalToGlobalMappingDestroy(), 360 ISLocalToGlobalMappingApplyIS(),AOCreateBasic(),AOApplicationToPetsc(), 361 AOPetscToApplication(), ISGlobalToLocalMappingApply() 362 363 Concepts: mapping^local to global 364 365 M*/ 366 367 /* -----------------------------------------------------------------------------------------*/ 368 369 #undef __FUNCT__ 370 #define __FUNCT__ "ISGlobalToLocalMappingSetUp_Private" 371 /* 372 Creates the global fields in the ISLocalToGlobalMapping structure 373 */ 374 static PetscErrorCode ISGlobalToLocalMappingSetUp_Private(ISLocalToGlobalMapping mapping) 375 { 376 PetscErrorCode ierr; 377 PetscInt i,*idx = mapping->indices,n = mapping->n,end,start,*globals; 378 379 PetscFunctionBegin; 380 end = 0; 381 start = 100000000; 382 383 for (i=0; i<n; i++) { 384 if (idx[i] < 0) continue; 385 if (idx[i] < start) start = idx[i]; 386 if (idx[i] > end) end = idx[i]; 387 } 388 if (start > end) {start = 0; end = -1;} 389 mapping->globalstart = start; 390 mapping->globalend = end; 391 392 ierr = PetscMalloc((end-start+2)*sizeof(PetscInt),&globals);CHKERRQ(ierr); 393 mapping->globals = globals; 394 for (i=0; i<end-start+1; i++) { 395 globals[i] = -1; 396 } 397 for (i=0; i<n; i++) { 398 if (idx[i] < 0) continue; 399 globals[idx[i] - start] = i; 400 } 401 402 ierr = PetscLogObjectMemory(mapping,(end-start+1)*sizeof(PetscInt));CHKERRQ(ierr); 403 PetscFunctionReturn(0); 404 } 405 406 #undef __FUNCT__ 407 #define __FUNCT__ "ISGlobalToLocalMappingApply" 408 /*@ 409 ISGlobalToLocalMappingApply - Provides the local numbering for a list of integers 410 specified with a global numbering. 411 412 Not collective 413 414 Input Parameters: 415 + mapping - mapping between local and global numbering 416 . type - IS_GTOLM_MASK - replaces global indices with no local value with -1 417 IS_GTOLM_DROP - drops the indices with no local value from the output list 418 . n - number of global indices to map 419 - idx - global indices to map 420 421 Output Parameters: 422 + nout - number of indices in output array (if type == IS_GTOLM_MASK then nout = n) 423 - idxout - local index of each global index, one must pass in an array long enough 424 to hold all the indices. You can call ISGlobalToLocalMappingApply() with 425 idxout == PETSC_NULL to determine the required length (returned in nout) 426 and then allocate the required space and call ISGlobalToLocalMappingApply() 427 a second time to set the values. 428 429 Notes: 430 Either nout or idxout may be PETSC_NULL. idx and idxout may be identical. 431 432 This is not scalable in memory usage. Each processor requires O(Nglobal) size 433 array to compute these. 434 435 Level: advanced 436 437 Concepts: mapping^global to local 438 439 .seealso: ISLocalToGlobalMappingApply(), ISLocalToGlobalMappingCreate(), 440 ISLocalToGlobalMappingDestroy() 441 @*/ 442 PetscErrorCode PETSCVEC_DLLEXPORT ISGlobalToLocalMappingApply(ISLocalToGlobalMapping mapping,ISGlobalToLocalMappingType type, 443 PetscInt n,const PetscInt idx[],PetscInt *nout,PetscInt idxout[]) 444 { 445 PetscInt i,*globals,nf = 0,tmp,start,end; 446 PetscErrorCode ierr; 447 448 PetscFunctionBegin; 449 if (!mapping->globals) { 450 ierr = ISGlobalToLocalMappingSetUp_Private(mapping);CHKERRQ(ierr); 451 } 452 globals = mapping->globals; 453 start = mapping->globalstart; 454 end = mapping->globalend; 455 456 if (type == IS_GTOLM_MASK) { 457 if (idxout) { 458 for (i=0; i<n; i++) { 459 if (idx[i] < 0) idxout[i] = idx[i]; 460 else if (idx[i] < start) idxout[i] = -1; 461 else if (idx[i] > end) idxout[i] = -1; 462 else idxout[i] = globals[idx[i] - start]; 463 } 464 } 465 if (nout) *nout = n; 466 } else { 467 if (idxout) { 468 for (i=0; i<n; i++) { 469 if (idx[i] < 0) continue; 470 if (idx[i] < start) continue; 471 if (idx[i] > end) continue; 472 tmp = globals[idx[i] - start]; 473 if (tmp < 0) continue; 474 idxout[nf++] = tmp; 475 } 476 } else { 477 for (i=0; i<n; i++) { 478 if (idx[i] < 0) continue; 479 if (idx[i] < start) continue; 480 if (idx[i] > end) continue; 481 tmp = globals[idx[i] - start]; 482 if (tmp < 0) continue; 483 nf++; 484 } 485 } 486 if (nout) *nout = nf; 487 } 488 489 PetscFunctionReturn(0); 490 } 491 492 #undef __FUNCT__ 493 #define __FUNCT__ "ISLocalToGlobalMappingGetInfo" 494 /*@C 495 ISLocalToGlobalMappingGetInfo - Gets the neighbor information for each processor and 496 each index shared by more than one processor 497 498 Collective on ISLocalToGlobalMapping 499 500 Input Parameters: 501 . mapping - the mapping from local to global indexing 502 503 Output Parameter: 504 + nproc - number of processors that are connected to this one 505 . proc - neighboring processors 506 . numproc - number of indices for each subdomain (processor) 507 - indices - indices of local nodes shared with neighbor (sorted by global numbering) 508 509 Level: advanced 510 511 Concepts: mapping^local to global 512 513 Fortran Usage: 514 $ ISLocalToGlobalMpngGetInfoSize(ISLocalToGlobalMapping,PetscInt nproc,PetscInt numprocmax,ierr) followed by 515 $ ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping,PetscInt nproc, PetscInt procs[nproc],PetscInt numprocs[nproc], 516 PetscInt indices[nproc][numprocmax],ierr) 517 There is no ISLocalToGlobalMappingRestoreInfo() in Fortran. You must make sure that procs[], numprocs[] and 518 indices[][] are large enough arrays, either by allocating them dynamically or defining static ones large enough. 519 520 521 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate(), 522 ISLocalToGlobalMappingRestoreInfo() 523 @*/ 524 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping mapping,PetscInt *nproc,PetscInt *procs[],PetscInt *numprocs[],PetscInt **indices[]) 525 { 526 PetscErrorCode ierr; 527 PetscMPIInt size,rank,tag1,tag2,tag3,*len,*source,imdex; 528 PetscInt i,n = mapping->n,Ng,ng,max = 0,*lindices = mapping->indices; 529 PetscInt *nprocs,*owner,nsends,*sends,j,*starts,nmax,nrecvs,*recvs,proc; 530 PetscInt cnt,scale,*ownedsenders,*nownedsenders,rstart,nowned; 531 PetscInt node,nownedm,nt,*sends2,nsends2,*starts2,*lens2,*dest,nrecvs2,*starts3,*recvs2,k,*bprocs,*tmp; 532 PetscInt first_procs,first_numprocs,*first_indices; 533 MPI_Request *recv_waits,*send_waits; 534 MPI_Status recv_status,*send_status,*recv_statuses; 535 MPI_Comm comm = mapping->comm; 536 PetscTruth debug = PETSC_FALSE; 537 538 PetscFunctionBegin; 539 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 540 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 541 if (size == 1) { 542 *nproc = 0; 543 *procs = PETSC_NULL; 544 ierr = PetscMalloc(sizeof(PetscInt),numprocs);CHKERRQ(ierr); 545 (*numprocs)[0] = 0; 546 ierr = PetscMalloc(sizeof(PetscInt*),indices);CHKERRQ(ierr); 547 (*indices)[0] = PETSC_NULL; 548 PetscFunctionReturn(0); 549 } 550 551 ierr = PetscOptionsHasName(PETSC_NULL,"-islocaltoglobalmappinggetinfo_debug",&debug);CHKERRQ(ierr); 552 553 /* 554 Notes on ISLocalToGlobalMappingGetInfo 555 556 globally owned node - the nodes that have been assigned to this processor in global 557 numbering, just for this routine. 558 559 nontrivial globally owned node - node assigned to this processor that is on a subdomain 560 boundary (i.e. is has more than one local owner) 561 562 locally owned node - node that exists on this processors subdomain 563 564 nontrivial locally owned node - node that is not in the interior (i.e. has more than one 565 local subdomain 566 */ 567 ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag1);CHKERRQ(ierr); 568 ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag2);CHKERRQ(ierr); 569 ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag3);CHKERRQ(ierr); 570 571 for (i=0; i<n; i++) { 572 if (lindices[i] > max) max = lindices[i]; 573 } 574 ierr = MPI_Allreduce(&max,&Ng,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr); 575 Ng++; 576 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 577 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 578 scale = Ng/size + 1; 579 ng = scale; if (rank == size-1) ng = Ng - scale*(size-1); ng = PetscMax(1,ng); 580 rstart = scale*rank; 581 582 /* determine ownership ranges of global indices */ 583 ierr = PetscMalloc(2*size*sizeof(PetscInt),&nprocs);CHKERRQ(ierr); 584 ierr = PetscMemzero(nprocs,2*size*sizeof(PetscInt));CHKERRQ(ierr); 585 586 /* determine owners of each local node */ 587 ierr = PetscMalloc(n*sizeof(PetscInt),&owner);CHKERRQ(ierr); 588 for (i=0; i<n; i++) { 589 proc = lindices[i]/scale; /* processor that globally owns this index */ 590 nprocs[2*proc+1] = 1; /* processor globally owns at least one of ours */ 591 owner[i] = proc; 592 nprocs[2*proc]++; /* count of how many that processor globally owns of ours */ 593 } 594 nsends = 0; for (i=0; i<size; i++) nsends += nprocs[2*i+1]; 595 ierr = PetscInfo1(0,"Number of global owners for my local data %d\n",nsends);CHKERRQ(ierr); 596 597 /* inform other processors of number of messages and max length*/ 598 ierr = PetscMaxSum(comm,nprocs,&nmax,&nrecvs);CHKERRQ(ierr); 599 ierr = PetscInfo1(0,"Number of local owners for my global data %d\n",nrecvs);CHKERRQ(ierr); 600 601 /* post receives for owned rows */ 602 ierr = PetscMalloc((2*nrecvs+1)*(nmax+1)*sizeof(PetscInt),&recvs);CHKERRQ(ierr); 603 ierr = PetscMalloc((nrecvs+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr); 604 for (i=0; i<nrecvs; i++) { 605 ierr = MPI_Irecv(recvs+2*nmax*i,2*nmax,MPIU_INT,MPI_ANY_SOURCE,tag1,comm,recv_waits+i);CHKERRQ(ierr); 606 } 607 608 /* pack messages containing lists of local nodes to owners */ 609 ierr = PetscMalloc((2*n+1)*sizeof(PetscInt),&sends);CHKERRQ(ierr); 610 ierr = PetscMalloc((size+1)*sizeof(PetscInt),&starts);CHKERRQ(ierr); 611 starts[0] = 0; 612 for (i=1; i<size; i++) { starts[i] = starts[i-1] + 2*nprocs[2*i-2];} 613 for (i=0; i<n; i++) { 614 sends[starts[owner[i]]++] = lindices[i]; 615 sends[starts[owner[i]]++] = i; 616 } 617 ierr = PetscFree(owner);CHKERRQ(ierr); 618 starts[0] = 0; 619 for (i=1; i<size; i++) { starts[i] = starts[i-1] + 2*nprocs[2*i-2];} 620 621 /* send the messages */ 622 ierr = PetscMalloc((nsends+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr); 623 ierr = PetscMalloc((nsends+1)*sizeof(PetscInt),&dest);CHKERRQ(ierr); 624 cnt = 0; 625 for (i=0; i<size; i++) { 626 if (nprocs[2*i]) { 627 ierr = MPI_Isend(sends+starts[i],2*nprocs[2*i],MPIU_INT,i,tag1,comm,send_waits+cnt);CHKERRQ(ierr); 628 dest[cnt] = i; 629 cnt++; 630 } 631 } 632 ierr = PetscFree(starts);CHKERRQ(ierr); 633 634 /* wait on receives */ 635 ierr = PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),&source);CHKERRQ(ierr); 636 ierr = PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),&len);CHKERRQ(ierr); 637 cnt = nrecvs; 638 ierr = PetscMalloc((ng+1)*sizeof(PetscInt),&nownedsenders);CHKERRQ(ierr); 639 ierr = PetscMemzero(nownedsenders,ng*sizeof(PetscInt));CHKERRQ(ierr); 640 while (cnt) { 641 ierr = MPI_Waitany(nrecvs,recv_waits,&imdex,&recv_status);CHKERRQ(ierr); 642 /* unpack receives into our local space */ 643 ierr = MPI_Get_count(&recv_status,MPIU_INT,&len[imdex]);CHKERRQ(ierr); 644 source[imdex] = recv_status.MPI_SOURCE; 645 len[imdex] = len[imdex]/2; 646 /* count how many local owners for each of my global owned indices */ 647 for (i=0; i<len[imdex]; i++) nownedsenders[recvs[2*imdex*nmax+2*i]-rstart]++; 648 cnt--; 649 } 650 ierr = PetscFree(recv_waits);CHKERRQ(ierr); 651 652 /* count how many globally owned indices are on an edge multiplied by how many processors own them. */ 653 nowned = 0; 654 nownedm = 0; 655 for (i=0; i<ng; i++) { 656 if (nownedsenders[i] > 1) {nownedm += nownedsenders[i]; nowned++;} 657 } 658 659 /* create single array to contain rank of all local owners of each globally owned index */ 660 ierr = PetscMalloc((nownedm+1)*sizeof(PetscInt),&ownedsenders);CHKERRQ(ierr); 661 ierr = PetscMalloc((ng+1)*sizeof(PetscInt),&starts);CHKERRQ(ierr); 662 starts[0] = 0; 663 for (i=1; i<ng; i++) { 664 if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1]; 665 else starts[i] = starts[i-1]; 666 } 667 668 /* for each nontrival globally owned node list all arriving processors */ 669 for (i=0; i<nrecvs; i++) { 670 for (j=0; j<len[i]; j++) { 671 node = recvs[2*i*nmax+2*j]-rstart; 672 if (nownedsenders[node] > 1) { 673 ownedsenders[starts[node]++] = source[i]; 674 } 675 } 676 } 677 678 if (debug) { /* ----------------------------------- */ 679 starts[0] = 0; 680 for (i=1; i<ng; i++) { 681 if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1]; 682 else starts[i] = starts[i-1]; 683 } 684 for (i=0; i<ng; i++) { 685 if (nownedsenders[i] > 1) { 686 ierr = PetscSynchronizedPrintf(comm,"[%d] global node %d local owner processors: ",rank,i+rstart);CHKERRQ(ierr); 687 for (j=0; j<nownedsenders[i]; j++) { 688 ierr = PetscSynchronizedPrintf(comm,"%d ",ownedsenders[starts[i]+j]);CHKERRQ(ierr); 689 } 690 ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr); 691 } 692 } 693 ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr); 694 }/* ----------------------------------- */ 695 696 /* wait on original sends */ 697 if (nsends) { 698 ierr = PetscMalloc(nsends*sizeof(MPI_Status),&send_status);CHKERRQ(ierr); 699 ierr = MPI_Waitall(nsends,send_waits,send_status);CHKERRQ(ierr); 700 ierr = PetscFree(send_status);CHKERRQ(ierr); 701 } 702 ierr = PetscFree(send_waits);CHKERRQ(ierr); 703 ierr = PetscFree(sends);CHKERRQ(ierr); 704 ierr = PetscFree(nprocs);CHKERRQ(ierr); 705 706 /* pack messages to send back to local owners */ 707 starts[0] = 0; 708 for (i=1; i<ng; i++) { 709 if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1]; 710 else starts[i] = starts[i-1]; 711 } 712 nsends2 = nrecvs; 713 ierr = PetscMalloc((nsends2+1)*sizeof(PetscInt),&nprocs);CHKERRQ(ierr); /* length of each message */ 714 for (i=0; i<nrecvs; i++) { 715 nprocs[i] = 1; 716 for (j=0; j<len[i]; j++) { 717 node = recvs[2*i*nmax+2*j]-rstart; 718 if (nownedsenders[node] > 1) { 719 nprocs[i] += 2 + nownedsenders[node]; 720 } 721 } 722 } 723 nt = 0; for (i=0; i<nsends2; i++) nt += nprocs[i]; 724 ierr = PetscMalloc((nt+1)*sizeof(PetscInt),&sends2);CHKERRQ(ierr); 725 ierr = PetscMalloc((nsends2+1)*sizeof(PetscInt),&starts2);CHKERRQ(ierr); 726 starts2[0] = 0; for (i=1; i<nsends2; i++) starts2[i] = starts2[i-1] + nprocs[i-1]; 727 /* 728 Each message is 1 + nprocs[i] long, and consists of 729 (0) the number of nodes being sent back 730 (1) the local node number, 731 (2) the number of processors sharing it, 732 (3) the processors sharing it 733 */ 734 for (i=0; i<nsends2; i++) { 735 cnt = 1; 736 sends2[starts2[i]] = 0; 737 for (j=0; j<len[i]; j++) { 738 node = recvs[2*i*nmax+2*j]-rstart; 739 if (nownedsenders[node] > 1) { 740 sends2[starts2[i]]++; 741 sends2[starts2[i]+cnt++] = recvs[2*i*nmax+2*j+1]; 742 sends2[starts2[i]+cnt++] = nownedsenders[node]; 743 ierr = PetscMemcpy(&sends2[starts2[i]+cnt],&ownedsenders[starts[node]],nownedsenders[node]*sizeof(PetscInt));CHKERRQ(ierr); 744 cnt += nownedsenders[node]; 745 } 746 } 747 } 748 749 /* receive the message lengths */ 750 nrecvs2 = nsends; 751 ierr = PetscMalloc((nrecvs2+1)*sizeof(PetscInt),&lens2);CHKERRQ(ierr); 752 ierr = PetscMalloc((nrecvs2+1)*sizeof(PetscInt),&starts3);CHKERRQ(ierr); 753 ierr = PetscMalloc((nrecvs2+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr); 754 for (i=0; i<nrecvs2; i++) { 755 ierr = MPI_Irecv(&lens2[i],1,MPIU_INT,dest[i],tag2,comm,recv_waits+i);CHKERRQ(ierr); 756 } 757 758 /* send the message lengths */ 759 for (i=0; i<nsends2; i++) { 760 ierr = MPI_Send(&nprocs[i],1,MPIU_INT,source[i],tag2,comm);CHKERRQ(ierr); 761 } 762 763 /* wait on receives of lens */ 764 if (nrecvs2) { 765 ierr = PetscMalloc(nrecvs2*sizeof(MPI_Status),&recv_statuses);CHKERRQ(ierr); 766 ierr = MPI_Waitall(nrecvs2,recv_waits,recv_statuses);CHKERRQ(ierr); 767 ierr = PetscFree(recv_statuses);CHKERRQ(ierr); 768 } 769 ierr = PetscFree(recv_waits); 770 771 starts3[0] = 0; 772 nt = 0; 773 for (i=0; i<nrecvs2-1; i++) { 774 starts3[i+1] = starts3[i] + lens2[i]; 775 nt += lens2[i]; 776 } 777 nt += lens2[nrecvs2-1]; 778 779 ierr = PetscMalloc((nt+1)*sizeof(PetscInt),&recvs2);CHKERRQ(ierr); 780 ierr = PetscMalloc((nrecvs2+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr); 781 for (i=0; i<nrecvs2; i++) { 782 ierr = MPI_Irecv(recvs2+starts3[i],lens2[i],MPIU_INT,dest[i],tag3,comm,recv_waits+i);CHKERRQ(ierr); 783 } 784 785 /* send the messages */ 786 ierr = PetscMalloc((nsends2+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr); 787 for (i=0; i<nsends2; i++) { 788 ierr = MPI_Isend(sends2+starts2[i],nprocs[i],MPIU_INT,source[i],tag3,comm,send_waits+i);CHKERRQ(ierr); 789 } 790 791 /* wait on receives */ 792 if (nrecvs2) { 793 ierr = PetscMalloc(nrecvs2*sizeof(MPI_Status),&recv_statuses);CHKERRQ(ierr); 794 ierr = MPI_Waitall(nrecvs2,recv_waits,recv_statuses);CHKERRQ(ierr); 795 ierr = PetscFree(recv_statuses);CHKERRQ(ierr); 796 } 797 ierr = PetscFree(recv_waits);CHKERRQ(ierr); 798 ierr = PetscFree(nprocs);CHKERRQ(ierr); 799 800 if (debug) { /* ----------------------------------- */ 801 cnt = 0; 802 for (i=0; i<nrecvs2; i++) { 803 nt = recvs2[cnt++]; 804 for (j=0; j<nt; j++) { 805 ierr = PetscSynchronizedPrintf(comm,"[%d] local node %d number of subdomains %d: ",rank,recvs2[cnt],recvs2[cnt+1]);CHKERRQ(ierr); 806 for (k=0; k<recvs2[cnt+1]; k++) { 807 ierr = PetscSynchronizedPrintf(comm,"%d ",recvs2[cnt+2+k]);CHKERRQ(ierr); 808 } 809 cnt += 2 + recvs2[cnt+1]; 810 ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr); 811 } 812 } 813 ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr); 814 } /* ----------------------------------- */ 815 816 /* count number subdomains for each local node */ 817 ierr = PetscMalloc(size*sizeof(PetscInt),&nprocs);CHKERRQ(ierr); 818 ierr = PetscMemzero(nprocs,size*sizeof(PetscInt));CHKERRQ(ierr); 819 cnt = 0; 820 for (i=0; i<nrecvs2; i++) { 821 nt = recvs2[cnt++]; 822 for (j=0; j<nt; j++) { 823 for (k=0; k<recvs2[cnt+1]; k++) { 824 nprocs[recvs2[cnt+2+k]]++; 825 } 826 cnt += 2 + recvs2[cnt+1]; 827 } 828 } 829 nt = 0; for (i=0; i<size; i++) nt += (nprocs[i] > 0); 830 *nproc = nt; 831 ierr = PetscMalloc((nt+1)*sizeof(PetscInt),procs);CHKERRQ(ierr); 832 ierr = PetscMalloc((nt+1)*sizeof(PetscInt),numprocs);CHKERRQ(ierr); 833 ierr = PetscMalloc((nt+1)*sizeof(PetscInt*),indices);CHKERRQ(ierr); 834 ierr = PetscMalloc(size*sizeof(PetscInt),&bprocs);CHKERRQ(ierr); 835 cnt = 0; 836 for (i=0; i<size; i++) { 837 if (nprocs[i] > 0) { 838 bprocs[i] = cnt; 839 (*procs)[cnt] = i; 840 (*numprocs)[cnt] = nprocs[i]; 841 ierr = PetscMalloc(nprocs[i]*sizeof(PetscInt),&(*indices)[cnt]);CHKERRQ(ierr); 842 cnt++; 843 } 844 } 845 846 /* make the list of subdomains for each nontrivial local node */ 847 ierr = PetscMemzero(*numprocs,nt*sizeof(PetscInt));CHKERRQ(ierr); 848 cnt = 0; 849 for (i=0; i<nrecvs2; i++) { 850 nt = recvs2[cnt++]; 851 for (j=0; j<nt; j++) { 852 for (k=0; k<recvs2[cnt+1]; k++) { 853 (*indices)[bprocs[recvs2[cnt+2+k]]][(*numprocs)[bprocs[recvs2[cnt+2+k]]]++] = recvs2[cnt]; 854 } 855 cnt += 2 + recvs2[cnt+1]; 856 } 857 } 858 ierr = PetscFree(bprocs);CHKERRQ(ierr); 859 ierr = PetscFree(recvs2);CHKERRQ(ierr); 860 861 /* sort the node indexing by their global numbers */ 862 nt = *nproc; 863 for (i=0; i<nt; i++) { 864 ierr = PetscMalloc(((*numprocs)[i])*sizeof(PetscInt),&tmp);CHKERRQ(ierr); 865 for (j=0; j<(*numprocs)[i]; j++) { 866 tmp[j] = lindices[(*indices)[i][j]]; 867 } 868 ierr = PetscSortIntWithArray((*numprocs)[i],tmp,(*indices)[i]);CHKERRQ(ierr); 869 ierr = PetscFree(tmp);CHKERRQ(ierr); 870 } 871 872 if (debug) { /* ----------------------------------- */ 873 nt = *nproc; 874 for (i=0; i<nt; i++) { 875 ierr = PetscSynchronizedPrintf(comm,"[%d] subdomain %d number of indices %d: ",rank,(*procs)[i],(*numprocs)[i]);CHKERRQ(ierr); 876 for (j=0; j<(*numprocs)[i]; j++) { 877 ierr = PetscSynchronizedPrintf(comm,"%d ",(*indices)[i][j]);CHKERRQ(ierr); 878 } 879 ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr); 880 } 881 ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr); 882 } /* ----------------------------------- */ 883 884 /* wait on sends */ 885 if (nsends2) { 886 ierr = PetscMalloc(nsends2*sizeof(MPI_Status),&send_status);CHKERRQ(ierr); 887 ierr = MPI_Waitall(nsends2,send_waits,send_status);CHKERRQ(ierr); 888 ierr = PetscFree(send_status);CHKERRQ(ierr); 889 } 890 891 ierr = PetscFree(starts3);CHKERRQ(ierr); 892 ierr = PetscFree(dest);CHKERRQ(ierr); 893 ierr = PetscFree(send_waits);CHKERRQ(ierr); 894 895 ierr = PetscFree(nownedsenders);CHKERRQ(ierr); 896 ierr = PetscFree(ownedsenders);CHKERRQ(ierr); 897 ierr = PetscFree(starts);CHKERRQ(ierr); 898 ierr = PetscFree(starts2);CHKERRQ(ierr); 899 ierr = PetscFree(lens2);CHKERRQ(ierr); 900 901 ierr = PetscFree(source);CHKERRQ(ierr); 902 ierr = PetscFree(len);CHKERRQ(ierr); 903 ierr = PetscFree(recvs);CHKERRQ(ierr); 904 ierr = PetscFree(nprocs);CHKERRQ(ierr); 905 ierr = PetscFree(sends2);CHKERRQ(ierr); 906 907 /* put the information about myself as the first entry in the list */ 908 first_procs = (*procs)[0]; 909 first_numprocs = (*numprocs)[0]; 910 first_indices = (*indices)[0]; 911 for (i=0; i<*nproc; i++) { 912 if ((*procs)[i] == rank) { 913 (*procs)[0] = (*procs)[i]; 914 (*numprocs)[0] = (*numprocs)[i]; 915 (*indices)[0] = (*indices)[i]; 916 (*procs)[i] = first_procs; 917 (*numprocs)[i] = first_numprocs; 918 (*indices)[i] = first_indices; 919 break; 920 } 921 } 922 PetscFunctionReturn(0); 923 } 924 925 #undef __FUNCT__ 926 #define __FUNCT__ "ISLocalToGlobalMappingRestoreInfo" 927 /*@C 928 ISLocalToGlobalMappingRestoreInfo - Frees the memory allocated by ISLocalToGlobalMappingGetInfo() 929 930 Collective on ISLocalToGlobalMapping 931 932 Input Parameters: 933 . mapping - the mapping from local to global indexing 934 935 Output Parameter: 936 + nproc - number of processors that are connected to this one 937 . proc - neighboring processors 938 . numproc - number of indices for each processor 939 - indices - indices of local nodes shared with neighbor (sorted by global numbering) 940 941 Level: advanced 942 943 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate(), 944 ISLocalToGlobalMappingGetInfo() 945 @*/ 946 PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingRestoreInfo(ISLocalToGlobalMapping mapping,PetscInt *nproc,PetscInt *procs[],PetscInt *numprocs[],PetscInt **indices[]) 947 { 948 PetscErrorCode ierr; 949 PetscInt i; 950 951 PetscFunctionBegin; 952 ierr = PetscFree(*procs);CHKERRQ(ierr); 953 ierr = PetscFree(*numprocs);CHKERRQ(ierr); 954 if (*indices) { 955 ierr = PetscFree((*indices)[0]);CHKERRQ(ierr); 956 for (i=1; i<*nproc; i++) { 957 ierr = PetscFree((*indices)[i]);CHKERRQ(ierr); 958 } 959 ierr = PetscFree(*indices);CHKERRQ(ierr); 960 } 961 PetscFunctionReturn(0); 962 } 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981