37 use,
intrinsic :: iso_c_binding
43 type(c_ptr),
bind(c) :: glb_ctx = c_null_ptr
46 type(c_ptr),
bind(c),
target :: glb_device_id = c_null_ptr
111 bind(c, name =
'clGetPlatformIDs')
112 use,
intrinsic :: iso_c_binding
114 integer(c_int),
value :: num_entries
115 type(c_ptr),
value :: platforms
116 integer(c_int) :: num_platforms
122 num_entries, devices, num_devices) &
123 bind(c, name =
'clGetDeviceIDs')
124 use,
intrinsic :: iso_c_binding
126 type(c_ptr),
value :: platform
127 integer(c_int64_t),
value :: device_type
128 integer(c_int),
value :: num_entries
129 type(c_ptr),
value :: devices
130 integer(c_int) :: num_devices
136 pfn_notify, user_data, ierr) &
137 bind(c, name =
'clCreateContext')
138 use,
intrinsic :: iso_c_binding
140 type(c_ptr),
value :: properties
141 integer(c_int),
value :: num_devices
142 type(c_ptr),
value :: devices
143 type(c_funptr),
value :: pfn_notify
144 type(c_ptr),
value :: user_data
145 integer(c_int) :: ierr
152 bind(c, name =
'clCreateCommandQueue')
153 use,
intrinsic :: iso_c_binding
155 type(c_ptr),
value :: context
156 type(c_ptr),
value ::
device
157 integer(c_int64_t),
value :: properties
158 integer(c_int) :: ierr
164 bind(c, name =
'clCreateBuffer')
165 use,
intrinsic :: iso_c_binding
167 type(c_ptr),
value :: context
168 integer(c_int),
value :: flags
169 integer(c_size_t),
value :: size
170 type(c_ptr),
value :: host_ptr
171 integer(c_int) :: ierr
177 bind(c, name =
'clCreateUserEvent')
178 use,
intrinsic :: iso_c_binding
180 type(c_ptr),
value :: context
181 integer(c_int) :: ierr
188 num_events_in_wait_list, &
189 event_wait_list, event) &
190 bind(c, name =
'clEnqueueReadBuffer')
191 use,
intrinsic :: iso_c_binding
193 type(c_ptr),
value :: queue
194 type(c_ptr),
value :: buffer
195 integer(c_int),
value :: blocking_read
196 integer(c_size_t),
value :: offset
197 integer(c_size_t),
value :: size
198 type(c_ptr),
value :: ptr
199 integer(c_int),
value :: num_events_in_wait_list
200 type(c_ptr),
value :: event_wait_list
201 type(c_ptr),
value :: event
207 blocking_write, offset, &
209 num_events_in_wait_list, &
210 event_wait_list, event) &
211 bind(c, name =
'clEnqueueWriteBuffer')
212 use,
intrinsic :: iso_c_binding
214 type(c_ptr),
value :: queue
215 type(c_ptr),
value :: buffer
216 integer(c_int),
value :: blocking_write
217 integer(c_size_t),
value :: offset
218 integer(c_size_t),
value :: size
219 type(c_ptr),
value :: ptr
220 integer(c_int),
value :: num_events_in_wait_list
221 type(c_ptr),
value :: event_wait_list
222 type(c_ptr),
value :: event
228 dst_buffer, src_offset, &
230 num_events_in_wait_list, &
231 event_wait_list, event) &
232 bind(c, name =
'clEnqueueCopyBuffer')
233 use,
intrinsic :: iso_c_binding
235 type(c_ptr),
value :: queue
236 type(c_ptr),
value :: src_buffer
237 type(c_ptr),
value :: dst_buffer
238 integer(c_size_t),
value :: src_offset
239 integer(c_size_t),
value :: dst_offset
240 integer(c_size_t),
value :: size
241 integer(c_int),
value :: num_events_in_wait_list
242 type(c_ptr),
value :: event_wait_list
243 type(c_ptr),
value :: event
249 (queue, num_events_in_wait_list, event_wait_list, event) &
250 bind(c, name =
'clEnqueueMarkerWithWaitList')
251 use,
intrinsic :: iso_c_binding
253 type(c_ptr),
value :: queue
254 integer(c_int),
value :: num_events_in_wait_list
255 type(c_ptr),
value :: event_wait_list
256 type(c_ptr),
value :: event
262 bind(c, name =
'clEnqueueMarker')
263 use,
intrinsic :: iso_c_binding
265 type(c_ptr),
value :: cmd_queue
266 type(c_ptr),
value :: event
272 bind(c, name =
'clEnqueueBarrier')
273 use,
intrinsic :: iso_c_binding
275 type(c_ptr),
value :: cmd_queue
281 num_events, event_list) &
282 bind(c, name =
'clEnqueueWaitForEvents')
283 use,
intrinsic :: iso_c_binding
285 type(c_ptr),
value :: queue
286 integer(c_int),
value :: num_events
287 type(c_ptr),
value :: event_list
293 bind(c, name =
'clWaitForEvents')
294 use,
intrinsic :: iso_c_binding
296 integer(c_int),
value :: num_events
297 type(c_ptr),
value :: event_list
303 bind(c, name =
'clSetUserEventStatus')
304 use,
intrinsic :: iso_c_binding
306 type(c_ptr),
value :: event
307 integer(c_int),
value :: status
313 param_value_size, param_value, &
314 param_value_size_ret) &
315 bind(c, name =
'clGetDeviceInfo')
316 use,
intrinsic :: iso_c_binding
318 type(c_ptr),
value ::
device
319 integer(c_int),
value :: param_name
320 integer(c_size_t),
value :: param_value_size
321 type(c_ptr),
value :: param_value
322 type(c_ptr),
value :: param_value_size_ret
328 bind(c, name =
'clReleaseContext')
329 use,
intrinsic :: iso_c_binding
331 type(c_ptr),
value :: context
337 bind(c, name =
'clReleaseCommandQueue')
338 use,
intrinsic :: iso_c_binding
340 type(c_ptr),
value :: queue
346 bind(c, name =
'clReleaseDevice')
347 use,
intrinsic :: iso_c_binding
349 type(c_ptr),
value ::
device
355 bind(c, name =
'clReleaseProgram')
356 use,
intrinsic :: iso_c_binding
358 type(c_ptr),
value :: prgm
364 bind(c, name =
'clReleaseMemObject')
365 use,
intrinsic :: iso_c_binding
367 type(c_ptr),
value :: ptr_d
373 bind(c, name =
'clReleaseEvent')
374 use,
intrinsic :: iso_c_binding
376 type(c_ptr),
value :: event
382 bind(c, name =
'clFlush')
383 use,
intrinsic :: iso_c_binding
385 type(c_ptr),
value :: cmd_queue
391 bind(c, name =
'clFinish')
392 use,
intrinsic :: iso_c_binding
394 type(c_ptr),
value :: cmd_queue
401 type(c_ptr),
intent(inout) :: glb_cmd_queue
402 type(c_ptr),
intent(inout) :: aux_cmd_queue
403 type(c_ptr),
target :: platform_id
404 integer(c_int) :: num_platforms, num_devices, ierr
405 integer(c_intptr_t) :: ctx_prop(3)
406 integer(c_int64_t),
parameter :: queue_props = 0
411 call neko_error(
'Failed to get a platform id')
415 c_loc(glb_device_id), num_devices) .ne.
cl_success)
then
416 call neko_error(
'Failed to get a device id')
419 if (c_associated(glb_ctx))
then
421 call neko_error(
'Failed to release context')
425 glb_ctx =
clcreatecontext(c_null_ptr, num_devices, c_loc(glb_device_id), &
426 c_null_funptr, c_null_ptr, ierr)
429 call neko_error(
'Failed to create an OpenCL context')
432 if (c_associated(glb_cmd_queue))
then
434 call neko_error(
'Faield to release command queue')
441 call neko_error(
'Failed to create a command queue')
447 call neko_error(
'Failed to create a command queue')
453 type(c_ptr),
intent(inout) :: glb_cmd_queue
454 type(c_ptr),
intent(inout) :: aux_cmd_queue
456 if (c_associated(glb_ctx))
then
458 call neko_error(
'Failed to release context')
463 if (c_associated(glb_cmd_queue))
then
465 call neko_error(
'Failed to release command queue')
467 glb_cmd_queue = c_null_ptr
470 if (c_associated(aux_cmd_queue))
then
472 call neko_error(
'Failed to release command queue')
474 aux_cmd_queue = c_null_ptr
477 if (c_associated(glb_device_id))
then
479 call neko_error(
'Failed to release device')
486 character(len=*),
intent(inout) :: name
487 character(kind=c_char, len=1024),
target :: c_name
488 integer(c_size_t),
target :: name_len
491 c_loc(c_name), c_loc(name_len)) .ne.
cl_success)
then
492 call neko_error(
'Failed to query device')
495 name(1:name_len) = c_name(1:name_len)
501 type(c_ptr),
target :: platform_id
502 integer(c_int) :: num_platforms, num_devices
506 call neko_error(
'Failed to get a platform id')
510 c_null_ptr, num_devices) .ne.
cl_success)
then
511 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
integer function opencl_device_count()
Return the number of OpenCL devices.
subroutine opencl_finalize(glb_cmd_queue, aux_cmd_queue)
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
subroutine opencl_init(glb_cmd_queue, aux_cmd_queue)
integer(c_int64_t), parameter cl_device_type_all
integer(c_int64_t), parameter cl_device_type_accelerator