/*@C
PetscCommBuildTwoSidedF - discovers communicating ranks given one-sided information, calling user-defined functions during rendezvous
Collective on MPI_Comm
Input Arguments:
+ comm - communicator
. count - number of entries to send/receive in initial rendezvous (must match on all ranks)
. dtype - datatype to send/receive from each rank (must match on all ranks)
. nto - number of ranks to send data to
. toranks - ranks to send to (array of length nto)
. todata - data to send to each rank (packed)
. ntags - number of tags needed by send/recv callbacks
. send - callback invoked on sending process when ready to send primary payload
. recv - callback invoked on receiving process after delivery of rendezvous message
- ctx - context for callbacks
Output Arguments:
+ nfrom - number of ranks receiving messages from
. fromranks - ranks receiving messages from (length nfrom; caller should PetscFree())
- fromdata - packed data from each rank, each with count entries of type dtype (length nfrom, caller responsible for PetscFree())
Level: developer
Notes:
This memory-scalable interface is an alternative to calling PetscGatherNumberOfMessages() and
PetscGatherMessageLengths(), possibly with a subsequent round of communication to send other data.
Basic data types as well as contiguous types are supported, but non-contiguous (e.g., strided) types are not.
References:
. 1. - Hoefler, Siebert and Lumsdaine, The MPI_Ibarrier implementation uses the algorithm in
Scalable communication protocols for dynamic sparse data exchange, 2010.
.seealso: PetscCommBuildTwoSided(), PetscCommBuildTwoSidedFReq(), PetscGatherNumberOfMessages(), PetscGatherMessageLengths()
@*/
PetscErrorCode PetscCommBuildTwoSidedF(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscMPIInt nto,const PetscMPIInt *toranks,const void *todata,PetscMPIInt *nfrom,PetscMPIInt **fromranks,void *fromdata,PetscMPIInt ntags,
PetscErrorCode (*send)(MPI_Comm,const PetscMPIInt[],PetscMPIInt,PetscMPIInt,void*,MPI_Request[],void*),
PetscErrorCode (*recv)(MPI_Comm,const PetscMPIInt[],PetscMPIInt,void*,MPI_Request[],void*),void *ctx)
{
PetscErrorCode ierr;
MPI_Request *toreqs,*fromreqs;
PetscFunctionBegin;
ierr = PetscCommBuildTwoSidedFReq(comm,count,dtype,nto,toranks,todata,nfrom,fromranks,fromdata,ntags,&toreqs,&fromreqs,send,recv,ctx);CHKERRQ(ierr);
ierr = MPI_Waitall(nto*ntags,toreqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
ierr = MPI_Waitall(*nfrom*ntags,fromreqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
ierr = PetscFree(toreqs);CHKERRQ(ierr);
ierr = PetscFree(fromreqs);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode VecAssemblyBegin_MPI_BTS(Vec X)
{
Vec_MPI *x = (Vec_MPI*)X->data;
PetscErrorCode ierr;
MPI_Comm comm;
PetscInt i,j,jb,bs;
PetscFunctionBegin;
if (X->stash.donotstash) PetscFunctionReturn(0);
ierr = PetscObjectGetComm((PetscObject)X,&comm);CHKERRQ(ierr);
ierr = VecGetBlockSize(X,&bs);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
{
InsertMode addv;
ierr = MPIU_Allreduce((PetscEnum*)&X->stash.insertmode,(PetscEnum*)&addv,1,MPIU_ENUM,MPI_BOR,comm);CHKERRQ(ierr);
if (addv == (ADD_VALUES|INSERT_VALUES)) SETERRQ(comm,PETSC_ERR_ARG_NOTSAMETYPE,"Some processors inserted values while others added");
}
#endif
X->bstash.insertmode = X->stash.insertmode; /* Block stash implicitly tracks InsertMode of scalar stash */
ierr = VecStashSortCompress_Private(&X->stash);CHKERRQ(ierr);
ierr = VecStashSortCompress_Private(&X->bstash);CHKERRQ(ierr);
if (!x->sendranks) {
PetscMPIInt nowners,bnowners,*owners,*bowners;
PetscInt ntmp;
ierr = VecStashGetOwnerList_Private(&X->stash,X->map,&nowners,&owners);CHKERRQ(ierr);
ierr = VecStashGetOwnerList_Private(&X->bstash,X->map,&bnowners,&bowners);CHKERRQ(ierr);
ierr = PetscMergeMPIIntArray(nowners,owners,bnowners,bowners,&ntmp,&x->sendranks);CHKERRQ(ierr);
x->nsendranks = ntmp;
ierr = PetscFree(owners);CHKERRQ(ierr);
ierr = PetscFree(bowners);CHKERRQ(ierr);
ierr = PetscMalloc1(x->nsendranks,&x->sendhdr);CHKERRQ(ierr);
ierr = PetscCalloc1(x->nsendranks,&x->sendptrs);CHKERRQ(ierr);
}
for (i=0,j=0,jb=0; i<x->nsendranks; i++) {
PetscMPIInt rank = x->sendranks[i];
x->sendhdr[i].insertmode = X->stash.insertmode;
/* Initialize pointers for non-empty stashes the first time around. Subsequent assemblies with
* VEC_SUBSET_OFF_PROC_ENTRIES will leave the old pointers (dangling because the stash has been collected) when
* there is nothing new to send, so that size-zero messages get sent instead. */
x->sendhdr[i].count = 0;
if (X->stash.n) {
x->sendptrs[i].ints = &X->stash.idx[j];
x->sendptrs[i].scalars = &X->stash.array[j];
for ( ; j<X->stash.n && X->stash.idx[j] < X->map->range[rank+1]; j++) x->sendhdr[i].count++;
}
x->sendhdr[i].bcount = 0;
if (X->bstash.n) {
x->sendptrs[i].intb = &X->bstash.idx[jb];
x->sendptrs[i].scalarb = &X->bstash.array[jb*bs];
for ( ; jb<X->bstash.n && X->bstash.idx[jb]*bs < X->map->range[rank+1]; jb++) x->sendhdr[i].bcount++;
}
}
if (!x->segrecvint) {ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&x->segrecvint);CHKERRQ(ierr);}
if (!x->segrecvscalar) {ierr = PetscSegBufferCreate(sizeof(PetscScalar),1000,&x->segrecvscalar);CHKERRQ(ierr);}
if (!x->segrecvframe) {ierr = PetscSegBufferCreate(sizeof(VecAssemblyFrame),50,&x->segrecvframe);CHKERRQ(ierr);}
if (x->recvhdr) { /* VEC_SUBSET_OFF_PROC_ENTRIES and this is not the first assembly */
PetscMPIInt tag[4];
if (!x->assembly_subset) SETERRQ(comm,PETSC_ERR_PLIB,"Attempt to reuse rendezvous when not VEC_SUBSET_OFF_PROC_ENTRIES");
for (i=0; i<4; i++) {ierr = PetscCommGetNewTag(comm,&tag[i]);CHKERRQ(ierr);}
for (i=0; i<x->nsendranks; i++) {
ierr = VecAssemblySend_MPI_Private(comm,tag,i,x->sendranks[i],x->sendhdr+i,x->sendreqs+4*i,X);CHKERRQ(ierr);
}
for (i=0; i<x->nrecvranks; i++) {
ierr = VecAssemblyRecv_MPI_Private(comm,tag,x->recvranks[i],x->recvhdr+i,x->recvreqs+4*i,X);CHKERRQ(ierr);
}
x->use_status = PETSC_TRUE;
} else { /* First time */
ierr = PetscCommBuildTwoSidedFReq(comm,3,MPIU_INT,x->nsendranks,x->sendranks,(PetscInt*)x->sendhdr,&x->nrecvranks,&x->recvranks,&x->recvhdr,4,&x->sendreqs,&x->recvreqs,VecAssemblySend_MPI_Private,VecAssemblyRecv_MPI_Private,X);CHKERRQ(ierr);
x->use_status = PETSC_FALSE;
}
{
PetscInt nstash,reallocs;
ierr = VecStashGetInfo_Private(&X->stash,&nstash,&reallocs);CHKERRQ(ierr);
ierr = PetscInfo2(X,"Stash has %D entries, uses %D mallocs.\n",nstash,reallocs);CHKERRQ(ierr);
ierr = VecStashGetInfo_Private(&X->bstash,&nstash,&reallocs);CHKERRQ(ierr);
ierr = PetscInfo2(X,"Block-Stash has %D entries, uses %D mallocs.\n",nstash,reallocs);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
