xref: /petsc/src/sys/utils/mpitr.c (revision da9f1d6b25924a16baf1fafcd5e58fa8eaafd3cf)
1 #define PETSC_DLL
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 */
6 
7 #include "petsc.h"           /*I "petsc.h" I*/
8 
9 #if defined(PETSC_USE_LOG) && !defined(_petsc_mpi_uni)
10 
11 #undef __FUNCT__
12 #define __FUNCT__ "PetscMPIDump"
13 /*@C
14    PetscMPIDump - Dumps a listing of incomplete MPI operations, such as sends that
15    have never been received, etc.
16 
17    Collective on PETSC_COMM_WORLD
18 
19    Input Parameter:
20 .  fp - file pointer.  If fp is NULL, stdout is assumed.
21 
22    Options Database Key:
23 .  -mpidump - Dumps MPI incompleteness during call to PetscFinalize()
24 
25     Level: developer
26 
27 .seealso:  PetscMallocDump()
28  @*/
29 PetscErrorCode PETSC_DLLEXPORT PetscMPIDump(FILE *fd)
30 {
31   PetscErrorCode ierr;
32   PetscMPIInt    rank;
33   double         tsends,trecvs,work;
34 
35   PetscFunctionBegin;
36   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
37   if (!fd) fd = PETSC_STDOUT;
38 
39   /* Did we wait on all the non-blocking sends and receives? */
40   ierr = PetscSequentialPhaseBegin(PETSC_COMM_WORLD,1);CHKERRQ(ierr);
41   if (irecv_ct + isend_ct != sum_of_waits_ct) {
42     ierr = PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]You have not waited on all non-blocking sends and receives",rank);CHKERRQ(ierr);
43     ierr = 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);CHKERRQ(ierr);
44     fflush(fd);
45   }
46   ierr = PetscSequentialPhaseEnd(PETSC_COMM_WORLD,1);CHKERRQ(ierr);
47   /* Did we receive all the messages that we sent? */
48   work = irecv_ct + recv_ct;
49   ierr = MPI_Reduce(&work,&trecvs,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
50   work = isend_ct + send_ct;
51   ierr = MPI_Reduce(&work,&tsends,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
52   if (!rank && tsends != trecvs) {
53     ierr = PetscFPrintf(PETSC_COMM_SELF,fd,"Total number sends %g not equal receives %g\n",tsends,trecvs);CHKERRQ(ierr);
54     fflush(fd);
55   }
56   PetscFunctionReturn(0);
57 }
58 
59 #else
60 
61 #undef __FUNCT__
62 #define __FUNCT__ "PetscMPIDump"
63 PetscErrorCode PETSC_DLLEXPORT PetscMPIDump(FILE *fd)
64 {
65   PetscFunctionBegin;
66   PetscFunctionReturn(0);
67 }
68 
69 #endif
70 
71 
72 
73 
74 
75 
76 
77 
78 
79