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: BSD-3-Clause !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Fortran API for the offload package, which is written in C.
10 : !> \author Ole Schuett
11 : ! **************************************************************************************************
12 : MODULE offload_api
13 : USE ISO_C_BINDING, ONLY: &
14 : C_ASSOCIATED, C_CHAR, C_FUNLOC, C_FUNPTR, C_F_POINTER, C_INT, C_NULL_CHAR, C_NULL_PTR, &
15 : C_PTR, C_SIZE_T
16 : USE kinds, ONLY: dp,&
17 : int_8
18 : USE message_passing, ONLY: mp_comm_type
19 : #include "../base/base_uses.f90"
20 :
21 : IMPLICIT NONE
22 :
23 : PRIVATE
24 :
25 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'offload_api'
26 :
27 : PUBLIC :: offload_init
28 : PUBLIC :: offload_get_device_count
29 : PUBLIC :: offload_set_chosen_device, offload_get_chosen_device, offload_activate_chosen_device
30 : PUBLIC :: offload_timeset, offload_timestop, offload_mem_info
31 : PUBLIC :: offload_buffer_type, offload_create_buffer, offload_free_buffer
32 : PUBLIC :: offload_malloc_pinned_mem, offload_free_pinned_mem
33 : PUBLIC :: offload_mempool_stats_print
34 :
35 : TYPE offload_buffer_type
36 : REAL(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: host_buffer => Null()
37 : TYPE(C_PTR) :: c_ptr = C_NULL_PTR
38 : END TYPE offload_buffer_type
39 :
40 : CONTAINS
41 :
42 : ! **************************************************************************************************
43 : !> \brief allocate pinned memory.
44 : !> \param buffer address of the buffer
45 : !> \param length length of the buffer
46 : !> \return 0
47 : ! **************************************************************************************************
48 0 : FUNCTION offload_malloc_pinned_mem(buffer, length) RESULT(res)
49 : TYPE(C_PTR) :: buffer
50 : INTEGER(C_SIZE_T), VALUE :: length
51 : INTEGER :: res
52 :
53 : INTERFACE
54 : FUNCTION offload_malloc_pinned_mem_c(buffer, length) &
55 : BIND(C, name="offload_host_malloc")
56 : IMPORT C_SIZE_T, C_PTR, C_INT
57 : TYPE(C_PTR) :: buffer
58 : INTEGER(C_SIZE_T), VALUE :: length
59 : INTEGER(KIND=C_INT) :: offload_malloc_pinned_mem_c
60 : END FUNCTION offload_malloc_pinned_mem_c
61 : END INTERFACE
62 :
63 0 : res = offload_malloc_pinned_mem_c(buffer, length)
64 0 : END FUNCTION offload_malloc_pinned_mem
65 :
66 : ! **************************************************************************************************
67 : !> \brief free pinned memory
68 : !> \param buffer address of the buffer
69 : !> \return 0
70 : ! **************************************************************************************************
71 0 : FUNCTION offload_free_pinned_mem(buffer) RESULT(res)
72 : TYPE(C_PTR), VALUE :: buffer
73 : INTEGER :: res
74 :
75 : INTERFACE
76 : FUNCTION offload_free_pinned_mem_c(buffer) &
77 : BIND(C, name="offload_host_free")
78 : IMPORT C_PTR, C_INT
79 : INTEGER(KIND=C_INT) :: offload_free_pinned_mem_c
80 : TYPE(C_PTR), VALUE :: buffer
81 : END FUNCTION offload_free_pinned_mem_c
82 : END INTERFACE
83 :
84 0 : res = offload_free_pinned_mem_c(buffer)
85 0 : END FUNCTION offload_free_pinned_mem
86 :
87 : ! **************************************************************************************************
88 : !> \brief Initialize runtime.
89 : !> \return ...
90 : !> \author Rocco Meli
91 : ! **************************************************************************************************
92 10486 : SUBROUTINE offload_init()
93 : INTERFACE
94 : SUBROUTINE offload_init_c() &
95 : BIND(C, name="offload_init")
96 : END SUBROUTINE offload_init_c
97 : END INTERFACE
98 :
99 10486 : CALL offload_init_c()
100 :
101 10486 : END SUBROUTINE offload_init
102 :
103 : ! **************************************************************************************************
104 : !> \brief Returns the number of available devices.
105 : !> \return ...
106 : !> \author Ole Schuett
107 : ! **************************************************************************************************
108 10490 : FUNCTION offload_get_device_count() RESULT(count)
109 : INTEGER :: count
110 :
111 : INTERFACE
112 : FUNCTION offload_get_device_count_c() &
113 : BIND(C, name="offload_get_device_count")
114 : IMPORT :: C_INT
115 : INTEGER(KIND=C_INT) :: offload_get_device_count_c
116 : END FUNCTION offload_get_device_count_c
117 : END INTERFACE
118 :
119 10490 : count = offload_get_device_count_c()
120 :
121 10490 : END FUNCTION offload_get_device_count
122 :
123 : ! **************************************************************************************************
124 : !> \brief Selects the chosen device to be used.
125 : !> \param device_id ...
126 : !> \author Ole Schuett
127 : ! **************************************************************************************************
128 0 : SUBROUTINE offload_set_chosen_device(device_id)
129 : INTEGER, INTENT(IN) :: device_id
130 :
131 : INTERFACE
132 : SUBROUTINE offload_set_chosen_device_c(device_id) &
133 : BIND(C, name="offload_set_chosen_device")
134 : IMPORT :: C_INT
135 : INTEGER(KIND=C_INT), VALUE :: device_id
136 : END SUBROUTINE offload_set_chosen_device_c
137 : END INTERFACE
138 :
139 0 : CALL offload_set_chosen_device_c(device_id=device_id)
140 :
141 0 : END SUBROUTINE offload_set_chosen_device
142 :
143 : ! **************************************************************************************************
144 : !> \brief Returns the chosen device.
145 : !> \return ...
146 : !> \author Ole Schuett
147 : ! **************************************************************************************************
148 0 : FUNCTION offload_get_chosen_device() RESULT(device_id)
149 : INTEGER :: device_id
150 :
151 : INTERFACE
152 : FUNCTION offload_get_chosen_device_c() &
153 : BIND(C, name="offload_get_chosen_device")
154 : IMPORT :: C_INT
155 : INTEGER(KIND=C_INT) :: offload_get_chosen_device_c
156 : END FUNCTION offload_get_chosen_device_c
157 : END INTERFACE
158 :
159 0 : device_id = offload_get_chosen_device_c()
160 :
161 0 : IF (device_id < 0) THEN
162 0 : CPABORT("No offload device has been chosen.")
163 : END IF
164 :
165 0 : END FUNCTION offload_get_chosen_device
166 :
167 : ! **************************************************************************************************
168 : !> \brief Activates the device selected via offload_set_chosen_device()
169 : !> \author Ole Schuett
170 : ! **************************************************************************************************
171 2278401 : SUBROUTINE offload_activate_chosen_device()
172 :
173 : INTERFACE
174 : SUBROUTINE offload_activate_chosen_device_c() &
175 : BIND(C, name="offload_activate_chosen_device")
176 : END SUBROUTINE offload_activate_chosen_device_c
177 : END INTERFACE
178 :
179 2278401 : CALL offload_activate_chosen_device_c()
180 :
181 2278401 : END SUBROUTINE offload_activate_chosen_device
182 :
183 : ! **************************************************************************************************
184 : !> \brief Starts a timing range.
185 : !> \param routineN ...
186 : !> \author Ole Schuett
187 : ! **************************************************************************************************
188 2015688125 : SUBROUTINE offload_timeset(routineN)
189 : CHARACTER(LEN=*), INTENT(IN) :: routineN
190 :
191 : INTERFACE
192 : SUBROUTINE offload_timeset_c(message) BIND(C, name="offload_timeset")
193 : IMPORT :: C_CHAR
194 : CHARACTER(kind=C_CHAR), DIMENSION(*), INTENT(IN) :: message
195 : END SUBROUTINE offload_timeset_c
196 : END INTERFACE
197 :
198 2015688125 : CALL offload_timeset_c(TRIM(routineN)//C_NULL_CHAR)
199 :
200 2015688125 : END SUBROUTINE offload_timeset
201 :
202 : ! **************************************************************************************************
203 : !> \brief Ends a timing range.
204 : !> \author Ole Schuett
205 : ! **************************************************************************************************
206 2015688125 : SUBROUTINE offload_timestop()
207 :
208 : INTERFACE
209 : SUBROUTINE offload_timestop_c() BIND(C, name="offload_timestop")
210 : END SUBROUTINE offload_timestop_c
211 : END INTERFACE
212 :
213 2015688125 : CALL offload_timestop_c()
214 :
215 2015688125 : END SUBROUTINE offload_timestop
216 :
217 : ! **************************************************************************************************
218 : !> \brief Gets free and total device memory.
219 : !> \param free ...
220 : !> \param total ...
221 : !> \author Ole Schuett
222 : ! **************************************************************************************************
223 0 : SUBROUTINE offload_mem_info(free, total)
224 : INTEGER(KIND=int_8), INTENT(OUT) :: free, total
225 :
226 : INTEGER(KIND=C_SIZE_T) :: my_free, my_total
227 : INTERFACE
228 : SUBROUTINE offload_mem_info_c(free, total) BIND(C, name="offload_mem_info")
229 : IMPORT :: C_SIZE_T
230 : INTEGER(KIND=C_SIZE_T) :: free, total
231 : END SUBROUTINE offload_mem_info_c
232 : END INTERFACE
233 :
234 0 : CALL offload_mem_info_c(my_free, my_total)
235 :
236 : ! On 32-bit architectures this converts from int_4 to int_8.
237 0 : free = my_free
238 0 : total = my_total
239 :
240 0 : END SUBROUTINE offload_mem_info
241 :
242 : ! **************************************************************************************************
243 : !> \brief Allocates a buffer of given length, ie. number of elements.
244 : !> \param length ...
245 : !> \param buffer ...
246 : !> \author Ole Schuett
247 : ! **************************************************************************************************
248 313642 : SUBROUTINE offload_create_buffer(length, buffer)
249 : INTEGER, INTENT(IN) :: length
250 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
251 :
252 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_create_buffer'
253 :
254 : INTEGER :: handle
255 : TYPE(C_PTR) :: host_buffer_c
256 : INTERFACE
257 : SUBROUTINE offload_create_buffer_c(length, buffer) &
258 : BIND(C, name="offload_create_buffer")
259 : IMPORT :: C_PTR, C_INT
260 : INTEGER(KIND=C_INT), VALUE :: length
261 : TYPE(C_PTR) :: buffer
262 : END SUBROUTINE offload_create_buffer_c
263 : END INTERFACE
264 : INTERFACE
265 : FUNCTION offload_get_buffer_host_pointer_c(buffer) &
266 : BIND(C, name="offload_get_buffer_host_pointer")
267 : IMPORT :: C_PTR
268 : TYPE(C_PTR), VALUE :: buffer
269 : TYPE(C_PTR) :: offload_get_buffer_host_pointer_c
270 : END FUNCTION offload_get_buffer_host_pointer_c
271 : END INTERFACE
272 :
273 313642 : CALL timeset(routineN, handle)
274 :
275 313642 : IF (ASSOCIATED(buffer%host_buffer)) THEN
276 12944 : IF (SIZE(buffer%host_buffer) == 0) DEALLOCATE (buffer%host_buffer)
277 12944 : IF (ASSOCIATED(buffer%host_buffer)) NULLIFY (buffer%host_buffer)
278 : END IF
279 :
280 313642 : CALL offload_create_buffer_c(length=length, buffer=buffer%c_ptr)
281 313642 : CPASSERT(C_ASSOCIATED(buffer%c_ptr))
282 :
283 313642 : IF (length == 0) THEN
284 : ! While C_F_POINTER usually accepts a NULL pointer it's not standard compliant.
285 490 : ALLOCATE (buffer%host_buffer(0))
286 : ELSE
287 313152 : host_buffer_c = offload_get_buffer_host_pointer_c(buffer%c_ptr)
288 313152 : CPASSERT(C_ASSOCIATED(host_buffer_c))
289 626304 : CALL C_F_POINTER(host_buffer_c, buffer%host_buffer, shape=[length])
290 : END IF
291 :
292 313642 : CALL timestop(handle)
293 313642 : END SUBROUTINE offload_create_buffer
294 :
295 : ! **************************************************************************************************
296 : !> \brief Deallocates given buffer.
297 : !> \param buffer ...
298 : !> \author Ole Schuett
299 : ! **************************************************************************************************
300 302450 : SUBROUTINE offload_free_buffer(buffer)
301 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
302 :
303 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_free_buffer'
304 :
305 : INTEGER :: handle
306 : INTERFACE
307 : SUBROUTINE offload_free_buffer_c(buffer) &
308 : BIND(C, name="offload_free_buffer")
309 : IMPORT :: C_PTR
310 : TYPE(C_PTR), VALUE :: buffer
311 : END SUBROUTINE offload_free_buffer_c
312 : END INTERFACE
313 :
314 302450 : CALL timeset(routineN, handle)
315 :
316 302450 : IF (C_ASSOCIATED(buffer%c_ptr)) THEN
317 :
318 300698 : CALL offload_free_buffer_c(buffer%c_ptr)
319 :
320 300698 : buffer%c_ptr = C_NULL_PTR
321 :
322 300698 : IF (SIZE(buffer%host_buffer) == 0) THEN
323 402 : DEALLOCATE (buffer%host_buffer)
324 : ELSE
325 300296 : NULLIFY (buffer%host_buffer)
326 : END IF
327 : END IF
328 :
329 302450 : CALL timestop(handle)
330 302450 : END SUBROUTINE offload_free_buffer
331 :
332 : ! **************************************************************************************************
333 : !> \brief Print allocation statistics.
334 : !> \param mpi_comm ...
335 : !> \param output_unit ...
336 : !> \author Ole Schuett
337 : ! **************************************************************************************************
338 10604 : SUBROUTINE offload_mempool_stats_print(mpi_comm, output_unit)
339 : TYPE(mp_comm_type), INTENT(IN) :: mpi_comm
340 : INTEGER, INTENT(IN) :: output_unit
341 :
342 : INTERFACE
343 : SUBROUTINE offload_mempool_stats_print_c(mpi_comm, print_func, output_unit) &
344 : BIND(C, name="offload_mempool_stats_print")
345 : IMPORT :: C_FUNPTR, C_INT
346 : INTEGER(KIND=C_INT), VALUE :: mpi_comm
347 : TYPE(C_FUNPTR), VALUE :: print_func
348 : INTEGER(KIND=C_INT), VALUE :: output_unit
349 : END SUBROUTINE offload_mempool_stats_print_c
350 : END INTERFACE
351 :
352 : ! Since Fortran units groups can't be used from C, we pass a function pointer instead.
353 : CALL offload_mempool_stats_print_c(mpi_comm=mpi_comm%get_handle(), &
354 : print_func=C_FUNLOC(print_func), &
355 10604 : output_unit=output_unit)
356 :
357 10604 : END SUBROUTINE offload_mempool_stats_print
358 :
359 : ! **************************************************************************************************
360 : !> \brief Callback to write to a Fortran output unit (called by C-side).
361 : !> \param msg to be printed.
362 : !> \param msglen number of characters excluding the terminating character.
363 : !> \param output_unit used for output.
364 : !> \author Hans Pabst
365 : ! **************************************************************************************************
366 83016 : SUBROUTINE print_func(msg, msglen, output_unit) BIND(C, name="offload_api_print_func")
367 : CHARACTER(KIND=C_CHAR), INTENT(IN) :: msg(*)
368 : INTEGER(KIND=C_INT), INTENT(IN), VALUE :: msglen, output_unit
369 :
370 83016 : IF (output_unit <= 0) RETURN ! Omit to print the message.
371 41760 : WRITE (output_unit, FMT="(100A)", ADVANCE="NO") msg(1:msglen)
372 : END SUBROUTINE print_func
373 0 : END MODULE offload_api
|
