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 @*/ 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 57 PetscErrorCode PetscMPIDump(FILE *fd) 58 { 59 PetscFunctionBegin; 60 PetscFunctionReturn(PETSC_SUCCESS); 61 } 62 63 #endif 64