Octopus
mpi_debug.F90
Go to the documentation of this file.
1!! Copyright (C) 2005-2006 Heiko Appel, Florian Lorenzen
2!!
3!! This program is free software; you can redistribute it and/or modify
4!! it under the terms of the GNU General Public License as published by
5!! the Free Software Foundation; either version 2, or (at your option)
6!! any later version.
7!!
8!! This program is distributed in the hope that it will be useful,
9!! but WITHOUT ANY WARRANTY; without even the implied warranty of
10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11!! GNU General Public License for more details.
12!!
13!! You should have received a copy of the GNU General Public License
14!! along with this program; if not, write to the Free Software
15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16!! 02110-1301, USA.
17!!
18
19! Routines to support MPI debugging.
20
21#include "global.h"
22
23module mpi_debug_oct_m
24#ifdef HAVE_MPI
25 use mpi_f08
26#else
28#endif
29 use, intrinsic :: iso_fortran_env
30 use loct_oct_m
31
32 implicit none
33
34 private
35
36 public :: &
41
42 integer, parameter :: C_NUM_MPI_ROUTINES = 18
43
44 integer, public, parameter :: &
45 C_MPI_BARRIER = 1, &
46 c_mpi_scatterv = 2, &
47 c_mpi_gatherv = 3, &
48 c_mpi_gather = 4, &
49 c_mpi_alltoallv = 5, &
50 c_mpi_allgatherv = 6, &
51 c_mpi_bcast = 7, &
52 c_mpi_allreduce = 8, &
53 c_mpi_alltoall = 9, &
54 c_mpi_allgather = 10, &
55 c_mpi_file_read = 11, &
56 c_mpi_file_write = 12, &
57 c_mpi_send = 13, &
58 c_mpi_recv = 14, &
59 c_mpi_isend = 15, &
60 c_mpi_irecv = 16, &
61 c_mpi_wait = 17, &
62 c_mpi_waitall = 18
63
64 character(len=14), dimension(C_NUM_MPI_ROUTINES), public :: mpi_rlabel = &
65 (/ &
66 'MPI_BARRIER ', &
67 'MPI_SCATTERV ', &
68 'MPI_GATHERV ', &
69 'MPI_GATHER ', &
70 'MPI_ALLTOALLV ', &
71 'MPI_ALLGATHERV', &
72 'MPI_BCAST ', &
73 'MPI_ALLREDUCE ', &
74 'MPI_ALLTOALL ', &
75 'MPI_ALLGATHER ', &
76 'MPI_FILE_READ ', &
77 'MPI_FILE_WRITE', &
78 'MPI_SEND ', &
79 'MPI_RECV ', &
80 'MPI_ISEND ', &
81 'MPI_IRECV ', &
82 'MPI_WAIT ', &
83 'MPI_WAITALL ' &
84 /)
85
86 integer, public :: call_counter(C_NUM_MPI_ROUTINES) = 0
87 real(real64), public :: sec_accum(C_NUM_MPI_ROUTINES) = 0_real64
88
89 real(real64) :: sec_in
90
91 logical :: debug_info = .false.
92 integer :: mpi_rank = 0
93
95 integer, parameter :: unit_offset = 1000
96
97contains
98
99 ! ---------------------------------------------------------
100 subroutine mpi_debug_init(rank, info)
101 integer, intent(in) :: rank
102 logical, intent(in) :: info
103
104 mpi_rank = rank
105 debug_info = info
106 end subroutine mpi_debug_init
107
108 ! ---------------------------------------------------------
109 subroutine mpi_debug_open_trace(iunit)
110 integer, intent(out) :: iunit
111
112 character(len=6) :: filenum
113
114 if (.not. debug_info) return
115
116 iunit = mpi_rank + unit_offset
117 write(filenum, '(i6.6)') iunit - unit_offset
118 call loct_mkdir('debug')
119 open(iunit, file = 'debug/debug_trace.node.'//filenum, &
120 action='write', status='unknown', position='append')
121
122 end subroutine mpi_debug_open_trace
123
124 ! ---------------------------------------------------------
125 subroutine mpi_debug_statistics()
126#if defined(HAVE_MPI)
127 integer :: j, iunit
128 real(real64) :: usec_call(C_NUM_MPI_ROUTINES)
129#endif
130
131 if (.not. debug_info) return
132#if defined(HAVE_MPI)
133
134 call mpi_debug_open_trace(iunit)
135
136 write(iunit,*)
137 write(iunit,'(A)') '--------------------------------------------------------------------'
138 write(iunit,*)
139 write(iunit, '(23x,a,6x,a,8x,a)') 'total time', 'calls', 'usec/call'
140 do j = 1, c_num_mpi_routines
141 if (call_counter(j) <= 0) then
142 usec_call(j) = 0
143 else
144 usec_call(j) = (sec_accum(j)*1000000)/call_counter(j)
145 end if
146
147 write(iunit,'(a,f13.6,6x,i8,6x,f13.0)') &
148 mpi_rlabel(j)//' : ', sec_accum(j), &
149 call_counter(j), usec_call(j)
150 end do
151 write(iunit,*)
152 write(iunit,'(A)') '--------------------------------------------------------------------'
153
154 close(iunit)
155#endif
156
157 end subroutine mpi_debug_statistics
158
160 ! ---------------------------------------------------------
161 subroutine mpi_debug_in(comm, index)
162 type(mpi_comm), intent(in) :: comm
163 integer, intent(in) :: index
164
165 integer :: iunit
166
167 if (.not. debug_info) return
168
169 call mpi_debug_open_trace(iunit)
170
171 call_counter(index) = call_counter(index) + 1
172#if defined(HAVE_MPI)
173 sec_in = mpi_wtime()
174#endif
175 write(iunit,'(a,f18.6,a,z8.8,a,i6.6,a,f13.6)') '* MPI_I ', &
176 sec_in, ' '//mpi_rlabel(index)//' : 0x', comm%MPI_VAL, ' | ', &
177 call_counter(index), ' - ', sec_accum(index)
178
179 close(iunit)
180
181 end subroutine mpi_debug_in
183
184 ! ---------------------------------------------------------
185 subroutine mpi_debug_out(comm, index)
186 type(mpi_comm), intent(in) :: comm
187 integer, intent(in) :: index
188
189 integer :: iunit
190 real(real64) :: sec_out, sec_diff
191
192 if (.not. debug_info) return
193
194 call mpi_debug_open_trace(iunit)
196#if defined(HAVE_MPI)
197 sec_out = mpi_wtime()
198#endif
199 call mpi_time_accum(index, sec_out, sec_diff)
200 write(iunit,'(a,f18.6,a,z8.8,a,i6.6,a,f13.6,a,f13.6)') &
201 '* MPI_O ', sec_out, ' '//mpi_rlabel(index)//' : 0x', comm%MPI_VAL, ' | ', &
202 call_counter(index), ' - ', sec_accum(index), ' - ', sec_diff
203
204 close(iunit)
205
206 end subroutine mpi_debug_out
207
208
209 ! ---------------------------------------------------------
210 subroutine mpi_time_accum(index, sec, sec_diff)
211 integer, intent(in) :: index
212 real(real64), intent(in) :: sec
213 real(real64), intent(out) :: sec_diff
214
215 sec_diff = sec - sec_in
216 sec_accum(index) = sec_accum(index) + sec_diff
217
218 end subroutine mpi_time_accum
219
221
222
223!! Local Variables:
224!! mode: f90
225!! coding: utf-8
226!! End:
subroutine, public loct_mkdir(name)
Definition: loct.F90:293
subroutine mpi_time_accum(index, sec, sec_diff)
Definition: mpi_debug.F90:282
integer, parameter, public c_mpi_allgatherv
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_allreduce
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_gatherv
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_irecv
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_file_read
Definition: mpi_debug.F90:139
subroutine, public mpi_debug_init(rank, info)
Definition: mpi_debug.F90:196
integer, parameter, public c_mpi_recv
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_scatterv
Definition: mpi_debug.F90:139
subroutine, public mpi_debug_in(comm, index)
Definition: mpi_debug.F90:233
integer, parameter, public c_mpi_send
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_waitall
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_allgather
Definition: mpi_debug.F90:139
subroutine, public mpi_debug_statistics()
Definition: mpi_debug.F90:221
integer, parameter, public c_mpi_bcast
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_alltoallv
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_gather
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_wait
Definition: mpi_debug.F90:139
subroutine, public mpi_debug_out(comm, index)
Definition: mpi_debug.F90:257
integer, parameter, public c_mpi_isend
Definition: mpi_debug.F90:139
subroutine mpi_debug_open_trace(iunit)
Definition: mpi_debug.F90:205
integer, parameter, public c_mpi_alltoall
Definition: mpi_debug.F90:139
integer, parameter, public c_mpi_file_write
Definition: mpi_debug.F90:139