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: 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 9284 : 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 9284 : CALL offload_init_c()
100 :
101 9284 : END SUBROUTINE offload_init
102 :
103 : ! **************************************************************************************************
104 : !> \brief Returns the number of available devices.
105 : !> \return ...
106 : !> \author Ole Schuett
107 : ! **************************************************************************************************
108 9288 : 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 9288 : count = offload_get_device_count_c()
120 :
121 9288 : 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) &
162 0 : CPABORT("No offload device has been chosen.")
163 :
164 0 : END FUNCTION offload_get_chosen_device
165 :
166 : ! **************************************************************************************************
167 : !> \brief Activates the device selected via offload_set_chosen_device()
168 : !> \author Ole Schuett
169 : ! **************************************************************************************************
170 1439238 : SUBROUTINE offload_activate_chosen_device()
171 :
172 : INTERFACE
173 : SUBROUTINE offload_activate_chosen_device_c() &
174 : BIND(C, name="offload_activate_chosen_device")
175 : END SUBROUTINE offload_activate_chosen_device_c
176 : END INTERFACE
177 :
178 1439238 : CALL offload_activate_chosen_device_c()
179 :
180 1439238 : END SUBROUTINE offload_activate_chosen_device
181 :
182 : ! **************************************************************************************************
183 : !> \brief Starts a timing range.
184 : !> \param routineN ...
185 : !> \author Ole Schuett
186 : ! **************************************************************************************************
187 1641700905 : SUBROUTINE offload_timeset(routineN)
188 : CHARACTER(LEN=*), INTENT(IN) :: routineN
189 :
190 : INTERFACE
191 : SUBROUTINE offload_timeset_c(message) BIND(C, name="offload_timeset")
192 : IMPORT :: C_CHAR
193 : CHARACTER(kind=C_CHAR), DIMENSION(*), INTENT(IN) :: message
194 : END SUBROUTINE offload_timeset_c
195 : END INTERFACE
196 :
197 1641700905 : CALL offload_timeset_c(TRIM(routineN)//C_NULL_CHAR)
198 :
199 1641700905 : END SUBROUTINE offload_timeset
200 :
201 : ! **************************************************************************************************
202 : !> \brief Ends a timing range.
203 : !> \author Ole Schuett
204 : ! **************************************************************************************************
205 1641700905 : SUBROUTINE offload_timestop()
206 :
207 : INTERFACE
208 : SUBROUTINE offload_timestop_c() BIND(C, name="offload_timestop")
209 : END SUBROUTINE offload_timestop_c
210 : END INTERFACE
211 :
212 1641700905 : CALL offload_timestop_c()
213 :
214 1641700905 : END SUBROUTINE offload_timestop
215 :
216 : ! **************************************************************************************************
217 : !> \brief Gets free and total device memory.
218 : !> \param free ...
219 : !> \param total ...
220 : !> \author Ole Schuett
221 : ! **************************************************************************************************
222 0 : SUBROUTINE offload_mem_info(free, total)
223 : INTEGER(KIND=int_8), INTENT(OUT) :: free, total
224 :
225 : INTEGER(KIND=C_SIZE_T) :: my_free, my_total
226 : INTERFACE
227 : SUBROUTINE offload_mem_info_c(free, total) BIND(C, name="offload_mem_info")
228 : IMPORT :: C_SIZE_T
229 : INTEGER(KIND=C_SIZE_T) :: free, total
230 : END SUBROUTINE offload_mem_info_c
231 : END INTERFACE
232 :
233 0 : CALL offload_mem_info_c(my_free, my_total)
234 :
235 : ! On 32-bit architectures this converts from int_4 to int_8.
236 0 : free = my_free
237 0 : total = my_total
238 :
239 0 : END SUBROUTINE offload_mem_info
240 :
241 : ! **************************************************************************************************
242 : !> \brief Allocates a buffer of given length, ie. number of elements.
243 : !> \param length ...
244 : !> \param buffer ...
245 : !> \author Ole Schuett
246 : ! **************************************************************************************************
247 274418 : SUBROUTINE offload_create_buffer(length, buffer)
248 : INTEGER, INTENT(IN) :: length
249 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
250 :
251 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_create_buffer'
252 :
253 : INTEGER :: handle
254 : TYPE(C_PTR) :: host_buffer_c
255 : INTERFACE
256 : SUBROUTINE offload_create_buffer_c(length, buffer) &
257 : BIND(C, name="offload_create_buffer")
258 : IMPORT :: C_PTR, C_INT
259 : INTEGER(KIND=C_INT), VALUE :: length
260 : TYPE(C_PTR) :: buffer
261 : END SUBROUTINE offload_create_buffer_c
262 : END INTERFACE
263 : INTERFACE
264 :
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 274418 : CALL timeset(routineN, handle)
274 :
275 274418 : IF (ASSOCIATED(buffer%host_buffer)) THEN
276 11356 : IF (SIZE(buffer%host_buffer) == 0) DEALLOCATE (buffer%host_buffer)
277 : END IF
278 :
279 274418 : CALL offload_create_buffer_c(length=length, buffer=buffer%c_ptr)
280 274418 : CPASSERT(C_ASSOCIATED(buffer%c_ptr))
281 :
282 274418 : IF (length == 0) THEN
283 : ! While C_F_POINTER usually accepts a NULL pointer it's not standard compliant.
284 464 : ALLOCATE (buffer%host_buffer(0))
285 : ELSE
286 273954 : host_buffer_c = offload_get_buffer_host_pointer_c(buffer%c_ptr)
287 273954 : CPASSERT(C_ASSOCIATED(host_buffer_c))
288 547908 : CALL C_F_POINTER(host_buffer_c, buffer%host_buffer, shape=[length])
289 : END IF
290 :
291 274418 : CALL timestop(handle)
292 274418 : END SUBROUTINE offload_create_buffer
293 :
294 : ! **************************************************************************************************
295 : !> \brief Deallocates given buffer.
296 : !> \param buffer ...
297 : !> \author Ole Schuett
298 : ! **************************************************************************************************
299 264814 : SUBROUTINE offload_free_buffer(buffer)
300 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
301 :
302 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_free_buffer'
303 :
304 : INTEGER :: handle
305 : INTERFACE
306 : SUBROUTINE offload_free_buffer_c(buffer) &
307 : BIND(C, name="offload_free_buffer")
308 : IMPORT :: C_PTR
309 : TYPE(C_PTR), VALUE :: buffer
310 : END SUBROUTINE offload_free_buffer_c
311 : END INTERFACE
312 :
313 264814 : CALL timeset(routineN, handle)
314 :
315 264814 : IF (C_ASSOCIATED(buffer%c_ptr)) THEN
316 :
317 263062 : CALL offload_free_buffer_c(buffer%c_ptr)
318 :
319 263062 : buffer%c_ptr = C_NULL_PTR
320 :
321 263062 : IF (SIZE(buffer%host_buffer) == 0) THEN
322 360 : DEALLOCATE (buffer%host_buffer)
323 : ELSE
324 262702 : NULLIFY (buffer%host_buffer)
325 : END IF
326 : END IF
327 :
328 264814 : CALL timestop(handle)
329 264814 : END SUBROUTINE offload_free_buffer
330 :
331 : ! **************************************************************************************************
332 : !> \brief Print allocation statistics.
333 : !> \param mpi_comm ...
334 : !> \param output_unit ...
335 : !> \author Ole Schuett
336 : ! **************************************************************************************************
337 9402 : SUBROUTINE offload_mempool_stats_print(mpi_comm, output_unit)
338 : TYPE(mp_comm_type), INTENT(IN) :: mpi_comm
339 : INTEGER, INTENT(IN) :: output_unit
340 :
341 : INTERFACE
342 : SUBROUTINE offload_mempool_stats_print_c(mpi_comm, print_func, output_unit) &
343 : BIND(C, name="offload_mempool_stats_print")
344 : IMPORT :: C_FUNPTR, C_INT
345 : INTEGER(KIND=C_INT), VALUE :: mpi_comm
346 : TYPE(C_FUNPTR), VALUE :: print_func
347 : INTEGER(KIND=C_INT), VALUE :: output_unit
348 : END SUBROUTINE offload_mempool_stats_print_c
349 : END INTERFACE
350 :
351 : ! Since Fortran units groups can't be used from C, we pass a function pointer instead.
352 : CALL offload_mempool_stats_print_c(mpi_comm=mpi_comm%get_handle(), &
353 : print_func=C_FUNLOC(print_func), &
354 9402 : output_unit=output_unit)
355 :
356 9402 : END SUBROUTINE offload_mempool_stats_print
357 :
358 : ! **************************************************************************************************
359 : !> \brief Callback to write to a Fortran output unit (called by C-side).
360 : !> \param msg to be printed.
361 : !> \param msglen number of characters excluding the terminating character.
362 : !> \param output_unit used for output.
363 : !> \author Hans Pabst
364 : ! **************************************************************************************************
365 80306 : SUBROUTINE print_func(msg, msglen, output_unit) BIND(C, name="offload_api_print_func")
366 : CHARACTER(KIND=C_CHAR), INTENT(IN) :: msg(*)
367 : INTEGER(KIND=C_INT), INTENT(IN), VALUE :: msglen, output_unit
368 :
369 80306 : IF (output_unit <= 0) RETURN ! Omit to print the message.
370 40433 : WRITE (output_unit, FMT="(100A)", ADVANCE="NO") msg(1:msglen)
371 : END SUBROUTINE print_func
372 0 : END MODULE offload_api
|
