1 #include <../src/vec/is/sf/impls/basic/allgatherv/sfallgatherv.h> 2 3 /* PetscSFGetGraph is non-collective. An implementation should not have collective calls */ 4 PETSC_INTERN PetscErrorCode PetscSFGetGraph_Allgatherv(PetscSF sf, PetscInt *nroots, PetscInt *nleaves, const PetscInt **ilocal, const PetscSFNode **iremote) 5 { 6 PetscInt j, k; 7 const PetscInt *range; 8 PetscMPIInt size; 9 10 PetscFunctionBegin; 11 PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)sf), &size)); 12 if (nroots) *nroots = sf->nroots; 13 if (nleaves) *nleaves = sf->nleaves; 14 if (ilocal) *ilocal = NULL; /* Contiguous leaves */ 15 if (iremote) { 16 if (!sf->remote && sf->nleaves) { /* The && sf->nleaves makes sfgatherv able to inherit this routine */ 17 PetscCall(PetscLayoutGetRanges(sf->map, &range)); 18 PetscCall(PetscMalloc1(sf->nleaves, &sf->remote)); 19 sf->remote_alloc = sf->remote; 20 for (PetscMPIInt i = 0; i < size; i++) { 21 for (j = range[i], k = 0; j < range[i + 1]; j++, k++) { 22 sf->remote[j].rank = i; 23 sf->remote[j].index = k; 24 } 25 } 26 } 27 *iremote = sf->remote; 28 } 29 PetscFunctionReturn(PETSC_SUCCESS); 30 } 31 32 PETSC_INTERN PetscErrorCode PetscSFSetUp_Allgatherv(PetscSF sf) 33 { 34 PetscSF_Allgatherv *dat = (PetscSF_Allgatherv *)sf->data; 35 PetscMPIInt size; 36 PetscInt i; 37 const PetscInt *range; 38 MPI_Comm comm; 39 40 PetscFunctionBegin; 41 PetscCall(PetscSFSetUp_Allgather(sf)); 42 PetscCall(PetscObjectGetComm((PetscObject)sf, &comm)); 43 PetscCallMPI(MPI_Comm_size(comm, &size)); 44 if (sf->nleaves) { /* This if (sf->nleaves) test makes sfgatherv able to inherit this routine */ 45 PetscBool isallgatherv = PETSC_FALSE; 46 47 PetscCall(PetscMalloc1(size, &dat->recvcounts)); 48 PetscCall(PetscMalloc1(size, &dat->displs)); 49 PetscCall(PetscLayoutGetRanges(sf->map, &range)); 50 51 for (i = 0; i < size; i++) { 52 PetscCall(PetscMPIIntCast(range[i], &dat->displs[i])); 53 PetscCall(PetscMPIIntCast(range[i + 1] - range[i], &dat->recvcounts[i])); 54 } 55 56 /* check if we actually have a one-to-all pattern */ 57 PetscCall(PetscObjectTypeCompare((PetscObject)sf, PETSCSFALLGATHERV, &isallgatherv)); 58 if (isallgatherv) { 59 PetscMPIInt rank, nRanksWithZeroRoots; 60 61 nRanksWithZeroRoots = (sf->nroots == 0) ? 1 : 0; /* I have no roots */ 62 PetscCallMPI(MPIU_Allreduce(MPI_IN_PLACE, &nRanksWithZeroRoots, 1, MPI_INT, MPI_SUM, comm)); 63 if (nRanksWithZeroRoots == size - 1) { /* Only one rank has roots, which indicates a bcast pattern */ 64 dat->bcast_pattern = PETSC_TRUE; 65 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 66 dat->bcast_root = sf->nroots > 0 ? rank : -1; 67 PetscCallMPI(MPIU_Allreduce(MPI_IN_PLACE, &dat->bcast_root, 1, MPI_INT, MPI_MAX, comm)); 68 } 69 } 70 } 71 PetscFunctionReturn(PETSC_SUCCESS); 72 } 73 74 PETSC_INTERN PetscErrorCode PetscSFReset_Allgatherv(PetscSF sf) 75 { 76 PetscSF_Allgatherv *dat = (PetscSF_Allgatherv *)sf->data; 77 PetscSFLink link = dat->avail, next; 78 79 PetscFunctionBegin; 80 PetscCall(PetscFree(dat->iranks)); 81 PetscCall(PetscFree(dat->ioffset)); 82 PetscCall(PetscFree(dat->irootloc)); 83 PetscCall(PetscFree(dat->recvcounts)); 84 PetscCall(PetscFree(dat->displs)); 85 PetscCheck(!dat->inuse, PetscObjectComm((PetscObject)sf), PETSC_ERR_ARG_WRONGSTATE, "Outstanding operation has not been completed"); 86 for (; link; link = next) { 87 next = link->next; 88 PetscCall(PetscSFLinkDestroy(sf, link)); 89 } 90 dat->avail = NULL; 91 PetscFunctionReturn(PETSC_SUCCESS); 92 } 93 94 PETSC_INTERN PetscErrorCode PetscSFDestroy_Allgatherv(PetscSF sf) 95 { 96 PetscFunctionBegin; 97 PetscCall(PetscSFReset_Allgatherv(sf)); 98 PetscCall(PetscFree(sf->data)); 99 PetscFunctionReturn(PETSC_SUCCESS); 100 } 101 102 static PetscErrorCode PetscSFBcastBegin_Allgatherv(PetscSF sf, MPI_Datatype unit, PetscMemType rootmtype, const void *rootdata, PetscMemType leafmtype, void *leafdata, MPI_Op op) 103 { 104 PetscSFLink link; 105 PetscMPIInt sendcount, rank, nleaves; 106 MPI_Comm comm; 107 void *rootbuf = NULL, *leafbuf = NULL; 108 MPI_Request *req = NULL; 109 PetscSF_Allgatherv *dat = (PetscSF_Allgatherv *)sf->data; 110 111 PetscFunctionBegin; 112 PetscCall(PetscSFLinkCreate(sf, unit, rootmtype, rootdata, leafmtype, leafdata, op, PETSCSF_BCAST, &link)); 113 PetscCall(PetscSFLinkPackRootData(sf, link, PETSCSF_REMOTE, rootdata)); 114 PetscCall(PetscSFLinkCopyRootBufferInCaseNotUseGpuAwareMPI(sf, link, PETSC_TRUE /* device2host before sending */)); 115 PetscCall(PetscObjectGetComm((PetscObject)sf, &comm)); 116 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 117 PetscCall(PetscMPIIntCast(sf->nroots, &sendcount)); 118 PetscCall(PetscSFLinkGetMPIBuffersAndRequests(sf, link, PETSCSF_ROOT2LEAF, &rootbuf, &leafbuf, &req, NULL)); 119 120 if (dat->bcast_pattern && rank == dat->bcast_root) PetscCall((*link->Memcpy)(link, link->leafmtype_mpi, leafbuf, link->rootmtype_mpi, rootbuf, (size_t)sendcount * link->unitbytes)); 121 /* Ready the buffers for MPI */ 122 PetscCall(PetscSFLinkSyncStreamBeforeCallMPI(sf, link)); 123 PetscCall(PetscMPIIntCast(sf->nleaves, &nleaves)); 124 if (dat->bcast_pattern) PetscCallMPI(MPIU_Ibcast(leafbuf, nleaves, unit, dat->bcast_root, comm, req)); 125 else PetscCallMPI(MPIU_Iallgatherv(rootbuf, sendcount, unit, leafbuf, dat->recvcounts, dat->displs, unit, comm, req)); 126 PetscFunctionReturn(PETSC_SUCCESS); 127 } 128 129 static PetscErrorCode PetscSFReduceBegin_Allgatherv(PetscSF sf, MPI_Datatype unit, PetscMemType leafmtype, const void *leafdata, PetscMemType rootmtype, void *rootdata, MPI_Op op) 130 { 131 PetscSFLink link; 132 PetscSF_Allgatherv *dat = (PetscSF_Allgatherv *)sf->data; 133 PetscInt rstart; 134 PetscMPIInt rank, count, recvcount; 135 MPI_Comm comm; 136 void *rootbuf = NULL, *leafbuf = NULL; 137 MPI_Request *req = NULL; 138 139 PetscFunctionBegin; 140 PetscCall(PetscSFLinkCreate(sf, unit, rootmtype, rootdata, leafmtype, leafdata, op, PETSCSF_REDUCE, &link)); 141 if (op == MPI_REPLACE) { 142 /* REPLACE is only meaningful when all processes have the same leafdata to reduce. Therefore copying from local leafdata is fine */ 143 PetscCall(PetscLayoutGetRange(sf->map, &rstart, NULL)); 144 PetscCall((*link->Memcpy)(link, rootmtype, rootdata, leafmtype, (const char *)leafdata + (size_t)rstart * link->unitbytes, (size_t)sf->nroots * link->unitbytes)); 145 if (PetscMemTypeDevice(leafmtype) && PetscMemTypeHost(rootmtype)) PetscCall((*link->SyncStream)(link)); 146 } else { 147 PetscCall(PetscObjectGetComm((PetscObject)sf, &comm)); 148 PetscCall(PetscSFLinkPackLeafData(sf, link, PETSCSF_REMOTE, leafdata)); 149 PetscCall(PetscSFLinkCopyLeafBufferInCaseNotUseGpuAwareMPI(sf, link, PETSC_TRUE /* device2host before sending */)); 150 PetscCall(PetscSFLinkGetMPIBuffersAndRequests(sf, link, PETSCSF_LEAF2ROOT, &rootbuf, &leafbuf, &req, NULL)); 151 PetscCall(PetscSFLinkSyncStreamBeforeCallMPI(sf, link)); 152 if (dat->bcast_pattern) { 153 #if defined(PETSC_HAVE_OPENMPI) /* Workaround: cuda-aware Open MPI 4.1.3 does not support MPI_Ireduce() with device buffers */ 154 *req = MPI_REQUEST_NULL; /* Set NULL so that we can safely MPI_Wait(req) */ 155 PetscCallMPI(MPIU_Reduce(leafbuf, rootbuf, sf->nleaves, unit, op, dat->bcast_root, comm)); 156 #else 157 PetscCallMPI(MPIU_Ireduce(leafbuf, rootbuf, sf->nleaves, unit, op, dat->bcast_root, comm, req)); 158 #endif 159 } else { /* Reduce leafdata, then scatter to rootdata */ 160 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 161 PetscCall(PetscMPIIntCast(dat->rootbuflen[PETSCSF_REMOTE], &recvcount)); 162 /* Allocate a separate leaf buffer on rank 0 */ 163 if (rank == 0 && !link->leafbuf_alloc[PETSCSF_REMOTE][link->leafmtype_mpi]) { 164 PetscCall(PetscSFMalloc(sf, link->leafmtype_mpi, sf->leafbuflen[PETSCSF_REMOTE] * link->unitbytes, (void **)&link->leafbuf_alloc[PETSCSF_REMOTE][link->leafmtype_mpi])); 165 } 166 /* In case we already copied leafdata from device to host (i.e., no use_gpu_aware_mpi), we need to adjust leafbuf on rank 0 */ 167 if (rank == 0 && link->leafbuf_alloc[PETSCSF_REMOTE][link->leafmtype_mpi] == leafbuf) leafbuf = MPI_IN_PLACE; 168 PetscCall(PetscMPIIntCast(sf->nleaves * link->bs, &count)); 169 PetscCallMPI(MPI_Reduce(leafbuf, link->leafbuf_alloc[PETSCSF_REMOTE][link->leafmtype_mpi], count, link->basicunit, op, 0, comm)); /* Must do reduce with MPI builtin datatype basicunit */ 170 PetscCallMPI(MPIU_Iscatterv(link->leafbuf_alloc[PETSCSF_REMOTE][link->leafmtype_mpi], dat->recvcounts, dat->displs, unit, rootbuf, recvcount, unit, 0, comm, req)); 171 } 172 } 173 PetscFunctionReturn(PETSC_SUCCESS); 174 } 175 176 PETSC_INTERN PetscErrorCode PetscSFReduceEnd_Allgatherv(PetscSF sf, MPI_Datatype unit, const void *leafdata, void *rootdata, MPI_Op op) 177 { 178 PetscSFLink link; 179 180 PetscFunctionBegin; 181 if (op == MPI_REPLACE) { 182 /* A rare case happens when op is MPI_REPLACE, using GPUs but no GPU aware MPI. In PetscSFReduceBegin_Allgather(v), 183 we did a device to device copy and in effect finished the communication. But in PetscSFLinkFinishCommunication() 184 of PetscSFReduceEnd_Basic(), it thinks since there is rootbuf, it calls PetscSFLinkCopyRootBufferInCaseNotUseGpuAwareMPI(). 185 It does a host to device memory copy on rootbuf, wrongly overwriting the results. So we don't overload 186 PetscSFReduceEnd_Basic() in this case, and just reclaim the link. 187 */ 188 PetscCall(PetscSFLinkGetInUse(sf, unit, rootdata, leafdata, PETSC_OWN_POINTER, &link)); 189 PetscCall(PetscSFLinkReclaim(sf, &link)); 190 } else { 191 PetscCall(PetscSFReduceEnd_Basic(sf, unit, leafdata, rootdata, op)); 192 } 193 PetscFunctionReturn(PETSC_SUCCESS); 194 } 195 196 static PetscErrorCode PetscSFBcastToZero_Allgatherv(PetscSF sf, MPI_Datatype unit, PetscMemType rootmtype, const void *rootdata, PetscMemType leafmtype, void *leafdata) 197 { 198 PetscSFLink link; 199 PetscMPIInt rank; 200 PetscMPIInt sendcount; 201 MPI_Comm comm; 202 PetscSF_Allgatherv *dat = (PetscSF_Allgatherv *)sf->data; 203 void *rootbuf = NULL, *leafbuf = NULL; /* buffer seen by MPI */ 204 MPI_Request *req = NULL; 205 206 PetscFunctionBegin; 207 PetscCall(PetscSFLinkCreate(sf, unit, rootmtype, rootdata, leafmtype, leafdata, MPI_REPLACE, PETSCSF_BCAST, &link)); 208 PetscCall(PetscSFLinkPackRootData(sf, link, PETSCSF_REMOTE, rootdata)); 209 PetscCall(PetscSFLinkCopyRootBufferInCaseNotUseGpuAwareMPI(sf, link, PETSC_TRUE /* device2host before sending */)); 210 PetscCall(PetscObjectGetComm((PetscObject)sf, &comm)); 211 PetscCall(PetscMPIIntCast(sf->nroots, &sendcount)); 212 PetscCall(PetscSFLinkGetMPIBuffersAndRequests(sf, link, PETSCSF_ROOT2LEAF, &rootbuf, &leafbuf, &req, NULL)); 213 PetscCall(PetscSFLinkSyncStreamBeforeCallMPI(sf, link)); 214 PetscCallMPI(MPIU_Igatherv(rootbuf, sendcount, unit, leafbuf, dat->recvcounts, dat->displs, unit, 0 /*rank 0*/, comm, req)); 215 216 PetscCall(PetscSFLinkGetInUse(sf, unit, rootdata, leafdata, PETSC_OWN_POINTER, &link)); 217 PetscCall(PetscSFLinkFinishCommunication(sf, link, PETSCSF_ROOT2LEAF)); 218 PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)sf), &rank)); 219 if (rank == 0 && PetscMemTypeDevice(leafmtype) && !sf->use_gpu_aware_mpi) PetscCall((*link->Memcpy)(link, PETSC_MEMTYPE_DEVICE, leafdata, PETSC_MEMTYPE_HOST, link->leafbuf[PETSC_MEMTYPE_HOST], sf->leafbuflen[PETSCSF_REMOTE] * link->unitbytes)); 220 PetscCall(PetscSFLinkReclaim(sf, &link)); 221 PetscFunctionReturn(PETSC_SUCCESS); 222 } 223 224 /* This routine is very tricky (I believe it is rarely used with this kind of graph so just provide a simple but not-optimal implementation). 225 226 Suppose we have three ranks. Rank 0 has a root with value 1. Rank 0,1,2 has a leaf with value 2,3,4 respectively. The leaves are connected 227 to the root on rank 0. Suppose op=MPI_SUM and rank 0,1,2 gets root state in their rank order. By definition of this routine, rank 0 sees 1 228 in root, fetches it into its leafupate, then updates root to 1 + 2 = 3; rank 1 sees 3 in root, fetches it into its leafupate, then updates 229 root to 3 + 3 = 6; rank 2 sees 6 in root, fetches it into its leafupdate, then updates root to 6 + 4 = 10. At the end, leafupdate on rank 230 0,1,2 is 1,3,6 respectively. root is 10. 231 232 We use a simpler implementation. From the same initial state, we copy leafdata to leafupdate 233 rank-0 rank-1 rank-2 234 Root 1 235 Leaf 2 3 4 236 Leafupdate 2 3 4 237 238 Do MPI_Exscan on leafupdate, 239 rank-0 rank-1 rank-2 240 Root 1 241 Leaf 2 3 4 242 Leafupdate 2 2 5 243 244 BcastAndOp from root to leafupdate, 245 rank-0 rank-1 rank-2 246 Root 1 247 Leaf 2 3 4 248 Leafupdate 3 3 6 249 250 Copy root to leafupdate on rank-0 251 rank-0 rank-1 rank-2 252 Root 1 253 Leaf 2 3 4 254 Leafupdate 1 3 6 255 256 Reduce from leaf to root, 257 rank-0 rank-1 rank-2 258 Root 10 259 Leaf 2 3 4 260 Leafupdate 1 3 6 261 */ 262 PETSC_INTERN PetscErrorCode PetscSFFetchAndOpBegin_Allgatherv(PetscSF sf, MPI_Datatype unit, PetscMemType rootmtype, void *rootdata, PetscMemType leafmtype, const void *leafdata, void *leafupdate, MPI_Op op) 263 { 264 PetscSFLink link; 265 MPI_Comm comm; 266 PetscMPIInt count; 267 268 PetscFunctionBegin; 269 PetscCall(PetscObjectGetComm((PetscObject)sf, &comm)); 270 PetscCheck(!PetscMemTypeDevice(rootmtype) && !PetscMemTypeDevice(leafmtype), comm, PETSC_ERR_SUP, "Do FetchAndOp on device"); 271 /* Copy leafdata to leafupdate */ 272 PetscCall(PetscSFLinkCreate(sf, unit, rootmtype, rootdata, leafmtype, leafdata, op, PETSCSF_FETCH, &link)); 273 PetscCall(PetscSFLinkPackLeafData(sf, link, PETSCSF_REMOTE, leafdata)); /* Sync the device */ 274 PetscCall((*link->Memcpy)(link, leafmtype, leafupdate, leafmtype, leafdata, sf->nleaves * link->unitbytes)); 275 PetscCall(PetscSFLinkGetInUse(sf, unit, rootdata, leafdata, PETSC_OWN_POINTER, &link)); 276 277 /* Exscan on leafupdate and then BcastAndOp rootdata to leafupdate */ 278 if (op == MPI_REPLACE) { 279 PetscMPIInt size, rank, prev, next; 280 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 281 PetscCallMPI(MPI_Comm_size(comm, &size)); 282 prev = rank ? rank - 1 : MPI_PROC_NULL; 283 next = (rank < size - 1) ? rank + 1 : MPI_PROC_NULL; 284 PetscCall(PetscMPIIntCast(sf->nleaves, &count)); 285 PetscCallMPI(MPI_Sendrecv_replace(leafupdate, count, unit, next, link->tag, prev, link->tag, comm, MPI_STATUSES_IGNORE)); 286 } else { 287 PetscCall(PetscMPIIntCast(sf->nleaves * link->bs, &count)); 288 PetscCallMPI(MPI_Exscan(MPI_IN_PLACE, leafupdate, count, link->basicunit, op, comm)); 289 } 290 PetscCall(PetscSFLinkReclaim(sf, &link)); 291 PetscCall(PetscSFBcastBegin(sf, unit, rootdata, leafupdate, op)); 292 PetscCall(PetscSFBcastEnd(sf, unit, rootdata, leafupdate, op)); 293 294 /* Bcast roots to rank 0's leafupdate */ 295 PetscCall(PetscSFBcastToZero_Private(sf, unit, rootdata, leafupdate)); /* Using this line makes Allgather SFs able to inherit this routine */ 296 297 /* Reduce leafdata to rootdata */ 298 PetscCall(PetscSFReduceBegin(sf, unit, leafdata, rootdata, op)); 299 PetscFunctionReturn(PETSC_SUCCESS); 300 } 301 302 PETSC_INTERN PetscErrorCode PetscSFFetchAndOpEnd_Allgatherv(PetscSF sf, MPI_Datatype unit, void *rootdata, const void *leafdata, void *leafupdate, MPI_Op op) 303 { 304 PetscFunctionBegin; 305 PetscCall(PetscSFReduceEnd(sf, unit, leafdata, rootdata, op)); 306 PetscFunctionReturn(PETSC_SUCCESS); 307 } 308 309 /* Get root ranks accessing my leaves */ 310 PETSC_INTERN PetscErrorCode PetscSFGetRootRanks_Allgatherv(PetscSF sf, PetscMPIInt *nranks, const PetscMPIInt **ranks, const PetscInt **roffset, const PetscInt **rmine, const PetscInt **rremote) 311 { 312 PetscInt j, k, size; 313 const PetscInt *range; 314 315 PetscFunctionBegin; 316 /* Lazily construct these large arrays if users really need them for this type of SF. Very likely, they do not */ 317 if (sf->nranks && !sf->ranks) { /* On rank!=0, sf->nranks=0. The sf->nranks test makes this routine also works for sfgatherv */ 318 size = sf->nranks; 319 PetscCall(PetscLayoutGetRanges(sf->map, &range)); 320 PetscCall(PetscMalloc4(size, &sf->ranks, size + 1, &sf->roffset, sf->nleaves, &sf->rmine, sf->nleaves, &sf->rremote)); 321 for (PetscMPIInt i = 0; i < size; i++) sf->ranks[i] = i; 322 PetscCall(PetscArraycpy(sf->roffset, range, size + 1)); 323 for (PetscInt i = 0; i < sf->nleaves; i++) sf->rmine[i] = i; /*rmine are never NULL even for contiguous leaves */ 324 for (PetscMPIInt i = 0; i < size; i++) { 325 for (j = range[i], k = 0; j < range[i + 1]; j++, k++) sf->rremote[j] = k; 326 } 327 } 328 329 if (nranks) *nranks = sf->nranks; 330 if (ranks) *ranks = sf->ranks; 331 if (roffset) *roffset = sf->roffset; 332 if (rmine) *rmine = sf->rmine; 333 if (rremote) *rremote = sf->rremote; 334 PetscFunctionReturn(PETSC_SUCCESS); 335 } 336 337 /* Get leaf ranks accessing my roots */ 338 PETSC_INTERN PetscErrorCode PetscSFGetLeafRanks_Allgatherv(PetscSF sf, PetscMPIInt *niranks, const PetscMPIInt **iranks, const PetscInt **ioffset, const PetscInt **irootloc) 339 { 340 PetscSF_Allgatherv *dat = (PetscSF_Allgatherv *)sf->data; 341 MPI_Comm comm; 342 PetscMPIInt size, rank; 343 344 PetscFunctionBegin; 345 /* Lazily construct these large arrays if users really need them for this type of SF. Very likely, they do not */ 346 PetscCall(PetscObjectGetComm((PetscObject)sf, &comm)); 347 PetscCallMPI(MPI_Comm_size(comm, &size)); 348 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 349 if (niranks) *niranks = size; 350 351 /* PetscSF_Basic has distinguished incoming ranks. Here we do not need that. But we must put self as the first and 352 sort other ranks. See comments in PetscSFSetUp_Basic about MatGetBrowsOfAoCols_MPIAIJ on why. 353 */ 354 if (iranks) { 355 if (!dat->iranks) { 356 PetscCall(PetscMalloc1(size, &dat->iranks)); 357 dat->iranks[0] = rank; 358 for (PetscMPIInt i = 0, j = 1; i < size; i++) { 359 if (i == rank) continue; 360 dat->iranks[j++] = i; 361 } 362 } 363 *iranks = dat->iranks; /* dat->iranks was init'ed to NULL by PetscNew */ 364 } 365 366 if (ioffset) { 367 if (!dat->ioffset) { 368 PetscCall(PetscMalloc1(size + 1, &dat->ioffset)); 369 for (PetscMPIInt i = 0; i <= size; i++) dat->ioffset[i] = i * sf->nroots; 370 } 371 *ioffset = dat->ioffset; 372 } 373 374 if (irootloc) { 375 if (!dat->irootloc) { 376 PetscCall(PetscMalloc1(sf->nleaves, &dat->irootloc)); 377 for (PetscMPIInt i = 0; i < size; i++) { 378 for (PetscInt j = 0; j < sf->nroots; j++) dat->irootloc[i * sf->nroots + j] = j; 379 } 380 } 381 *irootloc = dat->irootloc; 382 } 383 PetscFunctionReturn(PETSC_SUCCESS); 384 } 385 386 PETSC_INTERN PetscErrorCode PetscSFCreateLocalSF_Allgatherv(PetscSF sf, PetscSF *out) 387 { 388 PetscInt i, nroots, nleaves, rstart, *ilocal; 389 PetscSFNode *iremote; 390 PetscSF lsf; 391 392 PetscFunctionBegin; 393 nleaves = sf->nleaves ? sf->nroots : 0; /* sf->nleaves can be zero with SFGather(v) */ 394 nroots = nleaves; 395 PetscCall(PetscMalloc1(nleaves, &ilocal)); 396 PetscCall(PetscMalloc1(nleaves, &iremote)); 397 PetscCall(PetscLayoutGetRange(sf->map, &rstart, NULL)); 398 399 for (i = 0; i < nleaves; i++) { 400 ilocal[i] = rstart + i; /* lsf does not change leave indices */ 401 iremote[i].rank = 0; /* rank in PETSC_COMM_SELF */ 402 iremote[i].index = i; /* root index */ 403 } 404 405 PetscCall(PetscSFCreate(PETSC_COMM_SELF, &lsf)); 406 PetscCall(PetscSFSetGraph(lsf, nroots, nleaves, ilocal, PETSC_OWN_POINTER, iremote, PETSC_OWN_POINTER)); 407 PetscCall(PetscSFSetUp(lsf)); 408 *out = lsf; 409 PetscFunctionReturn(PETSC_SUCCESS); 410 } 411 412 PETSC_INTERN PetscErrorCode PetscSFCreate_Allgatherv(PetscSF sf) 413 { 414 PetscSF_Allgatherv *dat = (PetscSF_Allgatherv *)sf->data; 415 416 PetscFunctionBegin; 417 sf->ops->BcastEnd = PetscSFBcastEnd_Basic; 418 sf->ops->ReduceEnd = PetscSFReduceEnd_Allgatherv; 419 420 sf->ops->SetUp = PetscSFSetUp_Allgatherv; 421 sf->ops->Reset = PetscSFReset_Allgatherv; 422 sf->ops->Destroy = PetscSFDestroy_Allgatherv; 423 sf->ops->GetRootRanks = PetscSFGetRootRanks_Allgatherv; 424 sf->ops->GetLeafRanks = PetscSFGetLeafRanks_Allgatherv; 425 sf->ops->GetGraph = PetscSFGetGraph_Allgatherv; 426 sf->ops->BcastBegin = PetscSFBcastBegin_Allgatherv; 427 sf->ops->ReduceBegin = PetscSFReduceBegin_Allgatherv; 428 sf->ops->FetchAndOpBegin = PetscSFFetchAndOpBegin_Allgatherv; 429 sf->ops->FetchAndOpEnd = PetscSFFetchAndOpEnd_Allgatherv; 430 sf->ops->CreateLocalSF = PetscSFCreateLocalSF_Allgatherv; 431 sf->ops->BcastToZero = PetscSFBcastToZero_Allgatherv; 432 433 sf->collective = PETSC_TRUE; 434 435 PetscCall(PetscNew(&dat)); 436 dat->bcast_root = -1; 437 sf->data = (void *)dat; 438 PetscFunctionReturn(PETSC_SUCCESS); 439 } 440