PetscErrorCode PetscSubcommSetFromOptions(PetscSubcomm psubcomm)
{
PetscErrorCode ierr;
PetscSubcommType type;
PetscBool flg;
PetscFunctionBegin;
if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Must call PetscSubcommCreate firt");
type = psubcomm->type;
ierr = PetscOptionsEnum("-psubcomm_type","PETSc subcommunicator","PetscSubcommSetType",PetscSubcommTypes,(PetscEnum)type,(PetscEnum*)&type,&flg);CHKERRQ(ierr);
if (flg && psubcomm->type != type) {
/* free old structures */
ierr = PetscCommDestroy(&(psubcomm)->dupparent);CHKERRQ(ierr);
ierr = PetscCommDestroy(&(psubcomm)->comm);CHKERRQ(ierr);
ierr = PetscFree((psubcomm)->subsize);CHKERRQ(ierr);
switch (type) {
case PETSC_SUBCOMM_GENERAL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Runtime option PETSC_SUBCOMM_GENERAL is not supported, use PetscSubcommSetTypeGeneral()");
case PETSC_SUBCOMM_CONTIGUOUS:
ierr = PetscSubcommCreate_contiguous(psubcomm);CHKERRQ(ierr);
break;
case PETSC_SUBCOMM_INTERLACED:
ierr = PetscSubcommCreate_interlaced(psubcomm);CHKERRQ(ierr);
break;
default:
SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"PetscSubcommType %s is not supported yet",PetscSubcommTypes[type]);
}
}
ierr = PetscOptionsHasName(NULL, "-psubcomm_view", &flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscSubcommView(psubcomm,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode PetscSubcommDestroy(PetscSubcomm *psubcomm)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (!*psubcomm) PetscFunctionReturn(0);
ierr = PetscCommDestroy(&(*psubcomm)->dupparent);CHKERRQ(ierr);
ierr = PetscCommDestroy(&(*psubcomm)->comm);CHKERRQ(ierr);
ierr = PetscFree((*psubcomm));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@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
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_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);
}
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);
}
/*
PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries.
*/
PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void)
{
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
PetscFunctionBegin;
ierr = PetscOptionsGetBool(NULL,NULL,"-dll_view",&flg,NULL);CHKERRQ(ierr);
if (flg) { ierr = PetscDLLibraryPrintPath(PetscDLLibrariesLoaded);CHKERRQ(ierr); }
ierr = PetscDLLibraryClose(PetscDLLibrariesLoaded);CHKERRQ(ierr);
#if defined(PETSC_HAVE_THREADSAFETY)
ierr = PetscCommDestroy(&PETSC_COMM_SELF_INNER);CHKERRQ(ierr);
ierr = PetscCommDestroy(&PETSC_COMM_WORLD_INNER);CHKERRQ(ierr);
#endif
PetscDLLibrariesLoaded = 0;
PetscFunctionReturn(0);
}
/*@C
PetscThreadCommFinalizePackage - Finalize PetscThreadComm package, called from PetscFinalize()
Logically collective
Level: developer
.seealso: PetscThreadCommInitializePackage()
@*/
PetscErrorCode PetscThreadCommFinalizePackage(void)
{
PetscErrorCode ierr;
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscThreadCommRegisterDestroy();CHKERRQ(ierr);
comm = PETSC_COMM_WORLD; /* Release double-reference from PetscThreadCommInitialize */
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
comm = PETSC_COMM_SELF; /* Release double-reference from PetscThreadCommInitialize */
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
ierr = MPI_Keyval_free(&Petsc_ThreadComm_keyval);CHKERRQ(ierr);
PetscThreadCommPackageInitialized = PETSC_FALSE;
PetscFunctionReturn(0);
}
/*
PetscHeaderDestroy_Private - Destroys a base PETSc object header. Called by
the macro PetscHeaderDestroy().
*/
PetscErrorCode PetscHeaderDestroy_Private(PetscObject h)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeader(h,1);
ierr = PetscLogObjectDestroy(h);CHKERRQ(ierr);
ierr = PetscComposedQuantitiesDestroy(h);CHKERRQ(ierr);
if (PetscMemoryCollectMaximumUsage) {
PetscLogDouble usage;
ierr = PetscMemoryGetCurrentUsage(&usage);CHKERRQ(ierr);
if (usage > PetscMemoryMaximumUsage) PetscMemoryMaximumUsage = usage;
}
/* first destroy things that could execute arbitrary code */
if (h->python_destroy) {
void *python_context = h->python_context;
PetscErrorCode (*python_destroy)(void*) = h->python_destroy;
h->python_context = 0;
h->python_destroy = 0;
ierr = (*python_destroy)(python_context);CHKERRQ(ierr);
}
ierr = PetscObjectDestroyOptionsHandlers(h);CHKERRQ(ierr);
ierr = PetscObjectListDestroy(&h->olist);CHKERRQ(ierr);
ierr = PetscCommDestroy(&h->comm);CHKERRQ(ierr);
/* next destroy other things */
h->classid = PETSCFREEDHEADER;
ierr = PetscFunctionListDestroy(&h->qlist);CHKERRQ(ierr);
ierr = PetscFree(h->type_name);CHKERRQ(ierr);
ierr = PetscFree(h->name);CHKERRQ(ierr);
ierr = PetscFree(h->prefix);CHKERRQ(ierr);
ierr = PetscFree(h->fortran_func_pointers);CHKERRQ(ierr);
ierr = PetscFree(h->fortrancallback[PETSC_FORTRAN_CALLBACK_CLASS]);CHKERRQ(ierr);
ierr = PetscFree(h->fortrancallback[PETSC_FORTRAN_CALLBACK_SUBTYPE]);CHKERRQ(ierr);
#if defined(PETSC_USE_LOG)
if (PetscObjectsLog) {
PetscInt i;
/* Record object removal from list of all objects */
for (i=0; i<PetscObjectsMaxCounts; i++) {
if (PetscObjects[i] == h) {
PetscObjects[i] = 0;
PetscObjectsCounts--;
break;
}
}
if (!PetscObjectsCounts) {
ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
PetscObjectsMaxCounts = 0;
}
}
#endif
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);
}
PetscErrorCode OpDestroy(Op *op)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (!*op) PetscFunctionReturn(0);
if ((*op)->Destroy) {
ierr = (*op)->Destroy(*op);CHKERRQ(ierr);
}
ierr = TensorDestroy(&(*op)->TensorDOF);CHKERRQ(ierr);
ierr = TensorDestroy(&(*op)->Tensor3);CHKERRQ(ierr);
ierr = PetscCommDestroy(&(*op)->comm);CHKERRQ(ierr);
ierr = PetscFree(*op);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);
}
/*@
ISColoringDestroy - Destroys a coloring context.
Collective on ISColoring
Input Parameter:
. iscoloring - the coloring context
Level: advanced
.seealso: ISColoringView(), MatColoring
@*/
PetscErrorCode ISColoringDestroy(ISColoring *iscoloring)
{
PetscInt i;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!*iscoloring) PetscFunctionReturn(0);
PetscValidPointer((*iscoloring),1);
if (--(*iscoloring)->refct > 0) {*iscoloring = 0; PetscFunctionReturn(0);}
if ((*iscoloring)->is) {
for (i=0; i<(*iscoloring)->n; i++) {
ierr = ISDestroy(&(*iscoloring)->is[i]);CHKERRQ(ierr);
}
ierr = PetscFree((*iscoloring)->is);CHKERRQ(ierr);
}
if ((*iscoloring)->allocated) {ierr = PetscFree((*iscoloring)->colors);CHKERRQ(ierr);}
ierr = PetscCommDestroy(&(*iscoloring)->comm);CHKERRQ(ierr);
ierr = PetscFree((*iscoloring));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
PetscHeaderDestroy_Private - Destroys a base PETSc object header. Called by
the macro PetscHeaderDestroy().
*/
PetscErrorCode PETSC_DLLEXPORT PetscHeaderDestroy_Private(PetscObject h)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (PetscMemoryCollectMaximumUsage) {
PetscLogDouble usage;
ierr = PetscMemoryGetCurrentUsage(&usage);CHKERRQ(ierr);
if (usage > PetscMemoryMaximumUsage) PetscMemoryMaximumUsage = usage;
}
/* first destroy things that could execute arbitrary code */
if (h->python_destroy) {
void *python_context = h->python_context;
PetscErrorCode (*python_destroy)(void*) = h->python_destroy;
h->python_context = 0;
h->python_destroy = 0;
ierr = (*python_destroy)(python_context);CHKERRQ(ierr);
}
ierr = PetscOListDestroy(h->olist);CHKERRQ(ierr);
ierr = PetscCommDestroy(&h->comm);CHKERRQ(ierr);
/* next destroy other things */
h->cookie = PETSCFREEDHEADER;
ierr = PetscFree(h->bops);CHKERRQ(ierr);
ierr = PetscFListDestroy(&h->qlist);CHKERRQ(ierr);
ierr = PetscStrfree(h->type_name);CHKERRQ(ierr);
ierr = PetscStrfree(h->name);CHKERRQ(ierr);
ierr = PetscStrfree(h->prefix);CHKERRQ(ierr);
ierr = PetscFree(h->fortran_func_pointers);CHKERRQ(ierr);
ierr = PetscFree(h->intcomposeddata);CHKERRQ(ierr);
ierr = PetscFree(h->intcomposedstate);CHKERRQ(ierr);
ierr = PetscFree(h->realcomposeddata);CHKERRQ(ierr);
ierr = PetscFree(h->realcomposedstate);CHKERRQ(ierr);
ierr = PetscFree(h->scalarcomposeddata);CHKERRQ(ierr);
ierr = PetscFree(h->scalarcomposedstate);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);
}
/*@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);
}
/*
* 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);
}
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);
}
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);
}
