/*@C
PetscSubcommSetTypeGeneral - Set type of subcommunicators from user's specifications
Collective on MPI_Comm
Input Parameter:
+ psubcomm - PetscSubcomm context
. color - control of subset assignment (nonnegative integer). Processes with the same color are in the same subcommunicator.
. subrank - rank in the subcommunicator
- duprank - rank in the dupparent (see PetscSubcomm)
Level: advanced
.keywords: communicator, create
.seealso: PetscSubcommCreate(),PetscSubcommDestroy(),PetscSubcommSetNumber(),PetscSubcommSetType()
@*/
PetscErrorCode PetscSubcommSetTypeGeneral(PetscSubcomm psubcomm,PetscMPIInt color,PetscMPIInt subrank,PetscMPIInt duprank)
{
PetscErrorCode ierr;
MPI_Comm subcomm=0,dupcomm=0,comm=psubcomm->parent;
PetscMPIInt size;
PetscFunctionBegin;
if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"PetscSubcomm is not created. Call PetscSubcommCreate()");
if (psubcomm->n < 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"number of subcommunicators %D is incorrect. Call PetscSubcommSetNumber()",psubcomm->n);
ierr = MPI_Comm_split(comm,color,subrank,&subcomm);CHKERRQ(ierr);
/* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm
if duprank is not a valid number, then dupcomm is not created - not all applications require dupcomm! */
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (duprank == PETSC_DECIDE) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"duprank==PETSC_DECIDE is not supported yet");
else if (duprank >= 0 && duprank < size){
ierr = MPI_Comm_split(comm,0,duprank,&dupcomm);CHKERRQ(ierr);
}
ierr = PetscCommDuplicate(dupcomm,&psubcomm->dupparent,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscCommDuplicate(subcomm,&psubcomm->comm,PETSC_NULL);CHKERRQ(ierr);
ierr = MPI_Comm_free(&dupcomm);CHKERRQ(ierr);
ierr = MPI_Comm_free(&subcomm);CHKERRQ(ierr);
psubcomm->color = color;
PetscFunctionReturn(0);
}
PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm psubcomm)
{
PetscErrorCode ierr;
PetscMPIInt rank,size,*subsize,duprank,subrank;
PetscMPIInt np_subcomm,nleftover,i,j,color,nsubcomm=psubcomm->n;
MPI_Comm subcomm=0,dupcomm=0,comm=psubcomm->parent;
PetscFunctionBegin;
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
/* get size of each subcommunicator */
ierr = PetscMalloc((1+nsubcomm)*sizeof(PetscMPIInt),&subsize);CHKERRQ(ierr);
np_subcomm = size/nsubcomm;
nleftover = size - nsubcomm*np_subcomm;
for (i=0; i<nsubcomm; i++) {
subsize[i] = np_subcomm;
if (i<nleftover) subsize[i]++;
}
/* find color for this proc */
color = rank%nsubcomm;
subrank = rank/nsubcomm;
ierr = MPI_Comm_split(comm,color,subrank,&subcomm);CHKERRQ(ierr);
j = 0; duprank = 0;
for (i=0; i<nsubcomm; i++) {
if (j == color) {
duprank += subrank;
break;
}
duprank += subsize[i]; j++;
}
/* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
ierr = MPI_Comm_split(comm,0,duprank,&dupcomm);CHKERRQ(ierr);
{
PetscThreadComm tcomm;
ierr = PetscCommGetThreadComm(comm,&tcomm);CHKERRQ(ierr);
ierr = MPI_Attr_put(dupcomm,Petsc_ThreadComm_keyval,tcomm);CHKERRQ(ierr);
tcomm->refct++;
ierr = MPI_Attr_put(subcomm,Petsc_ThreadComm_keyval,tcomm);CHKERRQ(ierr);
tcomm->refct++;
}
ierr = PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);CHKERRQ(ierr);
ierr = PetscCommDuplicate(subcomm,&psubcomm->comm,NULL);CHKERRQ(ierr);
ierr = MPI_Comm_free(&dupcomm);CHKERRQ(ierr);
ierr = MPI_Comm_free(&subcomm);CHKERRQ(ierr);
psubcomm->color = color;
psubcomm->subsize = subsize;
psubcomm->type = PETSC_SUBCOMM_INTERLACED;
PetscFunctionReturn(0);
}
PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm psubcomm)
{
PetscErrorCode ierr;
PetscMPIInt rank,size,*subsize,duprank=-1,subrank=-1;
PetscMPIInt np_subcomm,nleftover,i,color=-1,rankstart,nsubcomm=psubcomm->n;
MPI_Comm subcomm=0,dupcomm=0,comm=psubcomm->parent;
PetscFunctionBegin;
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
/* get size of each subcommunicator */
ierr = PetscMalloc((1+nsubcomm)*sizeof(PetscMPIInt),&subsize);CHKERRQ(ierr);
np_subcomm = size/nsubcomm;
nleftover = size - nsubcomm*np_subcomm;
for (i=0; i<nsubcomm; i++) {
subsize[i] = np_subcomm;
if (i<nleftover) subsize[i]++;
}
/* get color and subrank of this proc */
rankstart = 0;
for (i=0; i<nsubcomm; i++) {
if (rank >= rankstart && rank < rankstart+subsize[i]) {
color = i;
subrank = rank - rankstart;
duprank = rank;
break;
} else rankstart += subsize[i];
}
ierr = MPI_Comm_split(comm,color,subrank,&subcomm);CHKERRQ(ierr);
/* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
ierr = MPI_Comm_split(comm,0,duprank,&dupcomm);CHKERRQ(ierr);
{
PetscThreadComm tcomm;
ierr = PetscCommGetThreadComm(comm,&tcomm);CHKERRQ(ierr);
ierr = MPI_Attr_put(dupcomm,Petsc_ThreadComm_keyval,tcomm);CHKERRQ(ierr);
tcomm->refct++;
ierr = MPI_Attr_put(subcomm,Petsc_ThreadComm_keyval,tcomm);CHKERRQ(ierr);
tcomm->refct++;
}
ierr = PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);CHKERRQ(ierr);
ierr = PetscCommDuplicate(subcomm,&psubcomm->comm,NULL);CHKERRQ(ierr);
ierr = MPI_Comm_free(&dupcomm);CHKERRQ(ierr);
ierr = MPI_Comm_free(&subcomm);CHKERRQ(ierr);
psubcomm->color = color;
psubcomm->subsize = subsize;
psubcomm->type = PETSC_SUBCOMM_CONTIGUOUS;
PetscFunctionReturn(0);
}
/*@C
PetscSubcommSetTypeGeneral - Set a PetscSubcomm from user's specifications
Collective on MPI_Comm
Input Parameter:
+ psubcomm - PetscSubcomm context
. color - control of subset assignment (nonnegative integer). Processes with the same color are in the same subcommunicator.
- subrank - rank in the subcommunicator
Level: advanced
.keywords: communicator, create
.seealso: PetscSubcommCreate(),PetscSubcommDestroy(),PetscSubcommSetNumber(),PetscSubcommSetType()
@*/
PetscErrorCode PetscSubcommSetTypeGeneral(PetscSubcomm psubcomm,PetscMPIInt color,PetscMPIInt subrank)
{
PetscErrorCode ierr;
MPI_Comm subcomm=0,dupcomm=0,comm=psubcomm->parent;
PetscMPIInt size,icolor,duprank,*recvbuf,sendbuf[3],mysubsize,rank,*subsize;
PetscMPIInt i,nsubcomm=psubcomm->n;
PetscFunctionBegin;
if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"PetscSubcomm is not created. Call PetscSubcommCreate()");
if (nsubcomm < 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()",nsubcomm);
ierr = MPI_Comm_split(comm,color,subrank,&subcomm);CHKERRQ(ierr);
/* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */
/* TODO: this can be done in an ostensibly scalale way (i.e., without allocating an array of size 'size') as is done in PetscObjectsCreateGlobalOrdering(). */
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = PetscMalloc1(2*size,&recvbuf);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(subcomm,&mysubsize);CHKERRQ(ierr);
sendbuf[0] = color;
sendbuf[1] = mysubsize;
ierr = MPI_Allgather(sendbuf,2,MPI_INT,recvbuf,2,MPI_INT,comm);CHKERRQ(ierr);
ierr = PetscCalloc1(nsubcomm,&subsize);CHKERRQ(ierr);
for (i=0; i<2*size; i+=2) {
subsize[recvbuf[i]] = recvbuf[i+1];
}
ierr = PetscFree(recvbuf);CHKERRQ(ierr);
duprank = 0;
for (icolor=0; icolor<nsubcomm; icolor++) {
if (icolor != color) { /* not color of this process */
duprank += subsize[icolor];
} else {
duprank += subrank;
break;
}
}
ierr = MPI_Comm_split(comm,0,duprank,&dupcomm);CHKERRQ(ierr);
ierr = PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);CHKERRQ(ierr);
ierr = PetscCommDuplicate(subcomm,&psubcomm->child,NULL);CHKERRQ(ierr);
ierr = MPI_Comm_free(&dupcomm);CHKERRQ(ierr);
ierr = MPI_Comm_free(&subcomm);CHKERRQ(ierr);
psubcomm->color = color;
psubcomm->subsize = subsize;
psubcomm->type = PETSC_SUBCOMM_GENERAL;
PetscFunctionReturn(0);
}
/*@C
PETSC_VIEWER_SOCKET_ - Creates a socket viewer shared by all processors in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the socket PetscViewer
Level: intermediate
Options Database Keys:
For use with the default PETSC_VIEWER_SOCKET_WORLD or if
NULL is passed for machine or PETSC_DEFAULT is passed for port
$ -viewer_socket_machine <machine>
$ -viewer_socket_port <port>
Environmental variables:
+ PETSC_VIEWER_SOCKET_PORT portnumber
- PETSC_VIEWER_SOCKET_MACHINE machine name
Notes:
Unlike almost all other PETSc routines, PetscViewer_SOCKET_ does not return
an error code. The socket PetscViewer is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_SOCKET_(comm));
Currently the only socket client available is MATLAB. See
src/dm/examples/tests/ex12.c and ex12.m for an example of usage.
Connects to a waiting socket and stays connected until PetscViewerDestroy() is called.
Use this for communicating with an interactive MATLAB session, see PETSC_VIEWER_MATLAB_() for writing output to a
.mat file. Use PetscMatlabEngineCreate() or PETSC_MATLAB_ENGINE_(), PETSC_MATLAB_ENGINE_SELF, or PETSC_MATLAB_ENGINE_WORLD
for communicating with a MATLAB Engine
.seealso: PETSC_VIEWER_SOCKET_WORLD, PETSC_VIEWER_SOCKET_SELF, PetscViewerSocketOpen(), PetscViewerCreate(),
PetscViewerSocketSetConnection(), PetscViewerDestroy(), PETSC_VIEWER_SOCKET_(), PetscViewerBinaryWrite(), PetscViewerBinaryRead(),
PetscViewerBinaryWriteStringArray(), PetscViewerBinaryGetDescriptor(), PETSC_VIEWER_MATLAB_()
@*/
PetscViewer PETSC_VIEWER_SOCKET_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscBool flg;
PetscViewer viewer;
MPI_Comm ncomm;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&ncomm,NULL);if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (Petsc_Viewer_Socket_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,MPI_COMM_NULL_DELETE_FN,&Petsc_Viewer_Socket_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = MPI_Comm_get_attr(ncomm,Petsc_Viewer_Socket_keyval,(void**)&viewer,(int*)&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flg) { /* PetscViewer not yet created */
ierr = PetscViewerSocketOpen(ncomm,0,0,&viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = MPI_Comm_set_attr(ncomm,Petsc_Viewer_Socket_keyval,(void*)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscCommDestroy(&ncomm);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
PetscFunctionReturn(viewer);
}
/*
PetscHeaderCreate_Private - Creates a base PETSc object header and fills
in the default values. Called by the macro PetscHeaderCreate().
*/
PetscErrorCode PETSC_DLLEXPORT PetscHeaderCreate_Private(PetscObject h,PetscCookie cookie,PetscInt type,const char class_name[],MPI_Comm comm,
PetscErrorCode (*des)(PetscObject),PetscErrorCode (*vie)(PetscObject,PetscViewer))
{
static PetscInt idcnt = 1;
PetscErrorCode ierr;
PetscFunctionBegin;
h->cookie = cookie;
h->type = type;
h->class_name = (char*)class_name;
h->prefix = 0;
h->refct = 1;
h->amem = -1;
h->id = idcnt++;
h->parentid = 0;
h->qlist = 0;
h->olist = 0;
h->bops->destroy = des;
h->bops->view = vie;
h->bops->getcomm = PetscObjectGetComm_Petsc;
h->bops->compose = PetscObjectCompose_Petsc;
h->bops->query = PetscObjectQuery_Petsc;
h->bops->composefunction = PetscObjectComposeFunction_Petsc;
h->bops->queryfunction = PetscObjectQueryFunction_Petsc;
ierr = PetscCommDuplicate(comm,&h->comm,&h->tag);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
PetscHeaderCreate_Private - Creates a base PETSc object header and fills
in the default values. Called by the macro PetscHeaderCreate().
*/
PetscErrorCode PetscHeaderCreate_Private(PetscObject h,PetscClassId classid,const char class_name[],const char descr[],const char mansec[],
MPI_Comm comm,PetscObjectDestroyFunction destroy,PetscObjectViewFunction view)
{
static PetscInt idcnt = 1;
PetscErrorCode ierr;
#if defined(PETSC_USE_LOG)
PetscObject *newPetscObjects;
PetscInt newPetscObjectsMaxCounts,i;
#endif
PetscFunctionBegin;
h->classid = classid;
h->type = 0;
h->class_name = (char*)class_name;
h->description = (char*)descr;
h->mansec = (char*)mansec;
h->prefix = 0;
h->refct = 1;
#if defined(PETSC_HAVE_SAWS)
h->amsmem = PETSC_FALSE;
#endif
h->id = idcnt++;
h->parentid = 0;
h->qlist = 0;
h->olist = 0;
h->bops->destroy = destroy;
h->bops->view = view;
h->bops->getcomm = PetscObjectGetComm_Petsc;
h->bops->compose = PetscObjectCompose_Petsc;
h->bops->query = PetscObjectQuery_Petsc;
h->bops->composefunction = PetscObjectComposeFunction_Petsc;
h->bops->queryfunction = PetscObjectQueryFunction_Petsc;
ierr = PetscCommDuplicate(comm,&h->comm,&h->tag);CHKERRQ(ierr);
#if defined(PETSC_USE_LOG)
/* Keep a record of object created */
if (PetscObjectsLog) {
PetscObjectsCounts++;
for (i=0; i<PetscObjectsMaxCounts; i++) {
if (!PetscObjects[i]) {
PetscObjects[i] = h;
PetscFunctionReturn(0);
}
}
/* Need to increase the space for storing PETSc objects */
if (!PetscObjectsMaxCounts) newPetscObjectsMaxCounts = 100;
else newPetscObjectsMaxCounts = 2*PetscObjectsMaxCounts;
ierr = PetscMalloc1(newPetscObjectsMaxCounts,&newPetscObjects);CHKERRQ(ierr);
ierr = PetscMemcpy(newPetscObjects,PetscObjects,PetscObjectsMaxCounts*sizeof(PetscObject));CHKERRQ(ierr);
ierr = PetscMemzero(newPetscObjects+PetscObjectsMaxCounts,(newPetscObjectsMaxCounts - PetscObjectsMaxCounts)*sizeof(PetscObject));CHKERRQ(ierr);
ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
PetscObjects = newPetscObjects;
PetscObjects[PetscObjectsMaxCounts] = h;
PetscObjectsMaxCounts = newPetscObjectsMaxCounts;
}
#endif
PetscFunctionReturn(0);
}
static PetscErrorCode PetscCommBuildTwoSided_Ibarrier(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscMPIInt nto,const PetscMPIInt *toranks,const void *todata,PetscMPIInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
{
PetscErrorCode ierr;
PetscMPIInt nrecvs,tag,done,i;
MPI_Aint lb,unitbytes;
char *tdata;
MPI_Request *sendreqs,barrier;
PetscSegBuffer segrank,segdata;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
ierr = MPI_Type_get_extent(dtype,&lb,&unitbytes);CHKERRQ(ierr);
if (lb != 0) SETERRQ1(comm,PETSC_ERR_SUP,"Datatype with nonzero lower bound %ld\n",(long)lb);
tdata = (char*)todata;
ierr = PetscMalloc1(nto,&sendreqs);CHKERRQ(ierr);
for (i=0; i<nto; i++) {
ierr = MPI_Issend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);CHKERRQ(ierr);
}
ierr = PetscSegBufferCreate(sizeof(PetscMPIInt),4,&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferCreate(unitbytes,4*count,&segdata);CHKERRQ(ierr);
nrecvs = 0;
barrier = MPI_REQUEST_NULL;
for (done=0; !done; ) {
PetscMPIInt flag;
MPI_Status status;
ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag,comm,&flag,&status);CHKERRQ(ierr);
if (flag) { /* incoming message */
PetscMPIInt *recvrank;
void *buf;
ierr = PetscSegBufferGet(segrank,1,&recvrank);CHKERRQ(ierr);
ierr = PetscSegBufferGet(segdata,count,&buf);CHKERRQ(ierr);
*recvrank = status.MPI_SOURCE;
ierr = MPI_Recv(buf,count,dtype,status.MPI_SOURCE,tag,comm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
nrecvs++;
}
if (barrier == MPI_REQUEST_NULL) {
PetscMPIInt sent,nsends;
ierr = PetscMPIIntCast(nto,&nsends);CHKERRQ(ierr);
ierr = MPI_Testall(nsends,sendreqs,&sent,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
if (sent) {
#if defined(PETSC_HAVE_MPI_IBARRIER)
ierr = MPI_Ibarrier(comm,&barrier);CHKERRQ(ierr);
#elif defined(PETSC_HAVE_MPIX_IBARRIER)
ierr = MPIX_Ibarrier(comm,&barrier);CHKERRQ(ierr);
#endif
ierr = PetscFree(sendreqs);CHKERRQ(ierr);
}
} else {
ierr = MPI_Test(&barrier,&done,MPI_STATUS_IGNORE);CHKERRQ(ierr);
}
}
*nfrom = nrecvs;
ierr = PetscSegBufferExtractAlloc(segrank,fromranks);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferExtractAlloc(segdata,fromdata);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segdata);CHKERRQ(ierr);
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PETSC_VIEWER_BINARY_ - Creates a binary PetscViewer shared by all processors
in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the binary PetscViewer
Level: intermediate
Options Database Keys:
+ -viewer_binary_filename <name>
. -viewer_binary_skip_info
- -viewer_binary_skip_options
Environmental variables:
- PETSC_VIEWER_BINARY_FILENAME
Notes:
Unlike almost all other PETSc routines, PETSC_VIEWER_BINARY_ does not return
an error code. The binary PetscViewer is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_BINARY_(comm));
.seealso: PETSC_VIEWER_BINARY_WORLD, PETSC_VIEWER_BINARY_SELF, PetscViewerBinaryOpen(), PetscViewerCreate(),
PetscViewerDestroy()
@*/
PetscViewer PETSC_VIEWER_BINARY_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscBool flg;
PetscViewer viewer;
char fname[PETSC_MAX_PATH_LEN];
MPI_Comm ncomm;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&ncomm,NULL);if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (Petsc_Viewer_Binary_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Viewer_Binary_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = MPI_Attr_get(ncomm,Petsc_Viewer_Binary_keyval,(void**)&viewer,(int*)&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flg) { /* PetscViewer not yet created */
ierr = PetscOptionsGetenv(ncomm,"PETSC_VIEWER_BINARY_FILENAME",fname,PETSC_MAX_PATH_LEN,&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flg) {
ierr = PetscStrcpy(fname,"binaryoutput");
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscViewerBinaryOpen(ncomm,fname,FILE_MODE_WRITE,&viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = MPI_Attr_put(ncomm,Petsc_Viewer_Binary_keyval,(void*)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscCommDestroy(&ncomm);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
PetscFunctionReturn(viewer);
}
/*@C
PETSC_VIEWER_DRAW_ - Creates a window PetscViewer shared by all processors
in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the window PetscViewer
Level: intermediate
Notes:
Unlike almost all other PETSc routines, PETSC_VIEWER_DRAW_ does not return
an error code. The window is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_DRAW_(comm));
.seealso: PETSC_VIEWER_DRAW_WORLD, PETSC_VIEWER_DRAW_SELF, PetscViewerDrawOpen(),
@*/
PetscViewer PETSC_VIEWER_DRAW_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscMPIInt flag;
PetscViewer viewer;
MPI_Comm ncomm;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&ncomm,NULL);if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (Petsc_Viewer_Draw_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Viewer_Draw_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = MPI_Attr_get(ncomm,Petsc_Viewer_Draw_keyval,(void**)&viewer,&flag);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flag) { /* PetscViewer not yet created */
ierr = PetscViewerDrawOpen(ncomm,0,0,PETSC_DECIDE,PETSC_DECIDE,300,300,&viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = MPI_Attr_put(ncomm,Petsc_Viewer_Draw_keyval,(void*)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscCommDestroy(&ncomm);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
PetscFunctionReturn(viewer);
}
/*@C
ISColoringCreate - Generates an ISColoring context from lists (provided
by each processor) of colors for each node.
Collective on MPI_Comm
Input Parameters:
+ comm - communicator for the processors creating the coloring
. ncolors - max color value
. n - number of nodes on this processor
- colors - array containing the colors for this processor, color
numbers begin at 0. In C/C++ this array must have been obtained with PetscMalloc()
and should NOT be freed (The ISColoringDestroy() will free it).
Output Parameter:
. iscoloring - the resulting coloring data structure
Options Database Key:
. -is_coloring_view - Activates ISColoringView()
Level: advanced
Notes: By default sets coloring type to IS_COLORING_GLOBAL
.seealso: MatColoringCreate(), ISColoringView(), ISColoringDestroy(), ISColoringSetType()
@*/
PetscErrorCode ISColoringCreate(MPI_Comm comm,PetscInt ncolors,PetscInt n,const ISColoringValue colors[],ISColoring *iscoloring)
{
PetscErrorCode ierr;
PetscMPIInt size,rank,tag;
PetscInt base,top,i;
PetscInt nc,ncwork;
PetscBool flg = PETSC_FALSE;
MPI_Status status;
PetscFunctionBegin;
if (ncolors != PETSC_DECIDE && ncolors > IS_COLORING_MAX) {
if (ncolors > 65535) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Max color value exeeds 65535 limit. This number is unrealistic. Perhaps a bug in code?\nCurrent max: %d user rewuested: %d",IS_COLORING_MAX,ncolors);
else SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Max color value exeeds limit. Perhaps reconfigure PETSc with --with-is-color-value-type=short?\n Current max: %d user rewuested: %d",IS_COLORING_MAX,ncolors);
}
ierr = PetscNew(struct _n_ISColoring,iscoloring);CHKERRQ(ierr);
ierr = PetscCommDuplicate(comm,&(*iscoloring)->comm,&tag);CHKERRQ(ierr);
comm = (*iscoloring)->comm;
/* compute the number of the first node on my processor */
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
/* should use MPI_Scan() */
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
if (!rank) {
base = 0;
top = n;
} else {
ierr = MPI_Recv(&base,1,MPIU_INT,rank-1,tag,comm,&status);CHKERRQ(ierr);
top = base+n;
}
if (rank < size-1) {
ierr = MPI_Send(&top,1,MPIU_INT,rank+1,tag,comm);CHKERRQ(ierr);
}
/* compute the total number of colors */
ncwork = 0;
for (i=0; i<n; i++) {
if (ncwork < colors[i]) ncwork = colors[i];
}
ncwork++;
ierr = MPI_Allreduce(&ncwork,&nc,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
if (nc > ncolors) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Number of colors passed in %D is less then the actual number of colors in array %D",ncolors,nc);
(*iscoloring)->n = nc;
(*iscoloring)->is = 0;
(*iscoloring)->colors = (ISColoringValue*)colors;
(*iscoloring)->N = n;
(*iscoloring)->refct = 1;
(*iscoloring)->ctype = IS_COLORING_GLOBAL;
ierr = PetscOptionsGetBool(NULL,"-is_coloring_view",&flg,NULL);CHKERRQ(ierr);
if (flg) {
PetscViewer viewer;
ierr = PetscViewerASCIIGetStdout((*iscoloring)->comm,&viewer);CHKERRQ(ierr);
ierr = ISColoringView(*iscoloring,viewer);CHKERRQ(ierr);
}
ierr = PetscInfo1(0,"Number of colors %D\n",nc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PetscSynchronizedFlush - Flushes to the screen output from all processors
involved in previous PetscSynchronizedPrintf() calls.
Collective on MPI_Comm
Input Parameters:
. comm - the communicator
Level: intermediate
Notes:
Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
.seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
PetscViewerASCIISynchronizedPrintf()
@*/
PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscMPIInt rank,size,tag,i,j,n,dummy = 0;
char *message;
MPI_Status status;
FILE *fd;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
/* First processor waits for messages from all other processors */
if (!rank) {
if (petsc_printfqueuefile) {
fd = petsc_printfqueuefile;
} else {
fd = PETSC_STDOUT;
}
for (i=1; i<size; i++) {
/* to prevent a flood of messages to process zero, request each message separately */
ierr = MPI_Send(&dummy,1,MPI_INT,i,tag,comm);CHKERRQ(ierr);
ierr = MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
for (j=0; j<n; j++) {
PetscMPIInt size;
ierr = MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
ierr = PetscMalloc(size * sizeof(char), &message);CHKERRQ(ierr);
ierr = MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fd,"%s",message);
ierr = PetscFree(message);CHKERRQ(ierr);
}
}
petsc_printfqueuefile = PETSC_NULL;
} else { /* other processors send queue to processor 0 */
PrintfQueue next = petsc_printfqueuebase,previous;
ierr = MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);CHKERRQ(ierr);
ierr = MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
for (i=0; i<petsc_printfqueuelength; i++) {
ierr = MPI_Send(&next->size,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
ierr = MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);CHKERRQ(ierr);
previous = next;
next = next->next;
ierr = PetscFree(previous->string);CHKERRQ(ierr);
ierr = PetscFree(previous);CHKERRQ(ierr);
}
petsc_printfqueue = 0;
petsc_printfqueuelength = 0;
}
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PetscCommBuildTwoSidedFReq_Reference(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscMPIInt nto,const PetscMPIInt *toranks,const void *todata,
PetscMPIInt *nfrom,PetscMPIInt **fromranks,void *fromdata,PetscMPIInt ntags,MPI_Request **toreqs,MPI_Request **fromreqs,
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;
PetscMPIInt i,*tag;
MPI_Aint lb,unitbytes;
MPI_Request *sendreq,*recvreq;
PetscFunctionBegin;
ierr = PetscMalloc1(ntags,&tag);CHKERRQ(ierr);
if (ntags > 0) {
ierr = PetscCommDuplicate(comm,&comm,&tag[0]);CHKERRQ(ierr);
}
for (i=1; i<ntags; i++) {
ierr = PetscCommGetNewTag(comm,&tag[i]);CHKERRQ(ierr);
}
/* Perform complete initial rendezvous */
ierr = PetscCommBuildTwoSided(comm,count,dtype,nto,toranks,todata,nfrom,fromranks,fromdata);CHKERRQ(ierr);
ierr = PetscMalloc1(nto*ntags,&sendreq);CHKERRQ(ierr);
ierr = PetscMalloc1(*nfrom*ntags,&recvreq);CHKERRQ(ierr);
ierr = MPI_Type_get_extent(dtype,&lb,&unitbytes);CHKERRQ(ierr);
if (lb != 0) SETERRQ1(comm,PETSC_ERR_SUP,"Datatype with nonzero lower bound %ld\n",(long)lb);
for (i=0; i<nto; i++) {
PetscMPIInt k;
for (k=0; k<ntags; k++) sendreq[i*ntags+k] = MPI_REQUEST_NULL;
ierr = (*send)(comm,tag,i,toranks[i],((char*)todata)+count*unitbytes*i,sendreq+i*ntags,ctx);CHKERRQ(ierr);
}
for (i=0; i<*nfrom; i++) {
void *header = (*(char**)fromdata) + count*unitbytes*i;
PetscMPIInt k;
for (k=0; k<ntags; k++) recvreq[i*ntags+k] = MPI_REQUEST_NULL;
ierr = (*recv)(comm,tag,(*fromranks)[i],header,recvreq+i*ntags,ctx);CHKERRQ(ierr);
}
ierr = PetscFree(tag);CHKERRQ(ierr);
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
*toreqs = sendreq;
*fromreqs = recvreq;
PetscFunctionReturn(0);
}
/*@C
PetscViewerASCIIGetStdout - Creates a ASCII PetscViewer shared by all processors
in a communicator. Error returning version of PETSC_VIEWER_STDOUT_()
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the PetscViewer
Level: beginner
Notes:
This should be used in all PETSc source code instead of PETSC_VIEWER_STDOUT_()
.seealso: PETSC_VIEWER_DRAW_(), PetscViewerASCIIOpen(), PETSC_VIEWER_STDERR_, PETSC_VIEWER_STDOUT_WORLD,
PETSC_VIEWER_STDOUT_SELF
@*/
PetscErrorCode PetscViewerASCIIGetStdout(MPI_Comm comm,PetscViewer *viewer)
{
PetscErrorCode ierr;
PetscBool flg;
MPI_Comm ncomm;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&ncomm,NULL);CHKERRQ(ierr);
if (Petsc_Viewer_Stdout_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Viewer_Stdout_keyval,0);CHKERRQ(ierr);
}
ierr = MPI_Attr_get(ncomm,Petsc_Viewer_Stdout_keyval,(void**)viewer,(PetscMPIInt*)&flg);CHKERRQ(ierr);
if (!flg) { /* PetscViewer not yet created */
ierr = PetscViewerASCIIOpen(ncomm,"stdout",viewer);CHKERRQ(ierr);
ierr = PetscObjectRegisterDestroy((PetscObject)*viewer);CHKERRQ(ierr);
ierr = MPI_Attr_put(ncomm,Petsc_Viewer_Stdout_keyval,(void*)*viewer);CHKERRQ(ierr);
}
ierr = PetscCommDestroy(&ncomm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PetscCommBuildTwoSided_RedScatter(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscMPIInt nto,const PetscMPIInt *toranks,const void *todata,PetscMPIInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
{
PetscErrorCode ierr;
PetscMPIInt size,*iflags,nrecvs,tag,*franks,i;
MPI_Aint lb,unitbytes;
char *tdata,*fdata;
MPI_Request *reqs,*sendreqs;
MPI_Status *statuses;
PetscFunctionBegin;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr);
for (i=0; i<nto; i++) iflags[toranks[i]] = 1;
ierr = MPI_Reduce_scatter_block(iflags,&nrecvs,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
ierr = PetscFree(iflags);CHKERRQ(ierr);
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
ierr = MPI_Type_get_extent(dtype,&lb,&unitbytes);CHKERRQ(ierr);
if (lb != 0) SETERRQ1(comm,PETSC_ERR_SUP,"Datatype with nonzero lower bound %ld\n",(long)lb);
ierr = PetscMalloc(nrecvs*count*unitbytes,&fdata);CHKERRQ(ierr);
tdata = (char*)todata;
ierr = PetscMalloc2(nto+nrecvs,&reqs,nto+nrecvs,&statuses);CHKERRQ(ierr);
sendreqs = reqs + nrecvs;
for (i=0; i<nrecvs; i++) {
ierr = MPI_Irecv((void*)(fdata+count*unitbytes*i),count,dtype,MPI_ANY_SOURCE,tag,comm,reqs+i);CHKERRQ(ierr);
}
for (i=0; i<nto; i++) {
ierr = MPI_Isend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);CHKERRQ(ierr);
}
ierr = MPI_Waitall(nto+nrecvs,reqs,statuses);CHKERRQ(ierr);
ierr = PetscMalloc1(nrecvs,&franks);CHKERRQ(ierr);
for (i=0; i<nrecvs; i++) franks[i] = statuses[i].MPI_SOURCE;
ierr = PetscFree2(reqs,statuses);CHKERRQ(ierr);
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
*nfrom = nrecvs;
*fromranks = franks;
*(void**)fromdata = fdata;
PetscFunctionReturn(0);
}
PetscErrorCode OpCreateFromOptions(MPI_Comm comm,Op *op)
{
PetscErrorCode ierr,(*f)(Op);
Op o;
char opname[256] = "poisson1";
PetscFunctionBegin;
ierr = OpInitializePackage();CHKERRQ(ierr);
ierr = PetscNew(&o);CHKERRQ(ierr);
ierr = PetscCommDuplicate(comm,&o->comm,NULL);CHKERRQ(ierr);
ierr = OpSetFEDegree(o,1);CHKERRQ(ierr);
ierr = OpSetDof(o,1);CHKERRQ(ierr);
ierr = PetscOptionsBegin(comm,NULL,"Operator options",NULL);CHKERRQ(ierr);
ierr = PetscOptionsFList("-op_type","Operator type","",OpList,opname,opname,sizeof opname,NULL);CHKERRQ(ierr);
ierr = PetscFunctionListFind(OpList,opname,&f);CHKERRQ(ierr);
if (!f) SETERRQ1(comm,PETSC_ERR_USER,"Operator type '%s' not found",opname);
ierr = (*f)(o);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = TensorCreate(o->ne,o->dof,o->fedegree+1,o->fedegree+1,&o->TensorDOF);CHKERRQ(ierr);
ierr = TensorCreate(o->ne,3,o->fedegree+1,o->fedegree+1,&o->Tensor3);CHKERRQ(ierr);
*op = o;
PetscFunctionReturn(0);
}
/*@C
PetscViewerASCIIOpen - Opens an ASCII file as a PetscViewer.
Collective on MPI_Comm
Input Parameters:
+ comm - the communicator
- name - the file name
Output Parameter:
. lab - the PetscViewer to use with the specified file
Level: beginner
Notes:
This PetscViewer can be destroyed with PetscViewerDestroy().
The MPI communicator used here must match that used by the object one is viewing. For example if the
Mat was created with a PETSC_COMM_WORLD, then the Viewer must be created with PETSC_COMM_WORLD
As shown below, PetscViewerASCIIOpen() is useful in conjunction with
MatView() and VecView()
.vb
PetscViewerASCIIOpen(PETSC_COMM_WORLD,"mat.output",&viewer);
MatView(matrix,viewer);
.ve
Concepts: PetscViewerASCII^creating
Concepts: printf
Concepts: printing
Concepts: accessing remote file
Concepts: remote file
.seealso: MatView(), VecView(), PetscViewerDestroy(), PetscViewerBinaryOpen(),
PetscViewerASCIIGetPointer(), PetscViewerPushFormat(), PETSC_VIEWER_STDOUT_, PETSC_VIEWER_STDERR_,
PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF,
@*/
PetscErrorCode PetscViewerASCIIOpen(MPI_Comm comm,const char name[],PetscViewer *lab)
{
PetscErrorCode ierr;
PetscViewerLink *vlink,*nv;
PetscBool flg,eq;
size_t len;
PetscFunctionBegin;
ierr = PetscStrlen(name,&len);CHKERRQ(ierr);
if (!len) {
ierr = PetscViewerASCIIGetStdout(comm,lab);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)*lab);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = PetscSpinlockLock(&PetscViewerASCIISpinLockOpen);CHKERRQ(ierr);
if (Petsc_Viewer_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelViewer,&Petsc_Viewer_keyval,(void*)0);CHKERRQ(ierr);
}
/*
It would be better to move this code to PetscFileSetName() but since it must return a preexiting communicator
we cannot do that, since PetscFileSetName() takes a communicator that already exists.
Plus if the original communicator that created the file has since been close this will not detect the old
communictor and hence will overwrite the old data. It may be better to simply remove all this code
*/
/* make sure communicator is a PETSc communicator */
ierr = PetscCommDuplicate(comm,&comm,NULL);CHKERRQ(ierr);
/* has file already been opened into a viewer */
ierr = MPI_Attr_get(comm,Petsc_Viewer_keyval,(void**)&vlink,(PetscMPIInt*)&flg);CHKERRQ(ierr);
if (flg) {
while (vlink) {
ierr = PetscStrcmp(name,((PetscViewer_ASCII*)(vlink->viewer->data))->filename,&eq);CHKERRQ(ierr);
if (eq) {
ierr = PetscObjectReference((PetscObject)vlink->viewer);CHKERRQ(ierr);
*lab = vlink->viewer;
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
ierr = PetscSpinlockUnlock(&PetscViewerASCIISpinLockOpen);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
vlink = vlink->next;
}
}
ierr = PetscViewerCreate(comm,lab);CHKERRQ(ierr);
ierr = PetscViewerSetType(*lab,PETSCVIEWERASCII);CHKERRQ(ierr);
if (name) {
ierr = PetscViewerFileSetName(*lab,name);CHKERRQ(ierr);
}
/* save viewer into communicator if needed later */
ierr = PetscNew(&nv);CHKERRQ(ierr);
nv->viewer = *lab;
if (!flg) {
ierr = MPI_Attr_put(comm,Petsc_Viewer_keyval,nv);CHKERRQ(ierr);
} else {
ierr = MPI_Attr_get(comm,Petsc_Viewer_keyval,(void**)&vlink,(PetscMPIInt*)&flg);CHKERRQ(ierr);
if (vlink) {
while (vlink->next) vlink = vlink->next;
vlink->next = nv;
} else {
ierr = MPI_Attr_put(comm,Petsc_Viewer_keyval,nv);CHKERRQ(ierr);
}
}
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
ierr = PetscSpinlockUnlock(&PetscViewerASCIISpinLockOpen);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscViewerFlush_ASCII(PetscViewer viewer)
{
PetscErrorCode ierr;
PetscViewer_ASCII *vascii = (PetscViewer_ASCII*)viewer->data;
int err;
MPI_Comm comm;
PetscMPIInt rank,size;
FILE *fd = vascii->fd;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (!vascii->bviewer && !rank && (vascii->mode != FILE_MODE_READ)) {
err = fflush(vascii->fd);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() call failed");
}
if (vascii->allowsynchronized) {
PetscMPIInt tag,i,j,n = 0,dummy = 0;
char *message;
MPI_Status status;
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
/* First processor waits for messages from all other processors */
if (!rank) {
/* flush my own messages that I may have queued up */
PrintfQueue next = vascii->petsc_printfqueuebase,previous;
for (i=0; i<vascii->petsc_printfqueuelength; i++) {
if (!vascii->bviewer) {
ierr = PetscFPrintf(comm,fd,"%s",next->string);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIISynchronizedPrintf(vascii->bviewer,"%s",next->string);CHKERRQ(ierr);
}
previous = next;
next = next->next;
ierr = PetscFree(previous->string);CHKERRQ(ierr);
ierr = PetscFree(previous);CHKERRQ(ierr);
}
vascii->petsc_printfqueue = 0;
vascii->petsc_printfqueuelength = 0;
for (i=1; i<size; i++) {
/* to prevent a flood of messages to process zero, request each message separately */
ierr = MPI_Send(&dummy,1,MPI_INT,i,tag,comm);CHKERRQ(ierr);
ierr = MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
for (j=0; j<n; j++) {
PetscMPIInt size = 0;
ierr = MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
ierr = PetscMalloc1(size, &message);CHKERRQ(ierr);
ierr = MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);CHKERRQ(ierr);
if (!vascii->bviewer) {
ierr = PetscFPrintf(comm,fd,"%s",message);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIISynchronizedPrintf(vascii->bviewer,"%s",message);CHKERRQ(ierr);
}
ierr = PetscFree(message);CHKERRQ(ierr);
}
}
} else { /* other processors send queue to processor 0 */
PrintfQueue next = vascii->petsc_printfqueuebase,previous;
ierr = MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);CHKERRQ(ierr);
ierr = MPI_Send(&vascii->petsc_printfqueuelength,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
for (i=0; i<vascii->petsc_printfqueuelength; i++) {
ierr = MPI_Send(&next->size,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
ierr = MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);CHKERRQ(ierr);
previous = next;
next = next->next;
ierr = PetscFree(previous->string);CHKERRQ(ierr);
ierr = PetscFree(previous);CHKERRQ(ierr);
}
vascii->petsc_printfqueue = 0;
vascii->petsc_printfqueuelength = 0;
}
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
* Increase overlap for the sub-matrix across sub communicator
* sub-matrix could be a graph or numerical matrix
* */
PetscErrorCode MatIncreaseOverlapSplit_Single(Mat mat,IS *is,PetscInt ov)
{
PetscInt i,nindx,*indices_sc,*indices_ov,localsize,*localsizes_sc,localsize_tmp;
PetscInt *indices_ov_rd,nroots,nleaves,*localoffsets,*indices_recv,*sources_sc,*sources_sc_rd;
const PetscInt *indices;
PetscMPIInt srank,ssize,issamecomm,k,grank;
IS is_sc,allis_sc,partitioning;
MPI_Comm gcomm,dcomm,scomm;
PetscSF sf;
PetscSFNode *remote;
Mat *smat;
MatPartitioning part;
PetscErrorCode ierr;
PetscFunctionBegin;
/* get a sub communicator before call individual MatIncreaseOverlap
* since the sub communicator may be changed.
* */
ierr = PetscObjectGetComm((PetscObject)(*is),&dcomm);CHKERRQ(ierr);
/*make a copy before the original one is deleted*/
ierr = PetscCommDuplicate(dcomm,&scomm,NULL);CHKERRQ(ierr);
/*get a global communicator, where mat should be a global matrix */
ierr = PetscObjectGetComm((PetscObject)mat,&gcomm);CHKERRQ(ierr);
/*increase overlap on each individual subdomain*/
ierr = (*mat->ops->increaseoverlap)(mat,1,is,ov);CHKERRQ(ierr);
/*compare communicators */
ierr = MPI_Comm_compare(gcomm,scomm,&issamecomm);CHKERRQ(ierr);
/* if the sub-communicator is the same as the global communicator,
* user does not want to use a sub-communicator
* */
if(issamecomm == MPI_IDENT || issamecomm == MPI_CONGRUENT) PetscFunctionReturn(0);
/* if the sub-communicator is petsc_comm_self,
* user also does not care the sub-communicator
* */
ierr = MPI_Comm_compare(scomm,PETSC_COMM_SELF,&issamecomm);CHKERRQ(ierr);
if(issamecomm == MPI_IDENT || issamecomm == MPI_CONGRUENT){PetscFunctionReturn(0);}
/*local rank, size in a sub-communicator */
ierr = MPI_Comm_rank(scomm,&srank);CHKERRQ(ierr);
ierr = MPI_Comm_size(scomm,&ssize);CHKERRQ(ierr);
ierr = MPI_Comm_rank(gcomm,&grank);CHKERRQ(ierr);
/*create a new IS based on sub-communicator
* since the old IS is often based on petsc_comm_self
* */
ierr = ISGetLocalSize(*is,&nindx);CHKERRQ(ierr);
ierr = PetscCalloc1(nindx,&indices_sc);CHKERRQ(ierr);
ierr = ISGetIndices(*is,&indices);CHKERRQ(ierr);
ierr = PetscMemcpy(indices_sc,indices,sizeof(PetscInt)*nindx);CHKERRQ(ierr);
ierr = ISRestoreIndices(*is,&indices);CHKERRQ(ierr);
/*we do not need any more*/
ierr = ISDestroy(is);CHKERRQ(ierr);
/*create a index set based on the sub communicator */
ierr = ISCreateGeneral(scomm,nindx,indices_sc,PETSC_OWN_POINTER,&is_sc);CHKERRQ(ierr);
/*gather all indices within the sub communicator*/
ierr = ISAllGather(is_sc,&allis_sc);CHKERRQ(ierr);
ierr = ISDestroy(&is_sc);CHKERRQ(ierr);
/* gather local sizes */
ierr = PetscMalloc1(ssize,&localsizes_sc);CHKERRQ(ierr);
/*get individual local sizes for all index sets*/
ierr = MPI_Gather(&nindx,1,MPIU_INT,localsizes_sc,1,MPIU_INT,0,scomm);CHKERRQ(ierr);
/*only root does these computations */
if(!srank){
/*get local size for the big index set*/
ierr = ISGetLocalSize(allis_sc,&localsize);CHKERRQ(ierr);
ierr = PetscCalloc2(localsize,&indices_ov,localsize,&sources_sc);CHKERRQ(ierr);
ierr = PetscCalloc2(localsize,&indices_ov_rd,localsize,&sources_sc_rd);CHKERRQ(ierr);
ierr = ISGetIndices(allis_sc,&indices);CHKERRQ(ierr);
ierr = PetscMemcpy(indices_ov,indices,sizeof(PetscInt)*localsize);CHKERRQ(ierr);
ierr = ISRestoreIndices(allis_sc,&indices);CHKERRQ(ierr);
/*we do not need it any more */
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*assign corresponding sources */
localsize_tmp = 0;
for(k=0; k<ssize; k++){
for(i=0; i<localsizes_sc[k]; i++){
sources_sc[localsize_tmp++] = k;
}
}
/*record where indices come from */
ierr = PetscSortIntWithArray(localsize,indices_ov,sources_sc);CHKERRQ(ierr);
/*count local sizes for reduced indices */
ierr = PetscMemzero(localsizes_sc,sizeof(PetscInt)*ssize);CHKERRQ(ierr);
/*initialize the first entity*/
if(localsize){
indices_ov_rd[0] = indices_ov[0];
sources_sc_rd[0] = sources_sc[0];
localsizes_sc[sources_sc[0]]++;
}
localsize_tmp = 1;
/*remove duplicate integers */
for(i=1; i<localsize; i++){
if(indices_ov[i] != indices_ov[i-1]){
indices_ov_rd[localsize_tmp] = indices_ov[i];
sources_sc_rd[localsize_tmp++] = sources_sc[i];
localsizes_sc[sources_sc[i]]++;
}
}
ierr = PetscFree2(indices_ov,sources_sc);CHKERRQ(ierr);
ierr = PetscCalloc1(ssize+1,&localoffsets);CHKERRQ(ierr);
for(k=0; k<ssize; k++){
localoffsets[k+1] = localoffsets[k] + localsizes_sc[k];
}
/*construct a star forest to send data back */
nleaves = localoffsets[ssize];
ierr = PetscMemzero(localoffsets,(ssize+1)*sizeof(PetscInt));CHKERRQ(ierr);
nroots = localsizes_sc[srank];
ierr = PetscCalloc1(nleaves,&remote);CHKERRQ(ierr);
for(i=0; i<nleaves; i++){
remote[i].rank = sources_sc_rd[i];
remote[i].index = localoffsets[sources_sc_rd[i]]++;
}
ierr = PetscFree(localoffsets);CHKERRQ(ierr);
}else{
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*Allocate a 'zero' pointer */
ierr = PetscCalloc1(0,&remote);CHKERRQ(ierr);
nleaves = 0;
indices_ov_rd = 0;
sources_sc_rd = 0;
}
/*scatter sizes to everybody */
ierr = MPI_Scatter(localsizes_sc,1, MPIU_INT,&nroots,1, MPIU_INT,0,scomm);CHKERRQ(ierr);
/*free memory */
ierr = PetscFree(localsizes_sc);CHKERRQ(ierr);
ierr = PetscCalloc1(nroots,&indices_recv);CHKERRQ(ierr);
/*ierr = MPI_Comm_dup(scomm,&dcomm);CHKERRQ(ierr);*/
/*set data back to every body */
ierr = PetscSFCreate(scomm,&sf);CHKERRQ(ierr);
ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr);
ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
ierr = PetscSFSetGraph(sf,nroots,nleaves,PETSC_NULL,PETSC_OWN_POINTER,remote,PETSC_OWN_POINTER);CHKERRQ(ierr);
ierr = PetscSFReduceBegin(sf,MPIU_INT,indices_ov_rd,indices_recv,MPIU_REPLACE);CHKERRQ(ierr);
ierr = PetscSFReduceEnd(sf,MPIU_INT,indices_ov_rd,indices_recv,MPIU_REPLACE);CHKERRQ(ierr);
ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
/* free memory */
ierr = PetscFree2(indices_ov_rd,sources_sc_rd);CHKERRQ(ierr);
/*create a index set*/
ierr = ISCreateGeneral(scomm,nroots,indices_recv,PETSC_OWN_POINTER,&is_sc);CHKERRQ(ierr);
/*construct a parallel submatrix */
ierr = MatGetSubMatricesMPI(mat,1,&is_sc,&is_sc,MAT_INITIAL_MATRIX,&smat);CHKERRQ(ierr);
/* we do not need them any more */
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*create a partitioner to repartition the sub-matrix*/
ierr = MatPartitioningCreate(scomm,&part);CHKERRQ(ierr);
ierr = MatPartitioningSetAdjacency(part,smat[0]);CHKERRQ(ierr);
#if PETSC_HAVE_PARMETIS
/* if there exists a ParMETIS installation, we try to use ParMETIS
* because a repartition routine possibly work better
* */
ierr = MatPartitioningSetType(part,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
/*try to use reparition function, instead of partition function */
ierr = MatPartitioningParmetisSetRepartition(part);CHKERRQ(ierr);
#else
/*we at least provide a default partitioner to rebalance the computation */
ierr = MatPartitioningSetType(part,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
#endif
/*user can pick up any partitioner by using an option*/
ierr = MatPartitioningSetFromOptions(part);CHKERRQ(ierr);
/* apply partition */
ierr = MatPartitioningApply(part,&partitioning);CHKERRQ(ierr);
ierr = MatPartitioningDestroy(&part);CHKERRQ(ierr);
ierr = MatDestroy(&(smat[0]));CHKERRQ(ierr);
ierr = PetscFree(smat);CHKERRQ(ierr);
/* get local rows including overlap */
ierr = ISBuildTwoSided(partitioning,is_sc,is);CHKERRQ(ierr);
/* destroy */
ierr = ISDestroy(&is_sc);CHKERRQ(ierr);
ierr = ISDestroy(&partitioning);CHKERRQ(ierr);
ierr = PetscCommDestroy(&scomm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
PetscInitialize_DynamicLibraries - Adds the default dynamic link libraries to the
search path.
*/
PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void)
{
char *libname[32];
PetscErrorCode ierr;
PetscInt nmax,i;
#if defined(PETSC_USE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)
PetscBool preload;
#endif
PetscFunctionBegin;
nmax = 32;
ierr = PetscOptionsGetStringArray(NULL,NULL,"-dll_prepend",libname,&nmax,NULL);CHKERRQ(ierr);
for (i=0; i<nmax; i++) {
ierr = PetscDLLibraryPrepend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);CHKERRQ(ierr);
ierr = PetscFree(libname[i]);CHKERRQ(ierr);
}
#if !defined(PETSC_USE_DYNAMIC_LIBRARIES) || !defined(PETSC_USE_SHARED_LIBRARIES)
/*
This just initializes the most basic PETSc stuff.
The classes, from PetscDraw to PetscTS, are initialized the first
time an XXCreate() is called.
*/
ierr = PetscSysInitializePackage();CHKERRQ(ierr);
#else
preload = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-dynamic_library_preload",&preload,NULL);CHKERRQ(ierr);
if (preload) {
PetscBool found;
#if defined(PETSC_USE_SINGLE_LIBRARY)
ierr = PetscLoadDynamicLibrary("",&found);CHKERRQ(ierr);
if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
#else
ierr = PetscLoadDynamicLibrary("sys",&found);CHKERRQ(ierr);
if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
ierr = PetscLoadDynamicLibrary("vec",&found);CHKERRQ(ierr);
if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Vec dynamic library \n You cannot move the dynamic libraries!");
ierr = PetscLoadDynamicLibrary("mat",&found);CHKERRQ(ierr);
if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Mat dynamic library \n You cannot move the dynamic libraries!");
ierr = PetscLoadDynamicLibrary("dm",&found);CHKERRQ(ierr);
if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc DM dynamic library \n You cannot move the dynamic libraries!");
ierr = PetscLoadDynamicLibrary("ksp",&found);CHKERRQ(ierr);
if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc KSP dynamic library \n You cannot move the dynamic libraries!");
ierr = PetscLoadDynamicLibrary("snes",&found);CHKERRQ(ierr);
if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc SNES dynamic library \n You cannot move the dynamic libraries!");
ierr = PetscLoadDynamicLibrary("ts",&found);CHKERRQ(ierr);
if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc TS dynamic library \n You cannot move the dynamic libraries!");
#endif
}
#endif
nmax = 32;
ierr = PetscOptionsGetStringArray(NULL,NULL,"-dll_append",libname,&nmax,NULL);CHKERRQ(ierr);
for (i=0; i<nmax; i++) {
ierr = PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);CHKERRQ(ierr);
ierr = PetscFree(libname[i]);CHKERRQ(ierr);
}
#if defined(PETSC_HAVE_THREADSAFETY)
/* These must be done here because it is not safe for individual threads to call these initialize routines */
ierr = AOInitializePackage();CHKERRQ(ierr);
ierr = PetscSFInitializePackage();CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
ierr = CharacteristicInitializePackage();CHKERRQ(ierr);
#endif
ierr = ISInitializePackage();CHKERRQ(ierr);
ierr = VecInitializePackage();CHKERRQ(ierr);
ierr = MatInitializePackage();CHKERRQ(ierr);
ierr = DMInitializePackage();CHKERRQ(ierr);
ierr = PCInitializePackage();CHKERRQ(ierr);
ierr = KSPInitializePackage();CHKERRQ(ierr);
ierr = SNESInitializePackage();CHKERRQ(ierr);
ierr = TSInitializePackage();CHKERRQ(ierr);
ierr = PetscCommDuplicate(PETSC_COMM_SELF,&PETSC_COMM_SELF_INNER,NULL);CHKERRQ(ierr);
ierr = PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD_INNER,NULL);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
PetscErrorCode PetscLogPrintSummaryToPy(MPI_Comm comm, PetscViewer viewer)
{
PetscViewer_ASCII *ascii = (PetscViewer_ASCII*)viewer->data;
FILE *fd = ascii->fd;
PetscLogDouble zero = 0.0;
StageLog stageLog;
StageInfo *stageInfo = PETSC_NULL;
EventPerfInfo *eventInfo = PETSC_NULL;
ClassPerfInfo *classInfo;
const char *name;
PetscLogDouble locTotalTime, TotalTime, TotalFlops;
PetscLogDouble numMessages, messageLength, avgMessLen, numReductions;
PetscLogDouble stageTime, flops, mem, mess, messLen, red;
PetscLogDouble fracTime, fracFlops, fracMessages, fracLength;
PetscLogDouble fracReductions;
PetscLogDouble tot,avg,x,y,*mydata;
PetscMPIInt minCt, maxCt;
PetscMPIInt size, rank, *mycount;
PetscTruth *localStageUsed, *stageUsed;
PetscTruth *localStageVisible, *stageVisible;
int numStages, localNumEvents, numEvents;
int stage, lastStage;
PetscLogEvent event;
PetscErrorCode ierr;
PetscInt i;
/* remove these two lines! */
PetscLogDouble PETSC_DLLEXPORT BaseTime = 0.0;
int numObjects = 0;
PetscFunctionBegin;
ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = PetscMalloc(size*sizeof(PetscLogDouble), &mydata);CHKERRQ(ierr);
ierr = PetscMalloc(size*sizeof(PetscMPIInt), &mycount);CHKERRQ(ierr);
/* Pop off any stages the user forgot to remove */
lastStage = 0;
ierr = PetscLogGetStageLog(&stageLog);CHKERRQ(ierr);
ierr = StageLogGetCurrent(stageLog, &stage);CHKERRQ(ierr);
while (stage >= 0) {
lastStage = stage;
ierr = StageLogPop(stageLog);CHKERRQ(ierr);
ierr = StageLogGetCurrent(stageLog, &stage);CHKERRQ(ierr);
}
/* Get the total elapsed time */
PetscTime(locTotalTime); locTotalTime -= BaseTime;
ierr = PetscFPrintf(comm, fd, "\n#------ PETSc Performance Summary ----------\n\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fd, "Nproc = %d\n",size);CHKERRQ(ierr);
/* Must preserve reduction count before we go on */
red = (allreduce_ct + gather_ct + scatter_ct)/((PetscLogDouble) size);
/* Calculate summary information */
/* Time */
ierr = MPI_Gather(&locTotalTime,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "Time = [ " );CHKERRQ(ierr);
tot = 0.0;
for (i=0; i<size; i++){
tot += mydata[i];
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
avg = (tot)/((PetscLogDouble) size);
TotalTime = tot;
}
/* Objects */
avg = (PetscLogDouble) numObjects;
ierr = MPI_Gather(&avg,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "Objects = [ " );CHKERRQ(ierr);
for (i=0; i<size; i++){
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
}
/* Flops */
ierr = MPI_Gather(&_TotalFlops,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "Flops = [ " );CHKERRQ(ierr);
tot = 0.0;
for (i=0; i<size; i++){
tot += mydata[i];
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n");CHKERRQ(ierr);
TotalFlops = tot;
}
/* Memory */
ierr = PetscMallocGetMaximumUsage(&mem);CHKERRQ(ierr);
ierr = MPI_Gather(&mem,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "Memory = [ " );CHKERRQ(ierr);
for (i=0; i<size; i++){
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
}
/* Messages */
mess = 0.5*(irecv_ct + isend_ct + recv_ct + send_ct);
ierr = MPI_Gather(&mess,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "MPIMessages = [ " );CHKERRQ(ierr);
tot = 0.0;
for (i=0; i<size; i++){
tot += mydata[i];
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
numMessages = tot;
}
/* Message Lengths */
mess = 0.5*(irecv_len + isend_len + recv_len + send_len);
ierr = MPI_Gather(&mess,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "MPIMessageLengths = [ " );CHKERRQ(ierr);
tot = 0.0;
for (i=0; i<size; i++){
tot += mydata[i];
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
messageLength = tot;
}
/* Reductions */
ierr = MPI_Gather(&red,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "MPIReductions = [ " );CHKERRQ(ierr);
tot = 0.0;
for (i=0; i<size; i++){
tot += mydata[i];
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
numReductions = tot;
}
/* Get total number of stages --
Currently, a single processor can register more stages than another, but stages must all be registered in order.
We can removed this requirement if necessary by having a global stage numbering and indirection on the stage ID.
This seems best accomplished by assoicating a communicator with each stage.
*/
ierr = MPI_Allreduce(&stageLog->numStages, &numStages, 1, MPI_INT, MPI_MAX, comm);CHKERRQ(ierr);
ierr = PetscMalloc(numStages * sizeof(PetscTruth), &localStageUsed);CHKERRQ(ierr);
ierr = PetscMalloc(numStages * sizeof(PetscTruth), &stageUsed);CHKERRQ(ierr);
ierr = PetscMalloc(numStages * sizeof(PetscTruth), &localStageVisible);CHKERRQ(ierr);
ierr = PetscMalloc(numStages * sizeof(PetscTruth), &stageVisible);CHKERRQ(ierr);
if (numStages > 0) {
stageInfo = stageLog->stageInfo;
for(stage = 0; stage < numStages; stage++) {
if (stage < stageLog->numStages) {
localStageUsed[stage] = stageInfo[stage].used;
localStageVisible[stage] = stageInfo[stage].perfInfo.visible;
} else {
localStageUsed[stage] = PETSC_FALSE;
localStageVisible[stage] = PETSC_TRUE;
}
}
ierr = MPI_Allreduce(localStageUsed, stageUsed, numStages, MPI_INT, MPI_LOR, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(localStageVisible, stageVisible, numStages, MPI_INT, MPI_LAND, comm);CHKERRQ(ierr);
for(stage = 0; stage < numStages; stage++) {
if (stageUsed[stage]) {
ierr = PetscFPrintf(comm, fd, "\n#Summary of Stages: ----- Time ------ ----- Flops ----- --- Messages --- -- Message Lengths -- -- Reductions --\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fd, "# Avg %%Total Avg %%Total counts %%Total Avg %%Total counts %%Total \n");CHKERRQ(ierr);
break;
}
}
for(stage = 0; stage < numStages; stage++) {
if (!stageUsed[stage]) continue;
if (localStageUsed[stage]) {
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.time, &stageTime, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.flops, &flops, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.numMessages, &mess, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.messageLength, &messLen, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.numReductions, &red, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
name = stageInfo[stage].name;
} else {
ierr = MPI_Allreduce(&zero, &stageTime, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &flops, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &mess, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &messLen, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &red, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
name = "";
}
mess *= 0.5; messLen *= 0.5; red /= size;
if (TotalTime != 0.0) fracTime = stageTime/TotalTime; else fracTime = 0.0;
if (TotalFlops != 0.0) fracFlops = flops/TotalFlops; else fracFlops = 0.0;
/* Talk to Barry if (stageTime != 0.0) flops = (size*flops)/stageTime; else flops = 0.0; */
if (numMessages != 0.0) fracMessages = mess/numMessages; else fracMessages = 0.0;
if (numMessages != 0.0) avgMessLen = messLen/numMessages; else avgMessLen = 0.0;
if (messageLength != 0.0) fracLength = messLen/messageLength; else fracLength = 0.0;
if (numReductions != 0.0) fracReductions = red/numReductions; else fracReductions = 0.0;
ierr = PetscFPrintf(comm, fd, "# ");
ierr = PetscFPrintf(comm, fd, "%2d: %15s: %6.4e %5.1f%% %6.4e %5.1f%% %5.3e %5.1f%% %5.3e %5.1f%% %5.3e %5.1f%% \n",
stage, name, stageTime/size, 100.0*fracTime, flops, 100.0*fracFlops,
mess, 100.0*fracMessages, avgMessLen, 100.0*fracLength, red, 100.0*fracReductions);CHKERRQ(ierr);
}
}
/* Report events */
ierr = PetscFPrintf(comm, fd,"\n# Event\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fd,"# ------------------------------------------------------\n");
CHKERRQ(ierr);
/* Problem: The stage name will not show up unless the stage executed on proc 1 */
for(stage = 0; stage < numStages; stage++) {
if (!stageVisible[stage]) continue;
if (localStageUsed[stage]) {
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.time, &stageTime, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.flops, &flops, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.numMessages, &mess, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.messageLength, &messLen, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&stageInfo[stage].perfInfo.numReductions, &red, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
} else {
ierr = PetscFPrintf(comm, fd, "\n--- Event Stage %d: Unknown\n\n", stage);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &stageTime, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &flops, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &mess, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &messLen, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&zero, &red, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, comm);CHKERRQ(ierr);
}
mess *= 0.5; messLen *= 0.5; red /= size;
/* Get total number of events in this stage --
Currently, a single processor can register more events than another, but events must all be registered in order,
just like stages. We can removed this requirement if necessary by having a global event numbering and indirection
on the event ID. This seems best accomplished by assoicating a communicator with each stage.
Problem: If the event did not happen on proc 1, its name will not be available.
Problem: Event visibility is not implemented
*/
if (!rank){
ierr = PetscFPrintf(comm, fd, "class Dummy(object):\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fd, " def foo(x):\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fd, " print x\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fd, "Event = {}\n");CHKERRQ(ierr);
}
if (localStageUsed[stage]) {
eventInfo = stageLog->stageInfo[stage].eventLog->eventInfo;
localNumEvents = stageLog->stageInfo[stage].eventLog->numEvents;
} else {
localNumEvents = 0;
}
ierr = MPI_Allreduce(&localNumEvents, &numEvents, 1, MPI_INT, MPI_MAX, comm);CHKERRQ(ierr);
for(event = 0; event < numEvents; event++) {
if (localStageUsed[stage] && (event < stageLog->stageInfo[stage].eventLog->numEvents) && (eventInfo[event].depth == 0)) {
ierr = MPI_Allreduce(&eventInfo[event].count, &maxCt, 1, MPI_INT, MPI_MAX, comm);CHKERRQ(ierr);
name = stageLog->eventLog->eventInfo[event].name;
} else {
ierr = MPI_Allreduce(&ierr, &maxCt, 1, MPI_INT, MPI_MAX, comm);CHKERRQ(ierr);
name = "";
}
if (maxCt != 0) {
ierr = PetscFPrintf(comm, fd,"#\n");CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "%s = Dummy()\n",name);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fd, "Event['%s'] = %s\n",name,name);CHKERRQ(ierr);
}
/* Count */
ierr = MPI_Gather(&eventInfo[event].count,1,MPI_INT,mycount,1,MPI_INT,0,comm);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fd, "%s.Count = [ ", name);CHKERRQ(ierr);
for (i=0; i<size; i++){
ierr = PetscFPrintf(comm, fd, " %7d,",mycount[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
/* Time */
ierr = MPI_Gather(&eventInfo[event].time,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "%s.Time = [ ", name);CHKERRQ(ierr);
for (i=0; i<size; i++){
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
}
/* Flops */
ierr = MPI_Gather(&eventInfo[event].flops,1,MPIU_PETSCLOGDOUBLE,mydata,1,MPIU_PETSCLOGDOUBLE,0,comm);CHKERRQ(ierr);
if (!rank){
ierr = PetscFPrintf(comm, fd, "%s.Flops = [ ", name);CHKERRQ(ierr);
for (i=0; i<size; i++){
ierr = PetscFPrintf(comm, fd, " %5.3e,",mydata[i] );CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fd, "]\n" );CHKERRQ(ierr);
}
}
}
}
/* Right now, only stages on the first processor are reported here, meaning only objects associated with
the global communicator, or MPI_COMM_SELF for proc 1. We really should report global stats and then
stats for stages local to processor sets.
*/
for(stage = 0; stage < numStages; stage++) {
if (localStageUsed[stage]) {
classInfo = stageLog->stageInfo[stage].classLog->classInfo;
} else {
ierr = PetscFPrintf(comm, fd, "\n--- Event Stage %d: Unknown\n\n", stage);CHKERRQ(ierr);
}
}
ierr = PetscFree(localStageUsed);CHKERRQ(ierr);
ierr = PetscFree(stageUsed);CHKERRQ(ierr);
ierr = PetscFree(localStageVisible);CHKERRQ(ierr);
ierr = PetscFree(stageVisible);CHKERRQ(ierr);
ierr = PetscFree(mydata);CHKERRQ(ierr);
ierr = PetscFree(mycount);CHKERRQ(ierr);
/* Information unrelated to this particular run */
ierr = PetscFPrintf(comm, fd,
"# ========================================================================================================================\n");CHKERRQ(ierr);
PetscTime(y);
PetscTime(x);
PetscTime(y); PetscTime(y); PetscTime(y); PetscTime(y); PetscTime(y);
PetscTime(y); PetscTime(y); PetscTime(y); PetscTime(y); PetscTime(y);
ierr = PetscFPrintf(comm,fd,"AveragetimetogetPetscTime = %g\n", (y-x)/10.0);CHKERRQ(ierr);
/* MPI information */
if (size > 1) {
MPI_Status status;
PetscMPIInt tag;
MPI_Comm newcomm;
ierr = MPI_Barrier(comm);CHKERRQ(ierr);
PetscTime(x);
ierr = MPI_Barrier(comm);CHKERRQ(ierr);
ierr = MPI_Barrier(comm);CHKERRQ(ierr);
ierr = MPI_Barrier(comm);CHKERRQ(ierr);
ierr = MPI_Barrier(comm);CHKERRQ(ierr);
ierr = MPI_Barrier(comm);CHKERRQ(ierr);
PetscTime(y);
ierr = PetscFPrintf(comm, fd, "AveragetimeforMPI_Barrier = %g\n", (y-x)/5.0);CHKERRQ(ierr);
ierr = PetscCommDuplicate(comm,&newcomm, &tag);CHKERRQ(ierr);
ierr = MPI_Barrier(comm);CHKERRQ(ierr);
if (rank) {
ierr = MPI_Recv(0, 0, MPI_INT, rank-1, tag, newcomm, &status);CHKERRQ(ierr);
ierr = MPI_Send(0, 0, MPI_INT, (rank+1)%size, tag, newcomm);CHKERRQ(ierr);
} else {
PetscTime(x);
ierr = MPI_Send(0, 0, MPI_INT, 1, tag, newcomm);CHKERRQ(ierr);
ierr = MPI_Recv(0, 0, MPI_INT, size-1, tag, newcomm, &status);CHKERRQ(ierr);
PetscTime(y);
ierr = PetscFPrintf(comm,fd,"AveragetimforzerosizeMPI_Send = %g\n", (y-x)/size);CHKERRQ(ierr);
}
ierr = PetscCommDestroy(&newcomm);CHKERRQ(ierr);
}
if (!rank) { /* print Optiontable */
ierr = PetscFPrintf(comm,fd,"# ");CHKERRQ(ierr);
//ierr = PetscOptionsPrint(fd);CHKERRQ(ierr);
}
/* Cleanup */
ierr = PetscFPrintf(comm, fd, "\n");CHKERRQ(ierr);
ierr = StageLogPush(stageLog, lastStage);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PetscCommBuildTwoSidedFReq_Ibarrier(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscMPIInt nto,const PetscMPIInt *toranks,const void *todata,
PetscMPIInt *nfrom,PetscMPIInt **fromranks,void *fromdata,PetscMPIInt ntags,MPI_Request **toreqs,MPI_Request **fromreqs,
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;
PetscMPIInt nrecvs,tag,*tags,done,i;
MPI_Aint lb,unitbytes;
char *tdata;
MPI_Request *sendreqs,*usendreqs,*req,barrier;
PetscSegBuffer segrank,segdata,segreq;
PetscBool barrier_started;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
ierr = PetscMalloc1(ntags,&tags);CHKERRQ(ierr);
for (i=0; i<ntags; i++) {
ierr = PetscCommGetNewTag(comm,&tags[i]);CHKERRQ(ierr);
}
ierr = MPI_Type_get_extent(dtype,&lb,&unitbytes);CHKERRQ(ierr);
if (lb != 0) SETERRQ1(comm,PETSC_ERR_SUP,"Datatype with nonzero lower bound %ld\n",(long)lb);
tdata = (char*)todata;
ierr = PetscMalloc1(nto,&sendreqs);CHKERRQ(ierr);
ierr = PetscMalloc1(nto*ntags,&usendreqs);CHKERRQ(ierr);
/* Post synchronous sends */
for (i=0; i<nto; i++) {
ierr = MPI_Issend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);CHKERRQ(ierr);
}
/* Post actual payloads. These are typically larger messages. Hopefully sending these later does not slow down the
* synchronous messages above. */
for (i=0; i<nto; i++) {
PetscMPIInt k;
for (k=0; k<ntags; k++) usendreqs[i*ntags+k] = MPI_REQUEST_NULL;
ierr = (*send)(comm,tags,i,toranks[i],tdata+count*unitbytes*i,usendreqs+i*ntags,ctx);CHKERRQ(ierr);
}
ierr = PetscSegBufferCreate(sizeof(PetscMPIInt),4,&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferCreate(unitbytes,4*count,&segdata);CHKERRQ(ierr);
ierr = PetscSegBufferCreate(sizeof(MPI_Request),4,&segreq);CHKERRQ(ierr);
nrecvs = 0;
barrier = MPI_REQUEST_NULL;
/* MPICH-3.2 sometimes does not create a request in some "optimized" cases. This is arguably a standard violation,
* but we need to work around it. */
barrier_started = PETSC_FALSE;
for (done=0; !done; ) {
PetscMPIInt flag;
MPI_Status status;
ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag,comm,&flag,&status);CHKERRQ(ierr);
if (flag) { /* incoming message */
PetscMPIInt *recvrank,k;
void *buf;
ierr = PetscSegBufferGet(segrank,1,&recvrank);CHKERRQ(ierr);
ierr = PetscSegBufferGet(segdata,count,&buf);CHKERRQ(ierr);
*recvrank = status.MPI_SOURCE;
ierr = MPI_Recv(buf,count,dtype,status.MPI_SOURCE,tag,comm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
ierr = PetscSegBufferGet(segreq,ntags,&req);CHKERRQ(ierr);
for (k=0; k<ntags; k++) req[k] = MPI_REQUEST_NULL;
ierr = (*recv)(comm,tags,status.MPI_SOURCE,buf,req,ctx);CHKERRQ(ierr);
nrecvs++;
}
if (!barrier_started) {
PetscMPIInt sent,nsends;
ierr = PetscMPIIntCast(nto,&nsends);CHKERRQ(ierr);
ierr = MPI_Testall(nsends,sendreqs,&sent,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
if (sent) {
#if defined(PETSC_HAVE_MPI_IBARRIER)
ierr = MPI_Ibarrier(comm,&barrier);CHKERRQ(ierr);
#elif defined(PETSC_HAVE_MPIX_IBARRIER)
ierr = MPIX_Ibarrier(comm,&barrier);CHKERRQ(ierr);
#endif
barrier_started = PETSC_TRUE;
}
} else {
ierr = MPI_Test(&barrier,&done,MPI_STATUS_IGNORE);CHKERRQ(ierr);
}
}
*nfrom = nrecvs;
ierr = PetscSegBufferExtractAlloc(segrank,fromranks);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferExtractAlloc(segdata,fromdata);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segdata);CHKERRQ(ierr);
*toreqs = usendreqs;
ierr = PetscSegBufferExtractAlloc(segreq,fromreqs);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segreq);CHKERRQ(ierr);
ierr = PetscFree(sendreqs);CHKERRQ(ierr);
ierr = PetscFree(tags);CHKERRQ(ierr);
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}