37 use,
intrinsic :: iso_c_binding
43 type(c_ptr),
bind(c) :: glb_cmd_queue = c_null_ptr
49 type(c_ptr),
bind(c) :: glb_ctx = c_null_ptr
52 type(c_ptr),
bind(c),
target :: glb_device_id = c_null_ptr
115 integer(c_int) function clgetplatformids(num_entries, platforms, &
117 bind(c, name =
'clGetPlatformIDs')
118 use,
intrinsic :: iso_c_binding
120 integer(c_int),
value :: num_entries
121 type(c_ptr),
value :: platforms
122 integer(c_int) :: num_platforms
123 end function clgetplatformids
127 integer(c_int) function clgetdeviceids(platform, device_type, &
128 num_entries, devices, num_devices) &
129 bind(c, name =
'clGetDeviceIDs')
130 use,
intrinsic :: iso_c_binding
132 type(c_ptr),
value :: platform
133 integer(c_int64_t),
value :: device_type
134 integer(c_int),
value :: num_entries
135 type(c_ptr),
value :: devices
136 integer(c_int) :: num_devices
137 end function clgetdeviceids
141 type (c_ptr) function clcreatecontext(properties, num_devices, devices, &
142 pfn_notify, user_data, ierr) &
143 bind(c, name =
'clCreateContext')
144 use,
intrinsic :: iso_c_binding
146 type(c_ptr),
value :: properties
147 integer(c_int),
value :: num_devices
148 type(c_ptr),
value :: devices
149 type(c_funptr),
value :: pfn_notify
150 type(c_ptr),
value :: user_data
151 integer(c_int) :: ierr
152 end function clcreatecontext
156 type(c_ptr) function clcreatecommandqueue(context,
device, &
158 bind(c, name =
'clCreateCommandQueue')
159 use,
intrinsic :: iso_c_binding
161 type(c_ptr),
value :: context
162 type(c_ptr),
value ::
device
163 integer(c_int64_t),
value :: properties
164 integer(c_int) :: ierr
165 end function clcreatecommandqueue
169 type(c_ptr) function clcreatebuffer(context, flags, size, host_ptr, ierr) &
170 bind(c, name =
'clCreateBuffer')
171 use,
intrinsic :: iso_c_binding
173 type(c_ptr),
value :: context
174 integer(c_int),
value :: flags
175 integer(c_size_t),
value :: size
176 type(c_ptr),
value :: host_ptr
177 integer(c_int) :: ierr
178 end function clcreatebuffer
182 type(c_ptr) function clcreateuserevent(context, ierr) &
183 bind(c, name =
'clCreateUserEvent')
184 use,
intrinsic :: iso_c_binding
186 type(c_ptr),
value :: context
187 integer(c_int) :: ierr
188 end function clcreateuserevent
192 integer(c_int) function clenqueuereadbuffer(queue, buffer, blocking_read, &
194 num_events_in_wait_list, &
195 event_wait_list, event) &
196 bind(c, name =
'clEnqueueReadBuffer')
197 use,
intrinsic :: iso_c_binding
199 type(c_ptr),
value :: queue
200 type(c_ptr),
value :: buffer
201 integer(c_int),
value :: blocking_read
202 integer(c_size_t),
value :: offset
203 integer(c_size_t),
value :: size
204 type(c_ptr),
value :: ptr
205 integer(c_int),
value :: num_events_in_wait_list
206 type(c_ptr),
value :: event_wait_list
207 type(c_ptr),
value :: event
208 end function clenqueuereadbuffer
212 integer(c_int) function clenqueuewritebuffer(queue, buffer, &
213 blocking_write, offset, &
215 num_events_in_wait_list, &
216 event_wait_list, event) &
217 bind(c, name =
'clEnqueueWriteBuffer')
218 use,
intrinsic :: iso_c_binding
220 type(c_ptr),
value :: queue
221 type(c_ptr),
value :: buffer
222 integer(c_int),
value :: blocking_write
223 integer(c_size_t),
value :: offset
224 integer(c_size_t),
value :: size
225 type(c_ptr),
value :: ptr
226 integer(c_int),
value :: num_events_in_wait_list
227 type(c_ptr),
value :: event_wait_list
228 type(c_ptr),
value :: event
229 end function clenqueuewritebuffer
233 integer(c_int) function clenqueuecopybuffer(queue, src_buffer, &
234 dst_buffer, src_offset, &
236 num_events_in_wait_list, &
237 event_wait_list, event) &
238 bind(c, name =
'clEnqueueCopyBuffer')
239 use,
intrinsic :: iso_c_binding
241 type(c_ptr),
value :: queue
242 type(c_ptr),
value :: src_buffer
243 type(c_ptr),
value :: dst_buffer
244 integer(c_size_t),
value :: src_offset
245 integer(c_size_t),
value :: dst_offset
246 integer(c_size_t),
value :: size
247 integer(c_int),
value :: num_events_in_wait_list
248 type(c_ptr),
value :: event_wait_list
249 type(c_ptr),
value :: event
250 end function clenqueuecopybuffer
254 integer(c_int) function clenqueuemarkerwithwaitlist &
255 (queue, num_events_in_wait_list, event_wait_list, event) &
256 bind(c, name =
'clEnqueueMarkerWithWaitList')
257 use,
intrinsic :: iso_c_binding
259 type(c_ptr),
value :: queue
260 integer(c_int),
value :: num_events_in_wait_list
261 type(c_ptr),
value :: event_wait_list
262 type(c_ptr),
value :: event
263 end function clenqueuemarkerwithwaitlist
267 integer(c_int) function clenqueuemarker(cmd_queue, event) &
268 bind(c, name =
'clEnqueueMarker')
269 use,
intrinsic :: iso_c_binding
271 type(c_ptr),
value :: cmd_queue
272 type(c_ptr),
value :: event
273 end function clenqueuemarker
277 integer(c_int) function clenqueuewaitforevents(queue, &
278 num_events, event_list) &
279 bind(c, name =
'clEnqueueWaitForEvents')
280 use,
intrinsic :: iso_c_binding
282 type(c_ptr),
value :: queue
283 integer(c_int),
value :: num_events
284 type(c_ptr),
value :: event_list
285 end function clenqueuewaitforevents
289 integer(c_int) function clwaitforevents(num_events, event_list) &
290 bind(c, name =
'clWaitForEvents')
291 use,
intrinsic :: iso_c_binding
293 integer(c_int),
value :: num_events
294 type(c_ptr),
value :: event_list
295 end function clwaitforevents
299 integer(c_int) function clsetusereventstatus(event, status) &
300 bind(c, name =
'clSetUserEventStatus')
301 use,
intrinsic :: iso_c_binding
303 type(c_ptr),
value :: event
304 integer(c_int),
value :: status
305 end function clsetusereventstatus
309 integer(c_int) function clgetdeviceinfo(device, param_name, &
310 param_value_size, param_value, &
311 param_value_size_ret) &
312 bind(c, name =
'clGetDeviceInfo')
313 use,
intrinsic :: iso_c_binding
315 type(c_ptr),
value ::
device
316 integer(c_int),
value :: param_name
317 integer(c_size_t),
value :: param_value_size
318 type(c_ptr),
value :: param_value
319 type(c_ptr),
value :: param_value_size_ret
320 end function clgetdeviceinfo
324 integer(c_int) function clreleasecontext(context) &
325 bind(c, name =
'clReleaseContext')
326 use,
intrinsic :: iso_c_binding
328 type(c_ptr),
value :: context
329 end function clreleasecontext
333 integer(c_int) function clreleasecommandqueue(queue) &
334 bind(c, name =
'clReleaseCommandQueue')
335 use,
intrinsic :: iso_c_binding
337 type(c_ptr),
value :: queue
338 end function clreleasecommandqueue
342 integer(c_int) function clreleasedevice(device) &
343 bind(c, name =
'clReleaseDevice')
344 use,
intrinsic :: iso_c_binding
346 type(c_ptr),
value ::
device
347 end function clreleasedevice
351 integer(c_int) function clreleaseprogram(prgm) &
352 bind(c, name =
'clReleaseProgram')
353 use,
intrinsic :: iso_c_binding
355 type(c_ptr),
value :: prgm
356 end function clreleaseprogram
360 integer(c_int) function clreleasememobject(ptr_d) &
361 bind(c, name =
'clReleaseMemObject')
362 use,
intrinsic :: iso_c_binding
364 type(c_ptr),
value :: ptr_d
365 end function clreleasememobject
369 integer(c_int) function clreleaseevent(event) &
370 bind(c, name =
'clReleaseEvent')
371 use,
intrinsic :: iso_c_binding
373 type(c_ptr),
value :: event
374 end function clreleaseevent
378 integer(c_int) function clflush(cmd_queue) &
379 bind(c, name =
'clFlush')
380 use,
intrinsic :: iso_c_binding
382 type(c_ptr),
value :: cmd_queue
387 integer(c_int) function clfinish(cmd_queue) &
388 bind(c, name =
'clFinish')
389 use,
intrinsic :: iso_c_binding
391 type(c_ptr),
value :: cmd_queue
392 end function clfinish
398 type(c_ptr),
target :: platform_id
399 integer(c_int) :: num_platforms, num_devices, ierr
400 integer(c_intptr_t) :: ctx_prop(3)
401 integer(c_int64_t),
parameter :: queue_props = 0
404 if (clgetplatformids(1, c_loc(platform_id), &
406 call neko_error(
'Failed to get a platform id')
410 c_loc(glb_device_id), num_devices) .ne.
cl_success)
then
411 call neko_error(
'Failed to get a device id')
414 if (c_associated(glb_ctx))
then
415 if (clreleasecontext(glb_ctx) .ne.
cl_success)
then
416 call neko_error(
'Failed to release context')
420 glb_ctx = clcreatecontext(c_null_ptr, num_devices, c_loc(glb_device_id), &
421 c_null_funptr, c_null_ptr, ierr)
424 call neko_error(
'Failed to create an OpenCL context')
427 if (c_associated(glb_cmd_queue))
then
428 if (clreleasecommandqueue(glb_cmd_queue) .ne.
cl_success)
then
429 call neko_error(
'Faield to release command queue')
433 glb_cmd_queue = clcreatecommandqueue(glb_ctx, glb_device_id, queue_props, &
437 call neko_error(
'Failed to create a command queue')
444 if (c_associated(glb_ctx))
then
445 if (clreleasecontext(glb_ctx) .ne.
cl_success)
then
446 call neko_error(
'Failed to release context')
451 if (c_associated(glb_cmd_queue))
then
452 if (clreleasecommandqueue(glb_cmd_queue) .ne.
cl_success)
then
453 call neko_error(
'Faield to release command queue')
455 glb_cmd_queue = c_null_ptr
458 if (c_associated(glb_device_id))
then
459 if (clreleasedevice(glb_device_id) .ne.
cl_success)
then
460 call neko_error(
'Faield to release device')
467 character(len=*),
intent(inout) :: name
468 character(kind=c_char, len=1024),
target :: c_name
469 integer(c_size_t),
target :: name_len
471 if (clgetdeviceinfo(glb_device_id,
cl_device_name, int(1024, i8), &
472 c_loc(c_name), c_loc(name_len)) .ne.
cl_success)
then
473 call neko_error(
'Failed to query device')
476 name(1:name_len) = c_name(1:name_len)
482 type(c_ptr),
target :: platform_id
483 integer(c_int) :: num_platforms, num_devices
485 if (clgetplatformids(1, c_loc(platform_id), &
487 call neko_error(
'Failed to get a platform id')
491 c_null_ptr, num_devices) .ne.
cl_success)
then
492 call neko_error(
'Failed to get a device id')
Device abstraction, common interface for various accelerators.
integer, parameter, public i8
Fortran OpenCL interface.
integer(c_int64_t), parameter cl_device_type_default
Device types.
subroutine opencl_device_name(name)
integer(c_int64_t), parameter cl_device_type_gpu
type(c_ptr), bind(C) aux_cmd_queue
Aux OpenCL command queue.
integer function opencl_device_count()
Return the number of OpenCL devices.
subroutine opencl_finalize
integer(c_int64_t), parameter cl_device_type_cpu
@ cl_image_format_mismatch
@ cl_image_format_not_supported
@ cl_device_not_available
@ cl_compiler_not_available
@ cl_mem_object_allocation_failure
@ cl_build_program_failure
@ cl_profiling_info_not_available
integer(c_int64_t), parameter cl_device_type_custom
integer(c_int64_t), parameter cl_device_type_all
integer(c_int64_t), parameter cl_device_type_accelerator