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 : offload_buffer_h2d, offload_buffer_d2h, &
33 : offload_get_buffer_device_pointer, offload_device_synchronize
34 : PUBLIC :: offload_malloc_pinned_mem, offload_free_pinned_mem
35 : PUBLIC :: offload_mempool_stats_print
36 : PUBLIC :: offload_get_buffer_host_pointer
37 :
38 : TYPE offload_buffer_type
39 : REAL(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: host_buffer => Null()
40 : TYPE(C_PTR) :: c_ptr = C_NULL_PTR
41 : END TYPE offload_buffer_type
42 :
43 : CONTAINS
44 :
45 : ! **************************************************************************************************
46 : !> \brief allocate pinned memory.
47 : !> \param buffer address of the buffer
48 : !> \param length length of the buffer
49 : !> \return 0
50 : ! **************************************************************************************************
51 0 : FUNCTION offload_malloc_pinned_mem(buffer, length) RESULT(res)
52 : TYPE(C_PTR) :: buffer
53 : INTEGER(C_SIZE_T), VALUE :: length
54 : INTEGER :: res
55 :
56 : INTERFACE
57 : FUNCTION offload_malloc_pinned_mem_c(buffer, length) &
58 : BIND(C, name="offload_host_malloc")
59 : IMPORT C_SIZE_T, C_PTR, C_INT
60 : TYPE(C_PTR) :: buffer
61 : INTEGER(C_SIZE_T), VALUE :: length
62 : INTEGER(KIND=C_INT) :: offload_malloc_pinned_mem_c
63 : END FUNCTION offload_malloc_pinned_mem_c
64 : END INTERFACE
65 :
66 0 : res = offload_malloc_pinned_mem_c(buffer, length)
67 0 : END FUNCTION offload_malloc_pinned_mem
68 :
69 : ! **************************************************************************************************
70 : !> \brief free pinned memory
71 : !> \param buffer address of the buffer
72 : !> \return 0
73 : ! **************************************************************************************************
74 0 : FUNCTION offload_free_pinned_mem(buffer) RESULT(res)
75 : TYPE(C_PTR), VALUE :: buffer
76 : INTEGER :: res
77 :
78 : INTERFACE
79 : FUNCTION offload_free_pinned_mem_c(buffer) &
80 : BIND(C, name="offload_host_free")
81 : IMPORT C_PTR, C_INT
82 : INTEGER(KIND=C_INT) :: offload_free_pinned_mem_c
83 : TYPE(C_PTR), VALUE :: buffer
84 : END FUNCTION offload_free_pinned_mem_c
85 : END INTERFACE
86 :
87 0 : res = offload_free_pinned_mem_c(buffer)
88 0 : END FUNCTION offload_free_pinned_mem
89 :
90 : ! **************************************************************************************************
91 : !> \brief Initialize runtime.
92 : !> \return ...
93 : !> \author Rocco Meli
94 : ! **************************************************************************************************
95 1465 : SUBROUTINE offload_init()
96 : INTERFACE
97 : SUBROUTINE offload_init_c() &
98 : BIND(C, name="offload_init")
99 : END SUBROUTINE offload_init_c
100 : END INTERFACE
101 :
102 1465 : CALL offload_init_c()
103 :
104 1465 : END SUBROUTINE offload_init
105 :
106 : ! **************************************************************************************************
107 : !> \brief Returns the number of available devices.
108 : !> \return ...
109 : !> \author Ole Schuett
110 : ! **************************************************************************************************
111 25281 : FUNCTION offload_get_device_count() RESULT(count)
112 : INTEGER :: count
113 :
114 : INTERFACE
115 : FUNCTION offload_get_device_count_c() &
116 : BIND(C, name="offload_get_device_count")
117 : IMPORT :: C_INT
118 : INTEGER(KIND=C_INT) :: offload_get_device_count_c
119 : END FUNCTION offload_get_device_count_c
120 : END INTERFACE
121 :
122 25281 : count = offload_get_device_count_c()
123 :
124 25281 : END FUNCTION offload_get_device_count
125 :
126 : ! **************************************************************************************************
127 : !> \brief Selects the chosen device to be used.
128 : !> \param device_id ...
129 : !> \author Ole Schuett
130 : ! **************************************************************************************************
131 0 : SUBROUTINE offload_set_chosen_device(device_id)
132 : INTEGER, INTENT(IN) :: device_id
133 :
134 : INTERFACE
135 : SUBROUTINE offload_set_chosen_device_c(device_id) &
136 : BIND(C, name="offload_set_chosen_device")
137 : IMPORT :: C_INT
138 : INTEGER(KIND=C_INT), VALUE :: device_id
139 : END SUBROUTINE offload_set_chosen_device_c
140 : END INTERFACE
141 :
142 0 : CALL offload_set_chosen_device_c(device_id=device_id)
143 :
144 0 : END SUBROUTINE offload_set_chosen_device
145 :
146 : ! **************************************************************************************************
147 : !> \brief Returns the chosen device.
148 : !> \return ...
149 : !> \author Ole Schuett
150 : ! **************************************************************************************************
151 0 : FUNCTION offload_get_chosen_device() RESULT(device_id)
152 : INTEGER :: device_id
153 :
154 : INTERFACE
155 : FUNCTION offload_get_chosen_device_c() &
156 : BIND(C, name="offload_get_chosen_device")
157 : IMPORT :: C_INT
158 : INTEGER(KIND=C_INT) :: offload_get_chosen_device_c
159 : END FUNCTION offload_get_chosen_device_c
160 : END INTERFACE
161 :
162 0 : device_id = offload_get_chosen_device_c()
163 :
164 0 : IF (device_id < 0) THEN
165 0 : CPABORT("No offload device has been chosen.")
166 : END IF
167 :
168 0 : END FUNCTION offload_get_chosen_device
169 :
170 : ! **************************************************************************************************
171 : !> \brief Activates the device selected via offload_set_chosen_device()
172 : !> \author Ole Schuett
173 : ! **************************************************************************************************
174 2012494 : SUBROUTINE offload_activate_chosen_device()
175 :
176 : INTERFACE
177 : SUBROUTINE offload_activate_chosen_device_c() &
178 : BIND(C, name="offload_activate_chosen_device")
179 : END SUBROUTINE offload_activate_chosen_device_c
180 : END INTERFACE
181 :
182 2012494 : CALL offload_activate_chosen_device_c()
183 :
184 2012494 : END SUBROUTINE offload_activate_chosen_device
185 :
186 : ! **************************************************************************************************
187 : !> \brief Starts a timing range.
188 : !> \param routineN ...
189 : !> \author Ole Schuett
190 : ! **************************************************************************************************
191 2005014483 : SUBROUTINE offload_timeset(routineN)
192 : CHARACTER(LEN=*), INTENT(IN) :: routineN
193 :
194 : INTERFACE
195 : SUBROUTINE offload_timeset_c(message) BIND(C, name="offload_timeset")
196 : IMPORT :: C_CHAR
197 : CHARACTER(kind=C_CHAR), DIMENSION(*), INTENT(IN) :: message
198 : END SUBROUTINE offload_timeset_c
199 : END INTERFACE
200 :
201 2005014483 : CALL offload_timeset_c(TRIM(routineN)//C_NULL_CHAR)
202 :
203 2005014483 : END SUBROUTINE offload_timeset
204 :
205 : ! **************************************************************************************************
206 : !> \brief Ends a timing range.
207 : !> \author Ole Schuett
208 : ! **************************************************************************************************
209 2005014479 : SUBROUTINE offload_timestop()
210 :
211 : INTERFACE
212 : SUBROUTINE offload_timestop_c() BIND(C, name="offload_timestop")
213 : END SUBROUTINE offload_timestop_c
214 : END INTERFACE
215 :
216 2005014479 : CALL offload_timestop_c()
217 :
218 2005014479 : END SUBROUTINE offload_timestop
219 :
220 : ! **************************************************************************************************
221 : !> \brief Gets free and total device memory.
222 : !> \param free ...
223 : !> \param total ...
224 : !> \author Ole Schuett
225 : ! **************************************************************************************************
226 0 : SUBROUTINE offload_mem_info(free, total)
227 : INTEGER(KIND=int_8), INTENT(OUT) :: free, total
228 :
229 : INTEGER(KIND=C_SIZE_T) :: my_free, my_total
230 : INTERFACE
231 : SUBROUTINE offload_mem_info_c(free, total) BIND(C, name="offload_mem_info")
232 : IMPORT :: C_SIZE_T
233 : INTEGER(KIND=C_SIZE_T) :: free, total
234 : END SUBROUTINE offload_mem_info_c
235 : END INTERFACE
236 :
237 0 : CALL offload_mem_info_c(my_free, my_total)
238 :
239 : ! On 32-bit architectures this converts from int_4 to int_8.
240 0 : free = my_free
241 0 : total = my_total
242 :
243 0 : END SUBROUTINE offload_mem_info
244 :
245 : ! **************************************************************************************************
246 : !> \brief Allocates a buffer of given length, ie. number of elements.
247 : !> \param length ...
248 : !> \param buffer ...
249 : !> \author Ole Schuett
250 : ! **************************************************************************************************
251 327135 : SUBROUTINE offload_create_buffer(length, buffer)
252 : INTEGER, INTENT(IN) :: length
253 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
254 :
255 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_create_buffer'
256 :
257 : INTEGER :: handle
258 : TYPE(C_PTR) :: host_buffer_c
259 : INTERFACE
260 : SUBROUTINE offload_create_buffer_c(length, buffer) &
261 : BIND(C, name="offload_create_buffer")
262 : IMPORT :: C_PTR, C_INT
263 : INTEGER(KIND=C_INT), VALUE :: length
264 : TYPE(C_PTR) :: buffer
265 : END SUBROUTINE offload_create_buffer_c
266 : END INTERFACE
267 : INTERFACE
268 : FUNCTION offload_get_buffer_host_pointer_c(buffer) &
269 : BIND(C, name="offload_get_buffer_host_pointer")
270 : IMPORT :: C_PTR
271 : TYPE(C_PTR), VALUE :: buffer
272 : TYPE(C_PTR) :: offload_get_buffer_host_pointer_c
273 : END FUNCTION offload_get_buffer_host_pointer_c
274 : END INTERFACE
275 :
276 327135 : CALL timeset(routineN, handle)
277 :
278 327135 : IF (ASSOCIATED(buffer%host_buffer)) THEN
279 14392 : IF (SIZE(buffer%host_buffer) == 0) DEALLOCATE (buffer%host_buffer)
280 14392 : IF (ASSOCIATED(buffer%host_buffer)) NULLIFY (buffer%host_buffer)
281 : END IF
282 :
283 327135 : CALL offload_create_buffer_c(length=length, buffer=buffer%c_ptr)
284 327135 : CPASSERT(C_ASSOCIATED(buffer%c_ptr))
285 :
286 327135 : IF (length == 0) THEN
287 : ! While C_F_POINTER usually accepts a NULL pointer it's not standard compliant.
288 676 : ALLOCATE (buffer%host_buffer(0))
289 : ELSE
290 326459 : host_buffer_c = offload_get_buffer_host_pointer_c(buffer%c_ptr)
291 326459 : CPASSERT(C_ASSOCIATED(host_buffer_c))
292 652918 : CALL C_F_POINTER(host_buffer_c, buffer%host_buffer, shape=[length])
293 : END IF
294 :
295 327135 : CALL timestop(handle)
296 327135 : END SUBROUTINE offload_create_buffer
297 :
298 : ! **************************************************************************************************
299 : !> \brief Deallocates given buffer.
300 : !> \param buffer ...
301 : !> \author Ole Schuett
302 : ! **************************************************************************************************
303 314368 : SUBROUTINE offload_free_buffer(buffer)
304 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
305 :
306 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_free_buffer'
307 :
308 : INTEGER :: handle
309 : INTERFACE
310 : SUBROUTINE offload_free_buffer_c(buffer) &
311 : BIND(C, name="offload_free_buffer")
312 : IMPORT :: C_PTR
313 : TYPE(C_PTR), VALUE :: buffer
314 : END SUBROUTINE offload_free_buffer_c
315 : END INTERFACE
316 :
317 314368 : CALL timeset(routineN, handle)
318 :
319 314368 : IF (C_ASSOCIATED(buffer%c_ptr)) THEN
320 :
321 312736 : CALL offload_free_buffer_c(buffer%c_ptr)
322 :
323 312736 : buffer%c_ptr = C_NULL_PTR
324 :
325 312736 : IF (ASSOCIATED(buffer%host_buffer)) THEN
326 312736 : IF (SIZE(buffer%host_buffer) == 0) THEN
327 574 : DEALLOCATE (buffer%host_buffer)
328 : ELSE
329 312162 : NULLIFY (buffer%host_buffer)
330 : END IF
331 : END IF
332 : END IF
333 :
334 314368 : CALL timestop(handle)
335 314368 : END SUBROUTINE offload_free_buffer
336 :
337 : ! **************************************************************************************************
338 : !> \brief Print allocation statistics.
339 : !> \param mpi_comm ...
340 : !> \param output_unit ...
341 : !> \author Ole Schuett
342 : ! **************************************************************************************************
343 11222 : SUBROUTINE offload_mempool_stats_print(mpi_comm, output_unit)
344 : TYPE(mp_comm_type), INTENT(IN) :: mpi_comm
345 : INTEGER, INTENT(IN) :: output_unit
346 :
347 : INTERFACE
348 : SUBROUTINE offload_mempool_stats_print_c(mpi_comm, print_func, output_unit) &
349 : BIND(C, name="offload_mempool_stats_print")
350 : IMPORT :: C_FUNPTR, C_INT
351 : INTEGER(KIND=C_INT), VALUE :: mpi_comm
352 : TYPE(C_FUNPTR), VALUE :: print_func
353 : INTEGER(KIND=C_INT), VALUE :: output_unit
354 : END SUBROUTINE offload_mempool_stats_print_c
355 : END INTERFACE
356 :
357 : ! Since Fortran units groups can't be used from C, we pass a function pointer instead.
358 : CALL offload_mempool_stats_print_c(mpi_comm=mpi_comm%get_handle(), &
359 : print_func=C_FUNLOC(print_func), &
360 11222 : output_unit=output_unit)
361 :
362 11222 : END SUBROUTINE offload_mempool_stats_print
363 :
364 : ! **************************************************************************************************
365 : !> \brief Callback to write to a Fortran output unit (called by C-side).
366 : !> \param msg to be printed.
367 : !> \param msglen number of characters excluding the terminating character.
368 : !> \param output_unit used for output.
369 : !> \author Hans Pabst
370 : ! **************************************************************************************************
371 92052 : SUBROUTINE print_func(msg, msglen, output_unit) BIND(C, name="offload_api_print_func")
372 : CHARACTER(KIND=C_CHAR), INTENT(IN) :: msg(*)
373 : INTEGER(KIND=C_INT), INTENT(IN), VALUE :: msglen, output_unit
374 :
375 92052 : IF (output_unit <= 0) RETURN ! Omit to print the message.
376 46296 : WRITE (output_unit, FMT="(100A)", ADVANCE="NO") msg(1:msglen)
377 : END SUBROUTINE print_func
378 :
379 : ! GPU data transfer functions
380 : ! **************************************************************************************************
381 : !> \brief Copy host data to device.
382 : !> \param buffer ...
383 : !> \param length ...
384 : ! **************************************************************************************************
385 0 : SUBROUTINE offload_buffer_h2d(buffer, length)
386 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
387 : INTEGER, INTENT(IN) :: length
388 :
389 : INTERFACE
390 : SUBROUTINE offload_buffer_h2d_c(buffer, length) &
391 : BIND(C, name="offload_buffer_h2d")
392 : IMPORT :: C_PTR, C_INT
393 : TYPE(C_PTR), VALUE :: buffer
394 : INTEGER(KIND=C_INT), VALUE :: length
395 : END SUBROUTINE offload_buffer_h2d_c
396 : END INTERFACE
397 :
398 0 : CALL offload_buffer_h2d_c(buffer%c_ptr, length)
399 0 : END SUBROUTINE offload_buffer_h2d
400 :
401 : ! **************************************************************************************************
402 : !> \brief Copy device data to host.
403 : !> \param buffer ...
404 : !> \param length ...
405 : ! **************************************************************************************************
406 0 : SUBROUTINE offload_buffer_d2h(buffer, length)
407 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
408 : INTEGER, INTENT(IN) :: length
409 :
410 : INTERFACE
411 : SUBROUTINE offload_buffer_d2h_c(buffer, length) &
412 : BIND(C, name="offload_buffer_d2h")
413 : IMPORT :: C_PTR, C_INT
414 : TYPE(C_PTR), VALUE :: buffer
415 : INTEGER(KIND=C_INT), VALUE :: length
416 : END SUBROUTINE offload_buffer_d2h_c
417 : END INTERFACE
418 :
419 0 : CALL offload_buffer_d2h_c(buffer%c_ptr, length)
420 0 : END SUBROUTINE offload_buffer_d2h
421 :
422 : ! **************************************************************************************************
423 : !> \brief Return a C pointer to the buffer's underlying device memory.
424 : !> \param buffer ...
425 : !> \return ...
426 : !> \author Samal Bibek
427 : ! **************************************************************************************************
428 0 : FUNCTION offload_get_buffer_device_pointer(buffer) RESULT(device_ptr)
429 : TYPE(offload_buffer_type), INTENT(IN) :: buffer
430 : TYPE(C_PTR) :: device_ptr
431 :
432 : INTERFACE
433 : FUNCTION offload_get_buffer_device_pointer_c(buffer) &
434 : BIND(C, name="offload_get_buffer_device_pointer")
435 : IMPORT :: C_PTR
436 : TYPE(C_PTR), VALUE :: buffer
437 : TYPE(C_PTR) :: offload_get_buffer_device_pointer_c
438 : END FUNCTION offload_get_buffer_device_pointer_c
439 : END INTERFACE
440 :
441 0 : device_ptr = offload_get_buffer_device_pointer_c(buffer%c_ptr)
442 0 : END FUNCTION offload_get_buffer_device_pointer
443 :
444 : ! **************************************************************************************************
445 : !> \brief Blocks until all outstanding device work has completed.
446 : !> \author Samal Bibek
447 : ! **************************************************************************************************
448 0 : SUBROUTINE offload_device_synchronize()
449 : INTERFACE
450 : SUBROUTINE offload_device_synchronize_c() &
451 : BIND(C, name="offload_device_synchronize")
452 : END SUBROUTINE offload_device_synchronize_c
453 : END INTERFACE
454 :
455 0 : CALL offload_device_synchronize_c()
456 0 : END SUBROUTINE offload_device_synchronize
457 : ! **************************************************************************************************
458 : !> \brief Return a C pointer to the buffer's host memory.
459 : !> \param buffer ...
460 : !> \return ...
461 : ! **************************************************************************************************
462 0 : FUNCTION offload_get_buffer_host_pointer(buffer) RESULT(host_ptr)
463 : TYPE(offload_buffer_type), INTENT(IN) :: buffer
464 : TYPE(C_PTR) :: host_ptr
465 :
466 : INTERFACE
467 : FUNCTION offload_get_buffer_host_pointer_c(buffer) &
468 : BIND(C, name="offload_get_buffer_host_pointer")
469 : IMPORT :: C_PTR
470 : TYPE(C_PTR), VALUE :: buffer
471 : TYPE(C_PTR) :: offload_get_buffer_host_pointer_c
472 : END FUNCTION offload_get_buffer_host_pointer_c
473 : END INTERFACE
474 :
475 0 : host_ptr = offload_get_buffer_host_pointer_c(buffer%c_ptr)
476 0 : END FUNCTION offload_get_buffer_host_pointer
477 0 : END MODULE offload_api
|
