Actual source code: mpitr.c
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: */
7: #include <petscsys.h>
9: #if defined(PETSC_USE_LOG) && !defined(PETSC_HAVE_MPIUNI)
11: /*@C
12: PetscMPIDump - Dumps a listing of incomplete MPI operations, such as sends that
13: have never been received, etc.
15: Collective on `PETSC_COMM_WORLD`
17: Input Parameter:
18: . fp - file pointer. If fp is NULL, stdout is assumed.
20: Options Database Key:
21: . -mpidump - Dumps MPI incompleteness during call to PetscFinalize()
23: Level: developer
25: .seealso: `PetscMallocDump()`
26: @*/
27: PetscErrorCode PetscMPIDump(FILE *fd)
28: {
29: PetscMPIInt rank;
30: double tsends, trecvs, work;
31: int err;
33: MPI_Comm_rank(PETSC_COMM_WORLD, &rank);
34: if (!fd) fd = PETSC_STDOUT;
36: /* Did we wait on all the non-blocking sends and receives? */
37: PetscSequentialPhaseBegin(PETSC_COMM_WORLD, 1);
38: if (petsc_irecv_ct + petsc_isend_ct != petsc_sum_of_waits_ct) {
39: PetscFPrintf(PETSC_COMM_SELF, fd, "[%d]You have not waited on all non-blocking sends and receives", rank);
40: 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);
41: err = fflush(fd);
43: }
44: PetscSequentialPhaseEnd(PETSC_COMM_WORLD, 1);
45: /* Did we receive all the messages that we sent? */
46: work = petsc_irecv_ct + petsc_recv_ct;
47: MPI_Reduce(&work, &trecvs, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD);
48: work = petsc_isend_ct + petsc_send_ct;
49: MPI_Reduce(&work, &tsends, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD);
50: if (rank == 0 && tsends != trecvs) {
51: PetscFPrintf(PETSC_COMM_SELF, fd, "Total number sends %g not equal receives %g\n", tsends, trecvs);
52: err = fflush(fd);
54: }
55: return 0;
56: }
58: #else
60: PetscErrorCode PetscMPIDump(FILE *fd)
61: {
62: return 0;
63: }
65: #endif
67: #if defined(PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY)
68: /*
69: OpenMPI version of MPI_Win_allocate_shared() does not provide __float128 alignment so we provide
70: a utility that insures alignment up to data item size.
71: */
72: PetscErrorCode MPIU_Win_allocate_shared(MPI_Aint sz, PetscMPIInt szind, MPI_Info info, MPI_Comm comm, void *ptr, MPI_Win *win)
73: {
74: float *tmp;
76: MPI_Win_allocate_shared(16 + sz, szind, info, comm, &tmp, win);
77: tmp += ((size_t)tmp) % szind ? szind / 4 - ((((size_t)tmp) % szind) / 4) : 0;
78: *(void **)ptr = (void *)tmp;
79: return 0;
80: }
82: PETSC_EXTERN PetscErrorCode MPIU_Win_shared_query(MPI_Win win, PetscMPIInt rank, MPI_Aint *sz, PetscMPIInt *szind, void *ptr)
83: {
84: float *tmp;
86: MPI_Win_shared_query(win, rank, sz, szind, &tmp);
88: tmp += ((size_t)tmp) % *szind ? *szind / 4 - ((((size_t)tmp) % *szind) / 4) : 0;
89: *(void **)ptr = (void *)tmp;
90: return 0;
91: }
93: #endif