2: /*
  3:     Code for tracing mistakes in MPI usage. For example, sends that are never received,
  4:   nonblocking messages that are not correctly waited for, etc.
  5: */

  7: #include <petscsys.h>

  9: #if defined(PETSC_USE_LOG) && !defined(PETSC_HAVE_MPIUNI)

 11: /*@C
 12:    PetscMPIDump - Dumps a listing of incomplete MPI operations, such as sends that
 13:    have never been received, etc.

 15:    Collective on PETSC_COMM_WORLD

 17:    Input Parameter:
 18: .  fp - file pointer.  If fp is NULL, stdout is assumed.

 20:    Options Database Key:
 21: .  -mpidump - Dumps MPI incompleteness during call to PetscFinalize()

 23:     Level: developer

 25: .seealso:  PetscMallocDump()
 26:  @*/
 27: PetscErrorCode  PetscMPIDump(FILE *fd)
 28: {
 29:   PetscMPIInt    rank;
 30:   double         tsends,trecvs,work;
 31:   int            err;

 33:   MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
 34:   if (!fd) fd = PETSC_STDOUT;

 36:   /* Did we wait on all the non-blocking sends and receives? */
 37:   PetscSequentialPhaseBegin(PETSC_COMM_WORLD,1);
 38:   if (petsc_irecv_ct + petsc_isend_ct != petsc_sum_of_waits_ct) {
 39:     PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]You have not waited on all non-blocking sends and receives",rank);
 40:     PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]Number non-blocking sends %g receives %g number of waits %g\n",rank,petsc_isend_ct,petsc_irecv_ct,petsc_sum_of_waits_ct);
 41:     err  = fflush(fd);
 43:   }
 44:   PetscSequentialPhaseEnd(PETSC_COMM_WORLD,1);
 45:   /* Did we receive all the messages that we sent? */
 46:   work = petsc_irecv_ct + petsc_recv_ct;
 47:   MPI_Reduce(&work,&trecvs,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);
 48:   work = petsc_isend_ct + petsc_send_ct;
 49:   MPI_Reduce(&work,&tsends,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);
 50:   if (rank == 0 && tsends != trecvs) {
 51:     PetscFPrintf(PETSC_COMM_SELF,fd,"Total number sends %g not equal receives %g\n",tsends,trecvs);
 52:     err  = fflush(fd);
 54:   }
 55:   return 0;
 56: }

 58: #else

 60: PetscErrorCode  PetscMPIDump(FILE *fd)
 61: {
 62:   return 0;
 63: }

 65: #endif

 67: #if defined(PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY)
 68: /*
 69:     OpenMPI version of MPI_Win_allocate_shared() does not provide __float128 alignment so we provide
 70:     a utility that insures alignment up to data item size.
 71: */
 72: PetscErrorCode MPIU_Win_allocate_shared(MPI_Aint sz,PetscMPIInt szind,MPI_Info info,MPI_Comm comm,void *ptr,MPI_Win *win)
 73: {
 74:   float          *tmp;

 76:   MPI_Win_allocate_shared(16+sz,szind,info,comm,&tmp,win);
 77:   tmp += ((size_t)tmp) % szind ? szind/4 - ((((size_t)tmp) % szind)/4) : 0;
 78:   *(void**)ptr = (void*)tmp;
 79:   return 0;
 80: }

 82: PETSC_EXTERN PetscErrorCode MPIU_Win_shared_query(MPI_Win win,PetscMPIInt rank,MPI_Aint *sz,PetscMPIInt *szind,void *ptr)
 83: {
 84:   float          *tmp;

 86:   MPI_Win_shared_query(win,rank,sz,szind,&tmp);
 88:   tmp += ((size_t)tmp) % *szind ? *szind/4 - ((((size_t)tmp) % *szind)/4) : 0;
 89:   *(void**)ptr = (void*)tmp;
 90:   return 0;
 91: }

 93: #endif