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