Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Defines all routines to deal with the performance of MPI routines
10 : ! **************************************************************************************************
11 : MODULE mp_perf_env
12 : ! performance gathering
13 : USE kinds, ONLY: dp
14 : #include "../base/base_uses.f90"
15 :
16 : IMPLICIT NONE
17 :
18 : PRIVATE
19 :
20 : PUBLIC :: mp_perf_env_type
21 : PUBLIC :: mp_perf_env_retain, mp_perf_env_release
22 : PUBLIC :: add_mp_perf_env, rm_mp_perf_env, get_mp_perf_env, describe_mp_perf_env
23 : PUBLIC :: add_perf
24 :
25 : TYPE mp_perf_type
26 : CHARACTER(LEN=20) :: name = ""
27 : INTEGER :: count = 0
28 : REAL(KIND=dp) :: msg_size = 0.0_dp
29 : END TYPE mp_perf_type
30 :
31 : INTEGER, PARAMETER :: MAX_PERF = 28
32 :
33 : ! **************************************************************************************************
34 : TYPE mp_perf_env_type
35 : PRIVATE
36 : INTEGER :: ref_count = -1
37 : TYPE(mp_perf_type), DIMENSION(MAX_PERF) :: mp_perfs = mp_perf_type()
38 : CONTAINS
39 : PROCEDURE, PUBLIC, PASS(perf_env), NON_OVERRIDABLE :: retain => mp_perf_env_retain
40 : END TYPE mp_perf_env_type
41 :
42 : ! **************************************************************************************************
43 : TYPE mp_perf_env_p_type
44 : TYPE(mp_perf_env_type), POINTER :: mp_perf_env => Null()
45 : END TYPE mp_perf_env_p_type
46 :
47 : ! introduce a stack of mp_perfs, first index is the stack pointer, for convenience is replacing
48 : INTEGER, PARAMETER :: max_stack_size = 10
49 : INTEGER :: stack_pointer = 0
50 : TYPE(mp_perf_env_p_type), DIMENSION(max_stack_size), SAVE :: mp_perf_stack
51 :
52 : CHARACTER(LEN=20), PARAMETER :: sname(MAX_PERF) = &
53 : ["MP_Group ", "MP_Bcast ", "MP_Allreduce ", &
54 : "MP_Gather ", "MP_Sync ", "MP_Alltoall ", &
55 : "MP_SendRecv ", "MP_ISendRecv ", "MP_Wait ", &
56 : "MP_comm_split ", "MP_ISend ", "MP_IRecv ", &
57 : "MP_Send ", "MP_Recv ", "MP_Memory ", &
58 : "MP_Put ", "MP_Get ", "MP_Fence ", &
59 : "MP_Win_Lock ", "MP_Win_Create ", "MP_Win_Free ", &
60 : "MP_IBcast ", "MP_IAllreduce ", "MP_IScatter ", &
61 : "MP_RGet ", "MP_Isync ", "MP_Read_All ", &
62 : "MP_Write_All "]
63 :
64 : CONTAINS
65 :
66 : ! **************************************************************************************************
67 : !> \brief start and stop the performance indicators
68 : !> for every call to start there has to be (exactly) one call to stop
69 : !> \param perf_env ...
70 : !> \par History
71 : !> 2.2004 created [Joost VandeVondele]
72 : !> \note
73 : !> can be used to measure performance of a sub-part of a program.
74 : !> timings measured here will not show up in the outer start/stops
75 : !> Doesn't need a fresh communicator
76 : ! **************************************************************************************************
77 129413 : SUBROUTINE add_mp_perf_env(perf_env)
78 : TYPE(mp_perf_env_type), OPTIONAL, POINTER :: perf_env
79 :
80 129413 : stack_pointer = stack_pointer + 1
81 129413 : IF (stack_pointer > max_stack_size) THEN
82 0 : CPABORT("stack_pointer too large : message_passing @ add_mp_perf_env")
83 : END IF
84 129413 : NULLIFY (mp_perf_stack(stack_pointer)%mp_perf_env)
85 129413 : IF (PRESENT(perf_env)) THEN
86 97348 : mp_perf_stack(stack_pointer)%mp_perf_env => perf_env
87 97348 : IF (ASSOCIATED(perf_env)) CALL mp_perf_env_retain(perf_env)
88 : END IF
89 129413 : IF (.NOT. ASSOCIATED(mp_perf_stack(stack_pointer)%mp_perf_env)) THEN
90 32065 : CALL mp_perf_env_create(mp_perf_stack(stack_pointer)%mp_perf_env)
91 : END IF
92 129413 : END SUBROUTINE add_mp_perf_env
93 :
94 : ! **************************************************************************************************
95 : !> \brief ...
96 : !> \param perf_env ...
97 : ! **************************************************************************************************
98 32065 : SUBROUTINE mp_perf_env_create(perf_env)
99 : TYPE(mp_perf_env_type), OPTIONAL, POINTER :: perf_env
100 :
101 : INTEGER :: i
102 :
103 : NULLIFY (perf_env)
104 929885 : ALLOCATE (perf_env)
105 32065 : perf_env%ref_count = 1
106 929885 : DO i = 1, MAX_PERF
107 929885 : perf_env%mp_perfs(i)%name = sname(i)
108 : END DO
109 :
110 32065 : END SUBROUTINE mp_perf_env_create
111 :
112 : ! **************************************************************************************************
113 : !> \brief ...
114 : !> \param perf_env ...
115 : ! **************************************************************************************************
116 139976 : SUBROUTINE mp_perf_env_release(perf_env)
117 : TYPE(mp_perf_env_type), POINTER :: perf_env
118 :
119 139976 : IF (ASSOCIATED(perf_env)) THEN
120 139976 : IF (perf_env%ref_count < 1) THEN
121 0 : CPABORT("invalid ref_count: message_passing @ mp_perf_env_release")
122 : END IF
123 139976 : perf_env%ref_count = perf_env%ref_count - 1
124 139976 : IF (perf_env%ref_count == 0) THEN
125 32065 : DEALLOCATE (perf_env)
126 : END IF
127 : END IF
128 139976 : NULLIFY (perf_env)
129 139976 : END SUBROUTINE mp_perf_env_release
130 :
131 : ! **************************************************************************************************
132 : !> \brief ...
133 : !> \param perf_env ...
134 : ! **************************************************************************************************
135 107911 : ELEMENTAL SUBROUTINE mp_perf_env_retain(perf_env)
136 : CLASS(mp_perf_env_type), INTENT(INOUT) :: perf_env
137 :
138 107911 : perf_env%ref_count = perf_env%ref_count + 1
139 107911 : END SUBROUTINE mp_perf_env_retain
140 :
141 : !.. reports the performance counters for the MPI run
142 : ! **************************************************************************************************
143 : !> \brief ...
144 : !> \param perf_env ...
145 : !> \param iw ...
146 : ! **************************************************************************************************
147 11087 : SUBROUTINE mp_perf_env_describe(perf_env, iw)
148 : TYPE(mp_perf_env_type), INTENT(IN) :: perf_env
149 : INTEGER, INTENT(IN) :: iw
150 :
151 : #if defined(__parallel)
152 : INTEGER :: i
153 : REAL(KIND=dp) :: vol
154 : #endif
155 :
156 11087 : IF (perf_env%ref_count < 1) THEN
157 0 : CPABORT("invalid perf_env%ref_count : message_passing @ mp_perf_env_describe")
158 : END IF
159 : #if defined(__parallel)
160 11087 : IF (iw > 0) THEN
161 5649 : WRITE (iw, '( /, 1X, 79("-") )')
162 5649 : WRITE (iw, '( " -", 77X, "-" )')
163 5649 : WRITE (iw, '( " -", 24X, A, 24X, "-" )') ' MESSAGE PASSING PERFORMANCE '
164 5649 : WRITE (iw, '( " -", 77X, "-" )')
165 5649 : WRITE (iw, '( 1X, 79("-"), / )')
166 5649 : WRITE (iw, '( A, A, A )') ' ROUTINE', ' CALLS ', &
167 11298 : ' AVE VOLUME [Bytes]'
168 163821 : DO i = 1, MAX_PERF
169 :
170 163821 : IF (perf_env%mp_perfs(i)%count > 0) THEN
171 40384 : vol = perf_env%mp_perfs(i)%msg_size/REAL(perf_env%mp_perfs(i)%count, KIND=dp)
172 40384 : IF (vol < 1.0_dp) THEN
173 : WRITE (iw, '(1X,A15,T17,I10)') &
174 17338 : ADJUSTL(perf_env%mp_perfs(i)%name), perf_env%mp_perfs(i)%count
175 : ELSE
176 : WRITE (iw, '(1X,A15,T17,I10,T40,F11.0)') &
177 23046 : ADJUSTL(perf_env%mp_perfs(i)%name), perf_env%mp_perfs(i)%count, &
178 46092 : vol
179 : END IF
180 : END IF
181 :
182 : END DO
183 5649 : WRITE (iw, '( 1X, 79("-"), / )')
184 : END IF
185 : #else
186 : MARK_USED(iw)
187 : #endif
188 11087 : END SUBROUTINE mp_perf_env_describe
189 :
190 : ! **************************************************************************************************
191 : !> \brief ...
192 : ! **************************************************************************************************
193 129413 : SUBROUTINE rm_mp_perf_env()
194 129413 : IF (stack_pointer < 1) THEN
195 0 : CPABORT("no perf_env in the stack : message_passing @ rm_mp_perf_env")
196 : END IF
197 129413 : CALL mp_perf_env_release(mp_perf_stack(stack_pointer)%mp_perf_env)
198 129413 : stack_pointer = stack_pointer - 1
199 129413 : END SUBROUTINE rm_mp_perf_env
200 :
201 : ! **************************************************************************************************
202 : !> \brief ...
203 : !> \return ...
204 : ! **************************************************************************************************
205 118998 : FUNCTION get_mp_perf_env() RESULT(res)
206 : TYPE(mp_perf_env_type), POINTER :: res
207 :
208 118998 : IF (stack_pointer < 1) THEN
209 0 : CPABORT("no perf_env in the stack : message_passing @ get_mp_perf_env")
210 : END IF
211 118998 : res => mp_perf_stack(stack_pointer)%mp_perf_env
212 118998 : END FUNCTION get_mp_perf_env
213 :
214 : ! **************************************************************************************************
215 : !> \brief ...
216 : !> \param scr ...
217 : ! **************************************************************************************************
218 11087 : SUBROUTINE describe_mp_perf_env(scr)
219 : INTEGER, INTENT(in) :: scr
220 :
221 : TYPE(mp_perf_env_type), POINTER :: perf_env
222 :
223 11087 : perf_env => get_mp_perf_env()
224 11087 : CALL mp_perf_env_describe(perf_env, scr)
225 11087 : END SUBROUTINE describe_mp_perf_env
226 :
227 : ! **************************************************************************************************
228 : !> \brief adds the performance informations of one call
229 : !> \param perf_id ...
230 : !> \param count ...
231 : !> \param msg_size ...
232 : !> \author fawzi
233 : ! **************************************************************************************************
234 115421524 : SUBROUTINE add_perf(perf_id, count, msg_size)
235 : INTEGER, INTENT(in) :: perf_id
236 : INTEGER, INTENT(in), OPTIONAL :: count
237 : INTEGER, INTENT(in), OPTIONAL :: msg_size
238 :
239 : #if defined(__parallel)
240 : TYPE(mp_perf_type), POINTER :: mp_perf
241 :
242 115421524 : IF (.NOT. ASSOCIATED(mp_perf_stack(stack_pointer)%mp_perf_env)) RETURN
243 :
244 115421524 : mp_perf => mp_perf_stack(stack_pointer)%mp_perf_env%mp_perfs(perf_id)
245 115421524 : IF (PRESENT(count)) THEN
246 115421524 : mp_perf%count = mp_perf%count + count
247 : END IF
248 115421524 : IF (PRESENT(msg_size)) THEN
249 102838572 : mp_perf%msg_size = mp_perf%msg_size + REAL(msg_size, dp)
250 : END IF
251 : #else
252 : MARK_USED(perf_id)
253 : MARK_USED(count)
254 : MARK_USED(msg_size)
255 : #endif
256 :
257 : END SUBROUTINE add_perf
258 :
259 0 : END MODULE mp_perf_env
|
