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 */
5
6 #include <petscsys.h> /*I "petscsys.h" I*/
7
8 #if defined(PETSC_USE_LOG) && !defined(PETSC_HAVE_MPIUNI)
9
10 /*@C
11 PetscMPIDump - Dumps a listing of incomplete MPI operations, such as sends that
12 have never been received, etc.
13
14 Collective on `PETSC_COMM_WORLD`
15
16 Input Parameter:
17 . fd - file pointer. If fp is `NULL`, `stdout` is assumed.
18
19 Options Database Key:
20 . -mpidump - Dumps MPI incompleteness during call to PetscFinalize()
21
22 Level: developer
23
24 .seealso: `PetscMallocDump()`
25 @*/
PetscMPIDump(FILE * fd)26 PetscErrorCode PetscMPIDump(FILE *fd)
27 {
28 PetscMPIInt rank;
29 double tsends, trecvs, work;
30
31 PetscFunctionBegin;
32 PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
33 if (!fd) fd = PETSC_STDOUT;
34
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 }
54
55 #else
56
PetscMPIDump(FILE * fd)57 PetscErrorCode PetscMPIDump(FILE *fd)
58 {
59 PetscFunctionBegin;
60 PetscFunctionReturn(PETSC_SUCCESS);
61 }
62
63 #endif
64