Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
opencl_intf.F90
Go to the documentation of this file.
1! Copyright (c) 2021-2025, The Neko Authors
2! All rights reserved.
3!
4! Redistribution and use in source and binary forms, with or without
5! modification, are permitted provided that the following conditions
6! are met:
7!
8! * Redistributions of source code must retain the above copyright
9! notice, this list of conditions and the following disclaimer.
10!
11! * Redistributions in binary form must reproduce the above
12! copyright notice, this list of conditions and the following
13! disclaimer in the documentation and/or other materials provided
14! with the distribution.
15!
16! * Neither the name of the authors nor the names of its
17! contributors may be used to endorse or promote products derived
18! from this software without specific prior written permission.
19!
20! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31! POSSIBILITY OF SUCH DAMAGE.
32!
35 use num_types, only : i8
36 use utils, only : neko_error
37 use, intrinsic :: iso_c_binding
38 implicit none
39
40#ifdef HAVE_OPENCL
41
43 type(c_ptr), bind(c) :: glb_ctx = c_null_ptr
44
46 type(c_ptr), bind(c), target :: glb_device_id = c_null_ptr
47
49 enum, bind(c)
50 enumerator :: cl_success = 0
51 enumerator :: cl_device_not_found = -1
52 enumerator :: cl_device_not_available = -2
53 enumerator :: cl_compiler_not_available = -3
55 enumerator :: cl_out_of_resources = -5
56 enumerator :: cl_out_of_host_memory = -6
58 enumerator :: cl_mem_copy_overlap = -8
59 enumerator :: cl_image_format_mismatch = -9
61 enumerator :: cl_build_program_failure = -11
62 enumerator :: cl_map_failure = -12
63 end enum
64
66 enum, bind(c)
67 enumerator :: cl_mem_read_write = 1
68 enumerator :: cl_mem_write_only = 2
69 enumerator :: cl_mem_read_only = 4
70 enumerator :: cl_mem_use_host_ptr = 8
71 enumerator :: cl_mem_alloc_host_ptr = 16
72 enumerator :: cl_mem_host_write_only = 128
73 enumerator :: cl_mem_host_read_only = 256
74 enumerator :: cl_mem_host_no_access = 512
75 end enum
76
78 enum, bind(c)
79 enumerator :: cl_complete = 0
80 enumerator :: cl_running = 1
81 enumerator :: cl_submitted = 2
82 enumerator :: cl_queued = 3
83 end enum
84
86 enum, bind(c)
87 enumerator :: cl_false = 0
88 enumerator :: cl_true = 1
89 end enum
90
91 enum, bind(c)
92 enumerator :: cl_context_platform = int(z'1084')
93 end enum
94
96 enum, bind(c)
97 enumerator :: cl_device_name = 4139
98 end enum
99
101 integer(c_int64_t), parameter :: cl_device_type_default = 1
102 integer(c_int64_t), parameter :: cl_device_type_cpu = 2
103 integer(c_int64_t), parameter :: cl_device_type_gpu = 4
104 integer(c_int64_t), parameter :: cl_device_type_accelerator = 8
105 integer(c_int64_t), parameter :: cl_device_type_custom = 16
106 integer(c_int64_t), parameter :: cl_device_type_all = int(z'FFFFFFFF', i8)
107
108 interface
109 integer(c_int) function clgetplatformids(num_entries, platforms, &
110 num_platforms) bind(c, name = 'clGetPlatformIDs')
111 use, intrinsic :: iso_c_binding
112 implicit none
113 integer(c_int), value :: num_entries
114 type(c_ptr), value :: platforms
115 integer(c_int) :: num_platforms
116 end function clgetplatformids
117 end interface
118
119 interface
120 integer(c_int) function clgetdeviceids(platform, device_type, &
121 num_entries, devices, num_devices) bind(c, name = 'clGetDeviceIDs')
122 use, intrinsic :: iso_c_binding
123 implicit none
124 type(c_ptr), value :: platform
125 integer(c_int64_t), value :: device_type
126 integer(c_int), value :: num_entries
127 type(c_ptr), value :: devices
128 integer(c_int) :: num_devices
129 end function clgetdeviceids
130 end interface
131
132 interface
133 type (c_ptr) function clcreatecontext(properties, num_devices, devices, &
134 pfn_notify, user_data, ierr) bind(c, name = 'clCreateContext')
135 use, intrinsic :: iso_c_binding
136 implicit none
137 type(c_ptr), value :: properties
138 integer(c_int), value :: num_devices
139 type(c_ptr), value :: devices
140 type(c_funptr), value :: pfn_notify
141 type(c_ptr), value :: user_data
142 integer(c_int) :: ierr
143 end function clcreatecontext
144 end interface
145
146 interface
147 type(c_ptr) function clcreatecommandqueue(context, device, &
148 properties, ierr) bind(c, name = 'clCreateCommandQueue')
149 use, intrinsic :: iso_c_binding
150 implicit none
151 type(c_ptr), value :: context
152 type(c_ptr), value :: device
153 integer(c_int64_t), value :: properties
154 integer(c_int) :: ierr
155 end function clcreatecommandqueue
156 end interface
157
158 interface
159 type(c_ptr) function clcreatebuffer(context, flags, size, host_ptr, ierr) &
160 bind(c, name = 'clCreateBuffer')
161 use, intrinsic :: iso_c_binding
162 implicit none
163 type(c_ptr), value :: context
164 integer(c_int), value :: flags
165 integer(c_size_t), value :: size
166 type(c_ptr), value :: host_ptr
167 integer(c_int) :: ierr
168 end function clcreatebuffer
169 end interface
170
171 interface
172 type(c_ptr) function clcreateuserevent(context, ierr) &
173 bind(c, name = 'clCreateUserEvent')
174 use, intrinsic :: iso_c_binding
175 implicit none
176 type(c_ptr), value :: context
177 integer(c_int) :: ierr
178 end function clcreateuserevent
179 end interface
180
181 interface
182 integer(c_int) function clenqueuereadbuffer(queue, buffer, blocking_read, &
183 offset, size, ptr, num_events_in_wait_list, event_wait_list, event) &
184 bind(c, name = 'clEnqueueReadBuffer')
185 use, intrinsic :: iso_c_binding
186 implicit none
187 type(c_ptr), value :: queue
188 type(c_ptr), value :: buffer
189 integer(c_int), value :: blocking_read
190 integer(c_size_t), value :: offset
191 integer(c_size_t), value :: size
192 type(c_ptr), value :: ptr
193 integer(c_int), value :: num_events_in_wait_list
194 type(c_ptr), value :: event_wait_list
195 type(c_ptr), value :: event
196 end function clenqueuereadbuffer
197 end interface
198
199 interface
200 integer(c_int) function clenqueuewritebuffer(queue, buffer, &
201 blocking_write, offset, size, ptr, num_events_in_wait_list, &
202 event_wait_list, event) bind(c, name = 'clEnqueueWriteBuffer')
203 use, intrinsic :: iso_c_binding
204 implicit none
205 type(c_ptr), value :: queue
206 type(c_ptr), value :: buffer
207 integer(c_int), value :: blocking_write
208 integer(c_size_t), value :: offset
209 integer(c_size_t), value :: size
210 type(c_ptr), value :: ptr
211 integer(c_int), value :: num_events_in_wait_list
212 type(c_ptr), value :: event_wait_list
213 type(c_ptr), value :: event
214 end function clenqueuewritebuffer
215 end interface
216
217 interface
218 integer(c_int) function clenqueuecopybuffer(queue, src_buffer, &
219 dst_buffer, src_offset, dst_offset, size, num_events_in_wait_list, &
220 event_wait_list, event) bind(c, name = 'clEnqueueCopyBuffer')
221 use, intrinsic :: iso_c_binding
222 implicit none
223 type(c_ptr), value :: queue
224 type(c_ptr), value :: src_buffer
225 type(c_ptr), value :: dst_buffer
226 integer(c_size_t), value :: src_offset
227 integer(c_size_t), value :: dst_offset
228 integer(c_size_t), value :: size
229 integer(c_int), value :: num_events_in_wait_list
230 type(c_ptr), value :: event_wait_list
231 type(c_ptr), value :: event
232 end function clenqueuecopybuffer
233 end interface
234
235 interface
236 integer(c_int) function clenqueuefillbuffer(queue, buffer, &
237 pattern, pattern_size, offset, size, num_events_in_wait_list, &
238 event_wait_list, event) bind(c, name = 'clEnqueueFillBuffer')
239 use, intrinsic :: iso_c_binding
240 implicit none
241 type(c_ptr), value :: queue
242 type(c_ptr), value :: buffer
243 type(c_ptr), value :: pattern
244 integer(c_size_t), value :: pattern_size
245 integer(c_size_t), value :: 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 clenqueuefillbuffer
251 end interface
252
253 interface
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
258 implicit none
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
264 end interface
265
266 interface
267 integer(c_int) function clenqueuemarker(cmd_queue, event) &
268 bind(c, name = 'clEnqueueMarker')
269 use, intrinsic :: iso_c_binding
270 implicit none
271 type(c_ptr), value :: cmd_queue
272 type(c_ptr), value :: event
273 end function clenqueuemarker
274 end interface
275
276 interface
277 integer(c_int) function clenqueuebarrier(cmd_queue) &
278 bind(c, name = 'clEnqueueBarrier')
279 use, intrinsic :: iso_c_binding
280 implicit none
281 type(c_ptr), value :: cmd_queue
282 end function clenqueuebarrier
283 end interface
284
285 interface
286 integer(c_int) function clenqueuewaitforevents(queue, &
287 num_events, event_list) bind(c, name = 'clEnqueueWaitForEvents')
288 use, intrinsic :: iso_c_binding
289 implicit none
290 type(c_ptr), value :: queue
291 integer(c_int), value :: num_events
292 type(c_ptr), value :: event_list
293 end function clenqueuewaitforevents
294 end interface
295
296 interface
297 integer(c_int) function clwaitforevents(num_events, event_list) &
298 bind(c, name = 'clWaitForEvents')
299 use, intrinsic :: iso_c_binding
300 implicit none
301 integer(c_int), value :: num_events
302 type(c_ptr), value :: event_list
303 end function clwaitforevents
304 end interface
305
306 interface
307 integer(c_int) function clsetusereventstatus(event, status) &
308 bind(c, name = 'clSetUserEventStatus')
309 use, intrinsic :: iso_c_binding
310 implicit none
311 type(c_ptr), value :: event
312 integer(c_int), value :: status
313 end function clsetusereventstatus
314 end interface
315
316 interface
317 integer(c_int) function clgetdeviceinfo(device, param_name, &
318 param_value_size, param_value, param_value_size_ret) &
319 bind(c, name = 'clGetDeviceInfo')
320 use, intrinsic :: iso_c_binding
321 implicit none
322 type(c_ptr), value :: device
323 integer(c_int), value :: param_name
324 integer(c_size_t), value :: param_value_size
325 type(c_ptr), value :: param_value
326 type(c_ptr), value :: param_value_size_ret
327 end function clgetdeviceinfo
328 end interface
329
330 interface
331 integer(c_int) function clreleasecontext(context) &
332 bind(c, name = 'clReleaseContext')
333 use, intrinsic :: iso_c_binding
334 implicit none
335 type(c_ptr), value :: context
336 end function clreleasecontext
337 end interface
338
339 interface
340 integer(c_int) function clreleasecommandqueue(queue) &
341 bind(c, name = 'clReleaseCommandQueue')
342 use, intrinsic :: iso_c_binding
343 implicit none
344 type(c_ptr), value :: queue
345 end function clreleasecommandqueue
346 end interface
347
348 interface
349 integer(c_int) function clreleasedevice(device) &
350 bind(c, name = 'clReleaseDevice')
351 use, intrinsic :: iso_c_binding
352 implicit none
353 type(c_ptr), value :: device
354 end function clreleasedevice
355 end interface
356
357 interface
358 integer(c_int) function clreleaseprogram(prgm) &
359 bind(c, name = 'clReleaseProgram')
360 use, intrinsic :: iso_c_binding
361 implicit none
362 type(c_ptr), value :: prgm
363 end function clreleaseprogram
364 end interface
365
366 interface
367 integer(c_int) function clreleasememobject(ptr_d) &
368 bind(c, name = 'clReleaseMemObject')
369 use, intrinsic :: iso_c_binding
370 implicit none
371 type(c_ptr), value :: ptr_d
372 end function clreleasememobject
373 end interface
374
375 interface
376 integer(c_int) function clreleaseevent(event) &
377 bind(c, name = 'clReleaseEvent')
378 use, intrinsic :: iso_c_binding
379 implicit none
380 type(c_ptr), value :: event
381 end function clreleaseevent
382 end interface
383
384 interface
385 integer(c_int) function clflush(cmd_queue) &
386 bind(c, name = 'clFlush')
387 use, intrinsic :: iso_c_binding
388 implicit none
389 type(c_ptr), value :: cmd_queue
390 end function clflush
391 end interface
392
393 interface
394 integer(c_int) function clfinish(cmd_queue) &
395 bind(c, name = 'clFinish')
396 use, intrinsic :: iso_c_binding
397 implicit none
398 type(c_ptr), value :: cmd_queue
399 end function clfinish
400 end interface
401
402contains
403
404 subroutine opencl_init(glb_cmd_queue, aux_cmd_queue)
405 type(c_ptr), intent(inout) :: glb_cmd_queue
406 type(c_ptr), intent(inout) :: aux_cmd_queue
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
411 integer :: i
412
413 if (clgetplatformids(1, c_loc(platform_id), &
414 num_platforms) .ne. cl_success) then
415 call neko_error('Failed to get a platform id')
416 end if
417
418 if (clgetdeviceids(platform_id, cl_device_type_gpu, 1, &
419 c_loc(glb_device_id), num_devices) .ne. cl_success) then
420 call neko_error('Failed to get a device id')
421 end if
422
423 if (c_associated(glb_ctx)) then
424 if (clreleasecontext(glb_ctx) .ne. cl_success) then
425 call neko_error('Failed to release context')
426 end if
427 end if
428
429 glb_ctx = clcreatecontext(c_null_ptr, num_devices, c_loc(glb_device_id), &
430 c_null_funptr, c_null_ptr, ierr)
431
432 if (ierr .ne. cl_success) then
433 call neko_error('Failed to create an OpenCL context')
434 end if
435
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')
439 end if
440 end if
441
442 glb_cmd_queue = clcreatecommandqueue(glb_ctx, glb_device_id, queue_props, &
443 ierr)
444 if (ierr .ne. cl_success) then
445 call neko_error('Failed to create a command queue')
446 end if
447
448 aux_cmd_queue = clcreatecommandqueue(glb_ctx, glb_device_id, queue_props, &
449 ierr)
450 if (ierr .ne. cl_success) then
451 call neko_error('Failed to create a command queue')
452 end if
453
454 end subroutine opencl_init
455
456 subroutine opencl_finalize(glb_cmd_queue, aux_cmd_queue)
457 type(c_ptr), intent(inout) :: glb_cmd_queue
458 type(c_ptr), intent(inout) :: aux_cmd_queue
459
460 if (c_associated(glb_ctx)) then
461 if (clreleasecontext(glb_ctx) .ne. cl_success) then
462 call neko_error('Failed to release context')
463 end if
464 glb_ctx = c_null_ptr
465 end if
466
467 if (c_associated(glb_cmd_queue)) then
468 if (clreleasecommandqueue(glb_cmd_queue) .ne. cl_success) then
469 call neko_error('Failed to release command queue')
470 end if
471 glb_cmd_queue = c_null_ptr
472 end if
473
474 if (c_associated(aux_cmd_queue)) then
475 if (clreleasecommandqueue(aux_cmd_queue) .ne. cl_success) then
476 call neko_error('Failed to release command queue')
477 end if
478 aux_cmd_queue = c_null_ptr
479 end if
480
481 if (c_associated(glb_device_id)) then
482 if (clreleasedevice(glb_device_id) .ne. cl_success) then
483 call neko_error('Failed to release device')
484 end if
485 end if
486
487 end subroutine opencl_finalize
488
489 subroutine opencl_device_name(name)
490 character(len=*), intent(inout) :: name
491 character(kind=c_char, len=1024), target :: c_name
492 integer(c_size_t), target :: name_len
493
494 if (clgetdeviceinfo(glb_device_id, cl_device_name, int(1024, i8), &
495 c_loc(c_name), c_loc(name_len)) .ne. cl_success) then
496 call neko_error('Failed to query device')
497 end if
498
499 name(1:name_len) = c_name(1:name_len)
500
501 end subroutine opencl_device_name
502
504 integer function opencl_device_count()
505 type(c_ptr), target :: platform_id
506 integer(c_int) :: num_platforms, num_devices
507
508 if (clgetplatformids(1, c_loc(platform_id), &
509 num_platforms) .ne. cl_success) then
510 call neko_error('Failed to get a platform id')
511 end if
512
513 if (clgetdeviceids(platform_id, cl_device_type_gpu, 0, &
514 c_null_ptr, num_devices) .ne. cl_success) then
515 call neko_error('Failed to get a device id')
516 end if
517
518 opencl_device_count = num_devices
519
520 end function opencl_device_count
521#endif
522
523end module opencl_intf
Generic buffer that is extended with buffers of varying rank.
Definition buffer.F90:34
Device abstraction, common interface for various accelerators.
Definition device.F90:34
integer, parameter, public i8
Definition num_types.f90:7
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
Utilities.
Definition utils.f90:35