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 <petscsys.h>

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

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

 14:   Collective on `PETSC_COMM_WORLD`

 16:   Input Parameter:
 17: . fd - file pointer.  If fp is `NULL`, `stdout` is assumed.

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

 22:   Level: developer

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

 31:   PetscFunctionBegin;
 32:   PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
 33:   if (!fd) fd = PETSC_STDOUT;

 35:   /* Did we wait on all the non-blocking sends and receives? */
 36:   PetscCall(PetscSequentialPhaseBegin(PETSC_COMM_WORLD, 1));
 37:   if (petsc_irecv_ct + petsc_isend_ct != petsc_sum_of_waits_ct) {
 38:     PetscCall(PetscFPrintf(PETSC_COMM_SELF, fd, "[%d]You have not waited on all non-blocking sends and receives", rank));
 39:     PetscCall(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));
 40:     PetscCall(PetscFFlush(fd));
 41:   }
 42:   PetscCall(PetscSequentialPhaseEnd(PETSC_COMM_WORLD, 1));
 43:   /* Did we receive all the messages that we sent? */
 44:   work = petsc_irecv_ct + petsc_recv_ct;
 45:   PetscCallMPI(MPI_Reduce(&work, &trecvs, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD));
 46:   work = petsc_isend_ct + petsc_send_ct;
 47:   PetscCallMPI(MPI_Reduce(&work, &tsends, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD));
 48:   if (rank == 0 && tsends != trecvs) {
 49:     PetscCall(PetscFPrintf(PETSC_COMM_SELF, fd, "Total number sends %g not equal receives %g\n", tsends, trecvs));
 50:     PetscCall(PetscFFlush(fd));
 51:   }
 52:   PetscFunctionReturn(PETSC_SUCCESS);
 53: }

 55: #else

 57: PetscErrorCode PetscMPIDump(FILE *fd)
 58: {
 59:   PetscFunctionBegin;
 60:   PetscFunctionReturn(PETSC_SUCCESS);
 61: }

 63: #endif