Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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: C_ASSOCIATED,&
14 : C_CHAR,&
15 : C_F_POINTER,&
16 : C_INT,&
17 : C_NULL_CHAR,&
18 : C_NULL_PTR,&
19 : C_PTR,&
20 : C_SIZE_T
21 : USE kinds, ONLY: dp,&
22 : int_8
23 : #include "../base/base_uses.f90"
24 :
25 : IMPLICIT NONE
26 :
27 : PRIVATE
28 :
29 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'offload_api'
30 :
31 : PUBLIC :: offload_init
32 : PUBLIC :: offload_get_device_count
33 : PUBLIC :: offload_set_chosen_device, offload_get_chosen_device, offload_activate_chosen_device
34 : PUBLIC :: offload_timeset, offload_timestop, offload_mem_info
35 : PUBLIC :: offload_buffer_type, offload_create_buffer, offload_free_buffer
36 : PUBLIC :: offload_malloc_pinned_mem, offload_free_pinned_mem
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 8530 : 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 8530 : CALL offload_init_c()
103 :
104 8530 : END SUBROUTINE offload_init
105 :
106 : ! **************************************************************************************************
107 : !> \brief Returns the number of available devices.
108 : !> \return ...
109 : !> \author Ole Schuett
110 : ! **************************************************************************************************
111 8534 : 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 8534 : count = offload_get_device_count_c()
123 :
124 8534 : 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) &
165 0 : CPABORT("No offload device has been chosen.")
166 :
167 0 : END FUNCTION offload_get_chosen_device
168 :
169 : ! **************************************************************************************************
170 : !> \brief Activates the device selected via offload_set_chosen_device()
171 : !> \author Ole Schuett
172 : ! **************************************************************************************************
173 1400716 : SUBROUTINE offload_activate_chosen_device()
174 :
175 : INTERFACE
176 : SUBROUTINE offload_activate_chosen_device_c() &
177 : BIND(C, name="offload_activate_chosen_device")
178 : END SUBROUTINE offload_activate_chosen_device_c
179 : END INTERFACE
180 :
181 1400716 : CALL offload_activate_chosen_device_c()
182 :
183 1400716 : END SUBROUTINE offload_activate_chosen_device
184 :
185 : ! **************************************************************************************************
186 : !> \brief Starts a timing range.
187 : !> \param routineN ...
188 : !> \author Ole Schuett
189 : ! **************************************************************************************************
190 1562303159 : SUBROUTINE offload_timeset(routineN)
191 : CHARACTER(LEN=*), INTENT(IN) :: routineN
192 :
193 : INTERFACE
194 : SUBROUTINE offload_timeset_c(message) BIND(C, name="offload_timeset")
195 : IMPORT :: C_CHAR
196 : CHARACTER(kind=C_CHAR), DIMENSION(*), INTENT(IN) :: message
197 : END SUBROUTINE offload_timeset_c
198 : END INTERFACE
199 :
200 1562303159 : CALL offload_timeset_c(TRIM(routineN)//C_NULL_CHAR)
201 :
202 1562303159 : END SUBROUTINE offload_timeset
203 :
204 : ! **************************************************************************************************
205 : !> \brief Ends a timing range.
206 : !> \author Ole Schuett
207 : ! **************************************************************************************************
208 1562303159 : SUBROUTINE offload_timestop()
209 :
210 : INTERFACE
211 : SUBROUTINE offload_timestop_c() BIND(C, name="offload_timestop")
212 : END SUBROUTINE offload_timestop_c
213 : END INTERFACE
214 :
215 1562303159 : CALL offload_timestop_c()
216 :
217 1562303159 : END SUBROUTINE offload_timestop
218 :
219 : ! **************************************************************************************************
220 : !> \brief Gets free and total device memory.
221 : !> \param free ...
222 : !> \param total ...
223 : !> \author Ole Schuett
224 : ! **************************************************************************************************
225 0 : SUBROUTINE offload_mem_info(free, total)
226 : INTEGER(KIND=int_8), INTENT(OUT) :: free, total
227 :
228 : INTEGER(KIND=C_SIZE_T) :: my_free, my_total
229 : INTERFACE
230 : SUBROUTINE offload_mem_info_c(free, total) BIND(C, name="offload_mem_info")
231 : IMPORT :: C_SIZE_T
232 : INTEGER(KIND=C_SIZE_T) :: free, total
233 : END SUBROUTINE offload_mem_info_c
234 : END INTERFACE
235 :
236 0 : CALL offload_mem_info_c(my_free, my_total)
237 :
238 : ! On 32-bit architectures this converts from int_4 to int_8.
239 0 : free = my_free
240 0 : total = my_total
241 :
242 0 : END SUBROUTINE offload_mem_info
243 :
244 : ! **************************************************************************************************
245 : !> \brief Allocates a buffer of given length, ie. number of elements.
246 : !> \param length ...
247 : !> \param buffer ...
248 : !> \author Ole Schuett
249 : ! **************************************************************************************************
250 262236 : SUBROUTINE offload_create_buffer(length, buffer)
251 : INTEGER, INTENT(IN) :: length
252 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
253 :
254 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_create_buffer'
255 :
256 : INTEGER :: handle
257 : TYPE(C_PTR) :: host_buffer_c
258 : INTERFACE
259 : SUBROUTINE offload_create_buffer_c(length, buffer) &
260 : BIND(C, name="offload_create_buffer")
261 : IMPORT :: C_PTR, C_INT
262 : INTEGER(KIND=C_INT), VALUE :: length
263 : TYPE(C_PTR) :: buffer
264 : END SUBROUTINE offload_create_buffer_c
265 : END INTERFACE
266 : INTERFACE
267 :
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 262236 : CALL timeset(routineN, handle)
277 :
278 262236 : IF (ASSOCIATED(buffer%host_buffer)) THEN
279 10788 : IF (SIZE(buffer%host_buffer) == 0) DEALLOCATE (buffer%host_buffer)
280 : END IF
281 :
282 262236 : CALL offload_create_buffer_c(length=length, buffer=buffer%c_ptr)
283 262236 : CPASSERT(C_ASSOCIATED(buffer%c_ptr))
284 :
285 262236 : IF (length == 0) THEN
286 : ! While C_F_POINTER usually accepts a NULL pointer it's not standard compliant.
287 454 : ALLOCATE (buffer%host_buffer(0))
288 : ELSE
289 261782 : host_buffer_c = offload_get_buffer_host_pointer_c(buffer%c_ptr)
290 261782 : CPASSERT(C_ASSOCIATED(host_buffer_c))
291 523564 : CALL C_F_POINTER(host_buffer_c, buffer%host_buffer, shape=(/length/))
292 : END IF
293 :
294 262236 : CALL timestop(handle)
295 262236 : END SUBROUTINE offload_create_buffer
296 :
297 : ! **************************************************************************************************
298 : !> \brief Deallocates given buffer.
299 : !> \param buffer ...
300 : !> \author Ole Schuett
301 : ! **************************************************************************************************
302 253200 : SUBROUTINE offload_free_buffer(buffer)
303 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
304 :
305 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_free_buffer'
306 :
307 : INTEGER :: handle
308 : INTERFACE
309 : SUBROUTINE offload_free_buffer_c(buffer) &
310 : BIND(C, name="offload_free_buffer")
311 : IMPORT :: C_PTR
312 : TYPE(C_PTR), VALUE :: buffer
313 : END SUBROUTINE offload_free_buffer_c
314 : END INTERFACE
315 :
316 253200 : CALL timeset(routineN, handle)
317 :
318 253200 : IF (C_ASSOCIATED(buffer%c_ptr)) THEN
319 :
320 251448 : CALL offload_free_buffer_c(buffer%c_ptr)
321 :
322 251448 : buffer%c_ptr = C_NULL_PTR
323 :
324 251448 : IF (SIZE(buffer%host_buffer) == 0) THEN
325 350 : DEALLOCATE (buffer%host_buffer)
326 : ELSE
327 251098 : NULLIFY (buffer%host_buffer)
328 : END IF
329 : END IF
330 :
331 253200 : CALL timestop(handle)
332 253200 : END SUBROUTINE offload_free_buffer
333 0 : END MODULE offload_api
|
