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, &
116 platforms, num_platforms) bind(c, name='clGetPlatformIDs')
117 use,
intrinsic :: iso_c_binding
119 integer(c_int),
value :: num_entries
120 type(c_ptr),
value :: platforms
121 integer(c_int) :: num_platforms
122 end function clgetplatformids
126 integer (c_int) function clgetdeviceids(platform, device_type, &
127 num_entries, devices, num_devices) bind(c, name='clGetDeviceIDs')
128 use,
intrinsic :: iso_c_binding
130 type(c_ptr),
value :: platform
131 integer(c_int64_t),
value :: device_type
132 integer(c_int),
value :: num_entries
133 type(c_ptr),
value :: devices
134 integer(c_int) :: num_devices
135 end function clgetdeviceids
139 type (c_ptr) function clcreatecontext(properties, num_devices, &
140 devices, pfn_notify, user_data, ierr) bind(c, name=
'clCreateContext')
141 use,
intrinsic :: iso_c_binding
143 type(c_ptr),
value :: properties
144 integer(c_int),
value :: num_devices
145 type(c_ptr),
value :: devices
146 type(c_funptr),
value :: pfn_notify
147 type(c_ptr),
value :: user_data
148 integer(c_int) :: ierr
149 end function clcreatecontext
153 type(c_ptr) function clcreatecommandqueue(context,
device, &
154 properties, ierr) bind(c, name=
'clCreateCommandQueue')
155 use,
intrinsic :: iso_c_binding
157 type(c_ptr),
value :: context
158 type(c_ptr),
value ::
device
159 integer(c_int64_t),
value :: properties
160 integer(c_int) :: ierr
161 end function clcreatecommandqueue
165 type(c_ptr) function clcreatebuffer(context, flags, size, host_ptr, ierr) &
166 bind(c, name=
'clCreateBuffer')
167 use,
intrinsic :: iso_c_binding
169 type(c_ptr),
value :: context
170 integer(c_int),
value :: flags
171 integer(c_size_t),
value :: size
172 type(c_ptr),
value :: host_ptr
173 integer(c_int) :: ierr
174 end function clcreatebuffer
178 type(c_ptr) function clcreateuserevent(context, ierr) &
179 bind(c, name=
'clCreateUserEvent')
180 use,
intrinsic :: iso_c_binding
182 type(c_ptr),
value :: context
183 integer(c_int) :: ierr
184 end function clcreateuserevent
188 integer (c_int) function clenqueuereadbuffer(queue, buffer, &
189 blocking_read, offset, size, ptr, num_events_in_wait_list, &
190 event_wait_list, event) 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
202 end function clenqueuereadbuffer
206 integer (c_int) function clenqueuewritebuffer(queue, buffer, &
207 blocking_write, offset, size, ptr, num_events_in_wait_list, &
208 event_wait_list, event) bind(c, name='clEnqueueWriteBuffer')
209 use,
intrinsic :: iso_c_binding
211 type(c_ptr),
value :: queue
212 type(c_ptr),
value :: buffer
213 integer(c_int),
value :: blocking_write
214 integer(c_size_t),
value :: offset
215 integer(c_size_t),
value :: size
216 type(c_ptr),
value :: ptr
217 integer(c_int),
value :: num_events_in_wait_list
218 type(c_ptr),
value :: event_wait_list
219 type(c_ptr),
value :: event
220 end function clenqueuewritebuffer
224 integer (c_int) function clenqueuecopybuffer(queue, src_buffer, &
225 dst_buffer, src_offset, dst_offset, size, num_events_in_wait_list, &
226 event_wait_list, event) bind(c, name='clEnqueueCopyBuffer')
227 use,
intrinsic :: iso_c_binding
229 type(c_ptr),
value :: queue
230 type(c_ptr),
value :: src_buffer
231 type(c_ptr),
value :: dst_buffer
232 integer(c_size_t),
value :: src_offset
233 integer(c_size_t),
value :: dst_offset
234 integer(c_size_t),
value :: size
235 integer(c_int),
value :: num_events_in_wait_list
236 type(c_ptr),
value :: event_wait_list
237 type(c_ptr),
value :: event
238 end function clenqueuecopybuffer
242 integer (c_int) function clenqueuemarkerwithwaitlist(queue,&
243 num_events_in_wait_list, event_wait_list, event) &
244 bind(c, name=
'clEnqueueMarkerWithWaitList')
245 use,
intrinsic :: iso_c_binding
247 type(c_ptr),
value :: queue
248 integer(c_int),
value :: num_events_in_wait_list
249 type(c_ptr),
value :: event_wait_list
250 type(c_ptr),
value :: event
251 end function clenqueuemarkerwithwaitlist
255 integer (c_int) function clenqueuemarker(cmd_queue, event) &
256 bind(c, name=
'clEnqueueMarker')
257 use,
intrinsic :: iso_c_binding
259 type(c_ptr),
value :: cmd_queue
260 type(c_ptr),
value :: event
261 end function clenqueuemarker
265 integer (c_int) function clenqueuewaitforevents(queue, &
266 num_events, event_list) bind(c, name='clEnqueueWaitForEvents')
267 use,
intrinsic :: iso_c_binding
269 type(c_ptr),
value :: queue
270 integer(c_int),
value :: num_events
271 type(c_ptr),
value :: event_list
272 end function clenqueuewaitforevents
276 integer (c_int) function clwaitforevents(num_events, event_list) &
277 bind(c, name=
'clWaitForEvents')
278 use,
intrinsic :: iso_c_binding
280 integer(c_int),
value :: num_events
281 type(c_ptr),
value :: event_list
282 end function clwaitforevents
286 integer (c_int) function clsetusereventstatus(event, status) &
287 bind(c, name=
'clSetUserEventStatus')
288 use,
intrinsic :: iso_c_binding
290 type(c_ptr),
value :: event
291 integer(c_int),
value :: status
292 end function clsetusereventstatus
296 integer (c_int) function clgetdeviceinfo(device, param_name, &
297 param_value_size, param_value, param_value_size_ret) &
298 bind(c, name=
'clGetDeviceInfo')
299 use,
intrinsic :: iso_c_binding
301 type(c_ptr),
value ::
device
302 integer(c_int),
value :: param_name
303 integer(c_size_t),
value :: param_value_size
304 type(c_ptr),
value :: param_value
305 type(c_ptr),
value :: param_value_size_ret
306 end function clgetdeviceinfo
310 integer (c_int) function clreleasecontext(context) &
311 bind(c, name=
'clReleaseContext')
312 use,
intrinsic :: iso_c_binding
314 type(c_ptr),
value :: context
315 end function clreleasecontext
319 integer (c_int) function clreleasecommandqueue(queue) &
320 bind(c, name=
'clReleaseCommandQueue')
321 use,
intrinsic :: iso_c_binding
323 type(c_ptr),
value :: queue
324 end function clreleasecommandqueue
328 integer (c_int) function clreleasedevice(device) &
329 bind(c, name=
'clReleaseDevice')
330 use,
intrinsic :: iso_c_binding
332 type(c_ptr),
value ::
device
333 end function clreleasedevice
337 integer (c_int) function clreleaseprogram(prgm) &
338 bind(c, name=
'clReleaseProgram')
339 use,
intrinsic :: iso_c_binding
341 type(c_ptr),
value :: prgm
342 end function clreleaseprogram
346 integer (c_int) function clreleasememobject(ptr_d) &
347 bind(c, name=
'clReleaseMemObject')
348 use,
intrinsic :: iso_c_binding
350 type(c_ptr),
value :: ptr_d
351 end function clreleasememobject
355 integer (c_int) function clreleaseevent(event) &
356 bind(c, name=
'clReleaseEvent')
357 use,
intrinsic :: iso_c_binding
359 type(c_ptr),
value :: event
360 end function clreleaseevent
364 integer (c_int) function clflush(cmd_queue) &
365 bind(c, name=
'clFlush')
366 use,
intrinsic :: iso_c_binding
368 type(c_ptr),
value :: cmd_queue
373 integer (c_int) function clfinish(cmd_queue) &
374 bind(c, name=
'clFinish')
375 use,
intrinsic :: iso_c_binding
377 type(c_ptr),
value :: cmd_queue
378 end function clfinish
384 type(c_ptr),
target :: platform_id
385 integer(c_int) :: num_platforms, num_devices, ierr
386 integer(c_intptr_t) :: ctx_prop(3)
387 integer(c_int64_t),
parameter :: queue_props = 0
390 if (clgetplatformids(1, c_loc(platform_id), &
392 call neko_error(
'Failed to get a platform id')
396 c_loc(glb_device_id), num_devices) .ne.
cl_success)
then
397 call neko_error(
'Failed to get a device id')
400 if (c_associated(glb_ctx))
then
401 if (clreleasecontext(glb_ctx) .ne.
cl_success)
then
402 call neko_error(
'Failed to release context')
406 glb_ctx = clcreatecontext(c_null_ptr, num_devices, c_loc(glb_device_id), &
407 c_null_funptr, c_null_ptr, ierr)
410 call neko_error(
'Failed to create an OpenCL context')
413 if (c_associated(glb_cmd_queue))
then
414 if (clreleasecommandqueue(glb_cmd_queue) .ne.
cl_success)
then
415 call neko_error(
'Faield to release command queue')
419 glb_cmd_queue = clcreatecommandqueue(glb_ctx, glb_device_id, queue_props, ierr)
422 call neko_error(
'Failed to create a command queue')
432 if (c_associated(glb_ctx))
then
433 if (clreleasecontext(glb_ctx) .ne.
cl_success)
then
434 call neko_error(
'Failed to release context')
439 if (c_associated(glb_cmd_queue))
then
440 if (clreleasecommandqueue(glb_cmd_queue) .ne.
cl_success)
then
441 call neko_error(
'Faield to release command queue')
443 glb_cmd_queue = c_null_ptr
446 if (c_associated(glb_device_id))
then
447 if (clreleasedevice(glb_device_id) .ne.
cl_success)
then
448 call neko_error(
'Faield to release device')
455 character(len=*),
intent(inout) :: name
456 character(kind=c_char, len=1024),
target :: c_name
457 integer(c_size_t),
target :: name_len
459 if (clgetdeviceinfo(glb_device_id,
cl_device_name, int(1024, i8), &
460 c_loc(c_name), c_loc(name_len)) .ne.
cl_success)
then
461 call neko_error(
'Failed to query device')
464 name(1:name_len) = c_name(1:name_len)
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.
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