Date: 2013-07-02T14:39:12+00:00

Actual source code: mpitr.c
petsc-3.4.2 2013-07-02

      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>           /*I "petscsys.h" I*/

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

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

     17:    Collective on PETSC_COMM_WORLD

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

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

     25:     Level: developer

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

     37:   MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
     38:   if (!fd) fd = PETSC_STDOUT;

     40:   /* Did we wait on all the non-blocking sends and receives? */
     41:   PetscSequentialPhaseBegin(PETSC_COMM_WORLD,1);
     42:   if (petsc_irecv_ct + petsc_isend_ct != petsc_sum_of_waits_ct) {
     43:     PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]You have not waited on all non-blocking sends and receives",rank);
     44:     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);
     45:     err  = fflush(fd);
     46:     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
     47:   }
     48:   PetscSequentialPhaseEnd(PETSC_COMM_WORLD,1);
     49:   /* Did we receive all the messages that we sent? */
     50:   work = petsc_irecv_ct + petsc_recv_ct;
     51:   MPI_Reduce(&work,&trecvs,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);
     52:   work = petsc_isend_ct + petsc_send_ct;
     53:   MPI_Reduce(&work,&tsends,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);
     54:   if (!rank && tsends != trecvs) {
     55:     PetscFPrintf(PETSC_COMM_SELF,fd,"Total number sends %g not equal receives %g\n",tsends,trecvs);
     56:     err  = fflush(fd);
     57:     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
     58:   }
     59:   return(0);
     60: }

     62: #else

     66: PetscErrorCode  PetscMPIDump(FILE *fd)
     67: {
     69:   return(0);
     70: }

     72: #endif