Actual source code: mpitr.c

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

 6:  #include petsc.h

  8: #if defined(PETSC_USE_LOG) && !defined(_petsc_mpi_uni)

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

 16:    Collective on PETSC_COMM_WORLD

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

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

 24:     Level: developer

 26: .seealso:  PetscTrDump()
 27:  @*/
 28: PetscErrorCode PetscMPIDump(FILE *fd)
 29: {
 31:   PetscMPIInt    rank;
 32:   double         tsends,trecvs,work;

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

 58: #else

 62: PetscErrorCode PetscMPIDump(FILE *fd)
 63: {
 65:   return(0);
 66: }

 68: #endif