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