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 clenqueuebarrier(cmd_queue) &
278 bind(c, name =
'clEnqueueBarrier')
279 use,
intrinsic :: iso_c_binding
281 type(c_ptr),
value :: cmd_queue
282 end function clenqueuebarrier
286 integer(c_int) function clenqueuewaitforevents(queue, &
287 num_events, event_list) &
288 bind(c, name =
'clEnqueueWaitForEvents')
289 use,
intrinsic :: iso_c_binding
291 type(c_ptr),
value :: queue
292 integer(c_int),
value :: num_events
293 type(c_ptr),
value :: event_list
294 end function clenqueuewaitforevents
298 integer(c_int) function clwaitforevents(num_events, event_list) &
299 bind(c, name =
'clWaitForEvents')
300 use,
intrinsic :: iso_c_binding
302 integer(c_int),
value :: num_events
303 type(c_ptr),
value :: event_list
304 end function clwaitforevents
308 integer(c_int) function clsetusereventstatus(event, status) &
309 bind(c, name =
'clSetUserEventStatus')
310 use,
intrinsic :: iso_c_binding
312 type(c_ptr),
value :: event
313 integer(c_int),
value :: status
314 end function clsetusereventstatus
318 integer(c_int) function clgetdeviceinfo(device, param_name, &
319 param_value_size, param_value, &
320 param_value_size_ret) &
321 bind(c, name =
'clGetDeviceInfo')
322 use,
intrinsic :: iso_c_binding
324 type(c_ptr),
value ::
device
325 integer(c_int),
value :: param_name
326 integer(c_size_t),
value :: param_value_size
327 type(c_ptr),
value :: param_value
328 type(c_ptr),
value :: param_value_size_ret
329 end function clgetdeviceinfo
333 integer(c_int) function clreleasecontext(context) &
334 bind(c, name =
'clReleaseContext')
335 use,
intrinsic :: iso_c_binding
337 type(c_ptr),
value :: context
338 end function clreleasecontext
342 integer(c_int) function clreleasecommandqueue(queue) &
343 bind(c, name =
'clReleaseCommandQueue')
344 use,
intrinsic :: iso_c_binding
346 type(c_ptr),
value :: queue
347 end function clreleasecommandqueue
351 integer(c_int) function clreleasedevice(device) &
352 bind(c, name =
'clReleaseDevice')
353 use,
intrinsic :: iso_c_binding
355 type(c_ptr),
value ::
device
356 end function clreleasedevice
360 integer(c_int) function clreleaseprogram(prgm) &
361 bind(c, name =
'clReleaseProgram')
362 use,
intrinsic :: iso_c_binding
364 type(c_ptr),
value :: prgm
365 end function clreleaseprogram
369 integer(c_int) function clreleasememobject(ptr_d) &
370 bind(c, name =
'clReleaseMemObject')
371 use,
intrinsic :: iso_c_binding
373 type(c_ptr),
value :: ptr_d
374 end function clreleasememobject
378 integer(c_int) function clreleaseevent(event) &
379 bind(c, name =
'clReleaseEvent')
380 use,
intrinsic :: iso_c_binding
382 type(c_ptr),
value :: event
383 end function clreleaseevent
387 integer(c_int) function clflush(cmd_queue) &
388 bind(c, name =
'clFlush')
389 use,
intrinsic :: iso_c_binding
391 type(c_ptr),
value :: cmd_queue
396 integer(c_int) function clfinish(cmd_queue) &
397 bind(c, name =
'clFinish')
398 use,
intrinsic :: iso_c_binding
400 type(c_ptr),
value :: cmd_queue
401 end function clfinish
407 type(c_ptr),
target :: platform_id
408 integer(c_int) :: num_platforms, num_devices, ierr
409 integer(c_intptr_t) :: ctx_prop(3)
410 integer(c_int64_t),
parameter :: queue_props = 0
413 if (clgetplatformids(1, c_loc(platform_id), &
415 call neko_error(
'Failed to get a platform id')
419 c_loc(glb_device_id), num_devices) .ne.
cl_success)
then
420 call neko_error(
'Failed to get a device id')
423 if (c_associated(glb_ctx))
then
424 if (clreleasecontext(glb_ctx) .ne.
cl_success)
then
425 call neko_error(
'Failed to release context')
429 glb_ctx = clcreatecontext(c_null_ptr, num_devices, c_loc(glb_device_id), &
430 c_null_funptr, c_null_ptr, ierr)
433 call neko_error(
'Failed to create an OpenCL context')
436 if (c_associated(glb_cmd_queue))
then
437 if (clreleasecommandqueue(glb_cmd_queue) .ne.
cl_success)
then
438 call neko_error(
'Faield to release command queue')
442 glb_cmd_queue = clcreatecommandqueue(glb_ctx, glb_device_id, queue_props, &
445 call neko_error(
'Failed to create a command queue')
448 aux_cmd_queue = clcreatecommandqueue(glb_ctx, glb_device_id, queue_props, &
451 call neko_error(
'Failed to create a command queue')
461 if (c_associated(glb_ctx))
then
462 if (clreleasecontext(glb_ctx) .ne.
cl_success)
then
463 call neko_error(
'Failed to release context')
468 if (c_associated(glb_cmd_queue))
then
469 if (clreleasecommandqueue(glb_cmd_queue) .ne.
cl_success)
then
470 call neko_error(
'Faield to release command queue')
472 glb_cmd_queue = c_null_ptr
475 if (c_associated(glb_device_id))
then
476 if (clreleasedevice(glb_device_id) .ne.
cl_success)
then
477 call neko_error(
'Faield to release device')
484 character(len=*),
intent(inout) :: name
485 character(kind=c_char, len=1024),
target :: c_name
486 integer(c_size_t),
target :: name_len
488 if (clgetdeviceinfo(glb_device_id,
cl_device_name, int(1024, i8), &
489 c_loc(c_name), c_loc(name_len)) .ne.
cl_success)
then
490 call neko_error(
'Failed to query device')
493 name(1:name_len) = c_name(1:name_len)
499 type(c_ptr),
target :: platform_id
500 integer(c_int) :: num_platforms, num_devices
502 if (clgetplatformids(1, c_loc(platform_id), &
504 call neko_error(
'Failed to get a platform id')
508 c_null_ptr, num_devices) .ne.
cl_success)
then
509 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