Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2022 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_get_device_count
32 : PUBLIC :: offload_set_chosen_device, offload_get_chosen_device, offload_activate_chosen_device
33 : PUBLIC :: offload_timeset, offload_timestop, offload_mem_info
34 : PUBLIC :: offload_buffer_type, offload_create_buffer, offload_free_buffer
35 : PUBLIC :: offload_malloc_pinned_mem, offload_free_pinned_mem
36 :
37 : TYPE offload_buffer_type
38 : REAL(KIND=dp), DIMENSION(:), POINTER :: host_buffer => Null()
39 : TYPE(C_PTR) :: c_ptr = C_NULL_PTR
40 : END TYPE offload_buffer_type
41 :
42 : CONTAINS
43 :
44 : ! **************************************************************************************************
45 : !> \brief allocate pinned memory.
46 : !> \param buffer address of the buffer
47 : !> \param length length of the buffer
48 : !> \return 0
49 : ! **************************************************************************************************
50 0 : FUNCTION offload_malloc_pinned_mem(buffer, length) RESULT(res)
51 : TYPE(C_PTR) :: buffer
52 : INTEGER(C_SIZE_T), VALUE :: length
53 : INTEGER :: res
54 :
55 : INTERFACE
56 : FUNCTION offload_malloc_pinned_mem_c(buffer, length) &
57 : BIND(C, name="offload_host_malloc")
58 : IMPORT C_SIZE_T, C_PTR, C_INT
59 : TYPE(C_PTR) :: buffer
60 : INTEGER(C_SIZE_T), VALUE :: length
61 : INTEGER(KIND=C_INT) :: offload_malloc_pinned_mem_c
62 : END FUNCTION offload_malloc_pinned_mem_c
63 : END INTERFACE
64 :
65 0 : res = offload_malloc_pinned_mem_c(buffer, length)
66 0 : END FUNCTION offload_malloc_pinned_mem
67 :
68 : ! **************************************************************************************************
69 : !> \brief free pinned memory
70 : !> \param buffer address of the buffer
71 : !> \return 0
72 : ! **************************************************************************************************
73 0 : FUNCTION offload_free_pinned_mem(buffer) RESULT(res)
74 : TYPE(C_PTR), VALUE :: buffer
75 : INTEGER :: res
76 :
77 : INTERFACE
78 : FUNCTION offload_free_pinned_mem_c(buffer) &
79 : BIND(C, name="offload_host_free")
80 : IMPORT C_PTR, C_INT
81 : INTEGER(KIND=C_INT) :: offload_free_pinned_mem_c
82 : TYPE(C_PTR), VALUE :: buffer
83 : END FUNCTION offload_free_pinned_mem_c
84 : END INTERFACE
85 :
86 0 : res = offload_free_pinned_mem_c(buffer)
87 0 : END FUNCTION offload_free_pinned_mem
88 :
89 : ! **************************************************************************************************
90 : !> \brief Returns the number of available devices.
91 : !> \return ...
92 : !> \author Ole Schuett
93 : ! **************************************************************************************************
94 7610 : FUNCTION offload_get_device_count() RESULT(count)
95 : INTEGER :: count
96 :
97 : INTERFACE
98 : FUNCTION offload_get_device_count_c() &
99 : BIND(C, name="offload_get_device_count")
100 : IMPORT :: C_INT
101 : INTEGER(KIND=C_INT) :: offload_get_device_count_c
102 : END FUNCTION offload_get_device_count_c
103 : END INTERFACE
104 :
105 7610 : count = offload_get_device_count_c()
106 :
107 7610 : END FUNCTION offload_get_device_count
108 :
109 : ! **************************************************************************************************
110 : !> \brief Selects the chosen device to be used.
111 : !> \param device_id ...
112 : !> \author Ole Schuett
113 : ! **************************************************************************************************
114 0 : SUBROUTINE offload_set_chosen_device(device_id)
115 : INTEGER, INTENT(IN) :: device_id
116 :
117 : INTERFACE
118 : SUBROUTINE offload_set_chosen_device_c(device_id) &
119 : BIND(C, name="offload_set_chosen_device")
120 : IMPORT :: C_INT
121 : INTEGER(KIND=C_INT), VALUE :: device_id
122 : END SUBROUTINE offload_set_chosen_device_c
123 : END INTERFACE
124 :
125 0 : CALL offload_set_chosen_device_c(device_id=device_id)
126 :
127 0 : END SUBROUTINE offload_set_chosen_device
128 :
129 : ! **************************************************************************************************
130 : !> \brief Returns the chosen device.
131 : !> \return ...
132 : !> \author Ole Schuett
133 : ! **************************************************************************************************
134 0 : FUNCTION offload_get_chosen_device() RESULT(device_id)
135 : INTEGER :: device_id
136 :
137 : INTERFACE
138 : FUNCTION offload_get_chosen_device_c() &
139 : BIND(C, name="offload_get_chosen_device")
140 : IMPORT :: C_INT
141 : INTEGER(KIND=C_INT) :: offload_get_chosen_device_c
142 : END FUNCTION offload_get_chosen_device_c
143 : END INTERFACE
144 :
145 0 : device_id = offload_get_chosen_device_c()
146 :
147 0 : IF (device_id < 0) &
148 0 : CPABORT("No offload device has been chosen.")
149 :
150 0 : END FUNCTION offload_get_chosen_device
151 :
152 : ! **************************************************************************************************
153 : !> \brief Activates the device selected via offload_set_chosen_device()
154 : !> \author Ole Schuett
155 : ! **************************************************************************************************
156 993458 : SUBROUTINE offload_activate_chosen_device()
157 :
158 : INTERFACE
159 : SUBROUTINE offload_activate_chosen_device_c() &
160 : BIND(C, name="offload_activate_chosen_device")
161 : END SUBROUTINE offload_activate_chosen_device_c
162 : END INTERFACE
163 :
164 993458 : CALL offload_activate_chosen_device_c()
165 :
166 993458 : END SUBROUTINE offload_activate_chosen_device
167 :
168 : ! **************************************************************************************************
169 : !> \brief Starts a timing range.
170 : !> \param routineN ...
171 : !> \author Ole Schuett
172 : ! **************************************************************************************************
173 1336531011 : SUBROUTINE offload_timeset(routineN)
174 : CHARACTER(LEN=*), INTENT(IN) :: routineN
175 :
176 : INTERFACE
177 : SUBROUTINE offload_timeset_c(message) BIND(C, name="offload_timeset")
178 : IMPORT :: C_CHAR
179 : CHARACTER(kind=C_CHAR), DIMENSION(*), INTENT(IN) :: message
180 : END SUBROUTINE offload_timeset_c
181 : END INTERFACE
182 :
183 1336531011 : CALL offload_timeset_c(TRIM(routineN)//C_NULL_CHAR)
184 :
185 1336531011 : END SUBROUTINE offload_timeset
186 :
187 : ! **************************************************************************************************
188 : !> \brief Ends a timing range.
189 : !> \author Ole Schuett
190 : ! **************************************************************************************************
191 1336531011 : SUBROUTINE offload_timestop()
192 :
193 : INTERFACE
194 : SUBROUTINE offload_timestop_c() BIND(C, name="offload_timestop")
195 : END SUBROUTINE offload_timestop_c
196 : END INTERFACE
197 :
198 1336531011 : CALL offload_timestop_c()
199 :
200 1336531011 : END SUBROUTINE offload_timestop
201 :
202 : ! **************************************************************************************************
203 : !> \brief Gets free and total device memory.
204 : !> \param free ...
205 : !> \param total ...
206 : !> \author Ole Schuett
207 : ! **************************************************************************************************
208 197833 : SUBROUTINE offload_mem_info(free, total)
209 : INTEGER(KIND=int_8), INTENT(OUT) :: free, total
210 :
211 : INTEGER(KIND=C_SIZE_T) :: my_free, my_total
212 : INTERFACE
213 : SUBROUTINE offload_mem_info_c(free, total) BIND(C, name="offload_mem_info")
214 : IMPORT :: C_SIZE_T
215 : INTEGER(KIND=C_SIZE_T) :: free, total
216 : END SUBROUTINE offload_mem_info_c
217 : END INTERFACE
218 :
219 197833 : CALL offload_mem_info_c(my_free, my_total)
220 :
221 : ! On 32-bit architectures this converts from int_4 to int_8.
222 197833 : free = my_free
223 197833 : total = my_total
224 :
225 197833 : END SUBROUTINE offload_mem_info
226 :
227 : ! **************************************************************************************************
228 : !> \brief Allocates a buffer of given length, ie. number of elements.
229 : !> \param length ...
230 : !> \param buffer ...
231 : !> \author Ole Schuett
232 : ! **************************************************************************************************
233 241194 : SUBROUTINE offload_create_buffer(length, buffer)
234 : INTEGER, INTENT(IN) :: length
235 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
236 :
237 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_create_buffer'
238 :
239 : INTEGER :: handle
240 : TYPE(C_PTR) :: host_buffer_c
241 : INTERFACE
242 : SUBROUTINE offload_create_buffer_c(length, buffer) &
243 : BIND(C, name="offload_create_buffer")
244 : IMPORT :: C_PTR, C_INT
245 : INTEGER(KIND=C_INT), VALUE :: length
246 : TYPE(C_PTR) :: buffer
247 : END SUBROUTINE offload_create_buffer_c
248 : END INTERFACE
249 : INTERFACE
250 :
251 : FUNCTION offload_get_buffer_host_pointer_c(buffer) &
252 : BIND(C, name="offload_get_buffer_host_pointer")
253 : IMPORT :: C_PTR
254 : TYPE(C_PTR), VALUE :: buffer
255 : TYPE(C_PTR) :: offload_get_buffer_host_pointer_c
256 : END FUNCTION offload_get_buffer_host_pointer_c
257 : END INTERFACE
258 :
259 241194 : CALL timeset(routineN, handle)
260 :
261 241194 : IF (ASSOCIATED(buffer%host_buffer)) THEN
262 9500 : IF (SIZE(buffer%host_buffer) == 0) DEALLOCATE (buffer%host_buffer)
263 : END IF
264 :
265 241194 : CALL offload_create_buffer_c(length=length, buffer=buffer%c_ptr)
266 241194 : CPASSERT(C_ASSOCIATED(buffer%c_ptr))
267 :
268 241194 : IF (length == 0) THEN
269 : ! While C_F_POINTER usually accepts a NULL pointer it's not standard compliant.
270 438 : ALLOCATE (buffer%host_buffer(0))
271 : ELSE
272 240756 : host_buffer_c = offload_get_buffer_host_pointer_c(buffer%c_ptr)
273 240756 : CPASSERT(C_ASSOCIATED(host_buffer_c))
274 481512 : CALL C_F_POINTER(host_buffer_c, buffer%host_buffer, shape=(/length/))
275 : END IF
276 :
277 241194 : CALL timestop(handle)
278 241194 : END SUBROUTINE offload_create_buffer
279 :
280 : ! **************************************************************************************************
281 : !> \brief Deallocates given buffer.
282 : !> \param buffer ...
283 : !> \author Ole Schuett
284 : ! **************************************************************************************************
285 231694 : SUBROUTINE offload_free_buffer(buffer)
286 : TYPE(offload_buffer_type), INTENT(INOUT) :: buffer
287 :
288 : CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_free_buffer'
289 :
290 : INTEGER :: handle
291 : INTERFACE
292 : SUBROUTINE offload_free_buffer_c(buffer) &
293 : BIND(C, name="offload_free_buffer")
294 : IMPORT :: C_PTR
295 : TYPE(C_PTR), VALUE :: buffer
296 : END SUBROUTINE offload_free_buffer_c
297 : END INTERFACE
298 :
299 231694 : CALL timeset(routineN, handle)
300 :
301 231694 : CPASSERT(C_ASSOCIATED(buffer%c_ptr))
302 :
303 231694 : CALL offload_free_buffer_c(buffer%c_ptr)
304 :
305 231694 : buffer%c_ptr = C_NULL_PTR
306 :
307 231694 : IF (SIZE(buffer%host_buffer) == 0) THEN
308 332 : DEALLOCATE (buffer%host_buffer)
309 : ELSE
310 231362 : NULLIFY (buffer%host_buffer)
311 : END IF
312 :
313 231694 : CALL timestop(handle)
314 231694 : END SUBROUTINE offload_free_buffer
315 0 : END MODULE offload_api
|