Loading [MathJax]/extensions/tex2jax.js
Neko 0.9.99
A portable framework for high-order spectral element flow simulations
All Classes Namespaces Files Functions Variables Typedefs Enumerator Macros Pages
opencl_intf.F90
Go to the documentation of this file.
1! Copyright (c) 2021-2023, 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) &
111 bind(c, name = 'clGetPlatformIDs')
112 use, intrinsic :: iso_c_binding
113 implicit none
114 integer(c_int), value :: num_entries
115 type(c_ptr), value :: platforms
116 integer(c_int) :: num_platforms
117 end function clgetplatformids
118 end interface
119
120 interface
121 integer(c_int) function clgetdeviceids(platform, device_type, &
122 num_entries, devices, num_devices) &
123 bind(c, name = 'clGetDeviceIDs')
124 use, intrinsic :: iso_c_binding
125 implicit none
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
131 end function clgetdeviceids
132 end interface
133
134 interface
135 type (c_ptr) function clcreatecontext(properties, num_devices, devices, &
136 pfn_notify, user_data, ierr) &
137 bind(c, name = 'clCreateContext')
138 use, intrinsic :: iso_c_binding
139 implicit none
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
146 end function clcreatecontext
147 end interface
148
149 interface
150 type(c_ptr) function clcreatecommandqueue(context, device, &
151 properties, ierr) &
152 bind(c, name = 'clCreateCommandQueue')
153 use, intrinsic :: iso_c_binding
154 implicit none
155 type(c_ptr), value :: context
156 type(c_ptr), value :: device
157 integer(c_int64_t), value :: properties
158 integer(c_int) :: ierr
159 end function clcreatecommandqueue
160 end interface
161
162 interface
163 type(c_ptr) function clcreatebuffer(context, flags, size, host_ptr, ierr) &
164 bind(c, name = 'clCreateBuffer')
165 use, intrinsic :: iso_c_binding
166 implicit none
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
172 end function clcreatebuffer
173 end interface
174
175 interface
176 type(c_ptr) function clcreateuserevent(context, ierr) &
177 bind(c, name = 'clCreateUserEvent')
178 use, intrinsic :: iso_c_binding
179 implicit none
180 type(c_ptr), value :: context
181 integer(c_int) :: ierr
182 end function clcreateuserevent
183 end interface
184
185 interface
186 integer(c_int) function clenqueuereadbuffer(queue, buffer, blocking_read, &
187 offset, size, ptr, &
188 num_events_in_wait_list, &
189 event_wait_list, event) &
190 bind(c, name = 'clEnqueueReadBuffer')
191 use, intrinsic :: iso_c_binding
192 implicit none
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
203 end interface
204
205 interface
206 integer(c_int) function clenqueuewritebuffer(queue, buffer, &
207 blocking_write, offset, &
208 size, ptr, &
209 num_events_in_wait_list, &
210 event_wait_list, event) &
211 bind(c, name = 'clEnqueueWriteBuffer')
212 use, intrinsic :: iso_c_binding
213 implicit none
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
223 end function clenqueuewritebuffer
224 end interface
225
226 interface
227 integer(c_int) function clenqueuecopybuffer(queue, src_buffer, &
228 dst_buffer, src_offset, &
229 dst_offset, size, &
230 num_events_in_wait_list, &
231 event_wait_list, event) &
232 bind(c, name = 'clEnqueueCopyBuffer')
233 use, intrinsic :: iso_c_binding
234 implicit none
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
244 end function clenqueuecopybuffer
245 end interface
246
247 interface
248 integer(c_int) function clenqueuemarkerwithwaitlist &
249 (queue, num_events_in_wait_list, event_wait_list, event) &
250 bind(c, name = 'clEnqueueMarkerWithWaitList')
251 use, intrinsic :: iso_c_binding
252 implicit none
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
257 end function clenqueuemarkerwithwaitlist
258 end interface
259
260 interface
261 integer(c_int) function clenqueuemarker(cmd_queue, event) &
262 bind(c, name = 'clEnqueueMarker')
263 use, intrinsic :: iso_c_binding
264 implicit none
265 type(c_ptr), value :: cmd_queue
266 type(c_ptr), value :: event
267 end function clenqueuemarker
268 end interface
269
270 interface
271 integer(c_int) function clenqueuebarrier(cmd_queue) &
272 bind(c, name = 'clEnqueueBarrier')
273 use, intrinsic :: iso_c_binding
274 implicit none
275 type(c_ptr), value :: cmd_queue
276 end function clenqueuebarrier
277 end interface
278
279 interface
280 integer(c_int) function clenqueuewaitforevents(queue, &
281 num_events, event_list) &
282 bind(c, name = 'clEnqueueWaitForEvents')
283 use, intrinsic :: iso_c_binding
284 implicit none
285 type(c_ptr), value :: queue
286 integer(c_int), value :: num_events
287 type(c_ptr), value :: event_list
288 end function clenqueuewaitforevents
289 end interface
290
291 interface
292 integer(c_int) function clwaitforevents(num_events, event_list) &
293 bind(c, name = 'clWaitForEvents')
294 use, intrinsic :: iso_c_binding
295 implicit none
296 integer(c_int), value :: num_events
297 type(c_ptr), value :: event_list
298 end function clwaitforevents
299 end interface
300
301 interface
302 integer(c_int) function clsetusereventstatus(event, status) &
303 bind(c, name = 'clSetUserEventStatus')
304 use, intrinsic :: iso_c_binding
305 implicit none
306 type(c_ptr), value :: event
307 integer(c_int), value :: status
308 end function clsetusereventstatus
309 end interface
310
311 interface
312 integer(c_int) function clgetdeviceinfo(device, param_name, &
313 param_value_size, param_value, &
314 param_value_size_ret) &
315 bind(c, name = 'clGetDeviceInfo')
316 use, intrinsic :: iso_c_binding
317 implicit none
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
323 end function clgetdeviceinfo
324 end interface
325
326 interface
327 integer(c_int) function clreleasecontext(context) &
328 bind(c, name = 'clReleaseContext')
329 use, intrinsic :: iso_c_binding
330 implicit none
331 type(c_ptr), value :: context
332 end function clreleasecontext
333 end interface
334
335 interface
336 integer(c_int) function clreleasecommandqueue(queue) &
337 bind(c, name = 'clReleaseCommandQueue')
338 use, intrinsic :: iso_c_binding
339 implicit none
340 type(c_ptr), value :: queue
341 end function clreleasecommandqueue
342 end interface
343
344 interface
345 integer(c_int) function clreleasedevice(device) &
346 bind(c, name = 'clReleaseDevice')
347 use, intrinsic :: iso_c_binding
348 implicit none
349 type(c_ptr), value :: device
350 end function clreleasedevice
351 end interface
352
353 interface
354 integer(c_int) function clreleaseprogram(prgm) &
355 bind(c, name = 'clReleaseProgram')
356 use, intrinsic :: iso_c_binding
357 implicit none
358 type(c_ptr), value :: prgm
359 end function clreleaseprogram
360 end interface
361
362 interface
363 integer(c_int) function clreleasememobject(ptr_d) &
364 bind(c, name = 'clReleaseMemObject')
365 use, intrinsic :: iso_c_binding
366 implicit none
367 type(c_ptr), value :: ptr_d
368 end function clreleasememobject
369 end interface
370
371 interface
372 integer(c_int) function clreleaseevent(event) &
373 bind(c, name = 'clReleaseEvent')
374 use, intrinsic :: iso_c_binding
375 implicit none
376 type(c_ptr), value :: event
377 end function clreleaseevent
378 end interface
379
380 interface
381 integer(c_int) function clflush(cmd_queue) &
382 bind(c, name = 'clFlush')
383 use, intrinsic :: iso_c_binding
384 implicit none
385 type(c_ptr), value :: cmd_queue
386 end function clflush
387 end interface
388
389 interface
390 integer(c_int) function clfinish(cmd_queue) &
391 bind(c, name = 'clFinish')
392 use, intrinsic :: iso_c_binding
393 implicit none
394 type(c_ptr), value :: cmd_queue
395 end function clfinish
396 end interface
397
398contains
399
400 subroutine opencl_init(glb_cmd_queue, aux_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
407 integer :: i
408
409 if (clgetplatformids(1, c_loc(platform_id), &
410 num_platforms) .ne. cl_success) then
411 call neko_error('Failed to get a platform id')
412 end if
413
414 if (clgetdeviceids(platform_id, cl_device_type_gpu, 1, &
415 c_loc(glb_device_id), num_devices) .ne. cl_success) then
416 call neko_error('Failed to get a device id')
417 end if
418
419 if (c_associated(glb_ctx)) then
420 if (clreleasecontext(glb_ctx) .ne. cl_success) then
421 call neko_error('Failed to release context')
422 end if
423 end if
424
425 glb_ctx = clcreatecontext(c_null_ptr, num_devices, c_loc(glb_device_id), &
426 c_null_funptr, c_null_ptr, ierr)
427
428 if (ierr .ne. cl_success) then
429 call neko_error('Failed to create an OpenCL context')
430 end if
431
432 if (c_associated(glb_cmd_queue)) then
433 if (clreleasecommandqueue(glb_cmd_queue) .ne. cl_success) then
434 call neko_error('Faield to release command queue')
435 end if
436 end if
437
438 glb_cmd_queue = clcreatecommandqueue(glb_ctx, glb_device_id, queue_props, &
439 ierr)
440 if (ierr .ne. cl_success) then
441 call neko_error('Failed to create a command queue')
442 end if
443
444 aux_cmd_queue = clcreatecommandqueue(glb_ctx, glb_device_id, queue_props, &
445 ierr)
446 if (ierr .ne. cl_success) then
447 call neko_error('Failed to create a command queue')
448 end if
449
450 end subroutine opencl_init
451
452 subroutine opencl_finalize(glb_cmd_queue, aux_cmd_queue)
453 type(c_ptr), intent(inout) :: glb_cmd_queue
454 type(c_ptr), intent(inout) :: aux_cmd_queue
455
456 if (c_associated(glb_ctx)) then
457 if (clreleasecontext(glb_ctx) .ne. cl_success) then
458 call neko_error('Failed to release context')
459 end if
460 glb_ctx = c_null_ptr
461 end if
462
463 if (c_associated(glb_cmd_queue)) then
464 if (clreleasecommandqueue(glb_cmd_queue) .ne. cl_success) then
465 call neko_error('Failed to release command queue')
466 end if
467 glb_cmd_queue = c_null_ptr
468 end if
469
470 if (c_associated(aux_cmd_queue)) then
471 if (clreleasecommandqueue(aux_cmd_queue) .ne. cl_success) then
472 call neko_error('Failed to release command queue')
473 end if
474 aux_cmd_queue = c_null_ptr
475 end if
476
477 if (c_associated(glb_device_id)) then
478 if (clreleasedevice(glb_device_id) .ne. cl_success) then
479 call neko_error('Failed to release device')
480 end if
481 end if
482
483 end subroutine opencl_finalize
484
485 subroutine opencl_device_name(name)
486 character(len=*), intent(inout) :: name
487 character(kind=c_char, len=1024), target :: c_name
488 integer(c_size_t), target :: name_len
489
490 if (clgetdeviceinfo(glb_device_id, cl_device_name, int(1024, i8), &
491 c_loc(c_name), c_loc(name_len)) .ne. cl_success) then
492 call neko_error('Failed to query device')
493 end if
494
495 name(1:name_len) = c_name(1:name_len)
496
497 end subroutine opencl_device_name
498
500 integer function opencl_device_count()
501 type(c_ptr), target :: platform_id
502 integer(c_int) :: num_platforms, num_devices
503
504 if (clgetplatformids(1, c_loc(platform_id), &
505 num_platforms) .ne. cl_success) then
506 call neko_error('Failed to get a platform id')
507 end if
508
509 if (clgetdeviceids(platform_id, cl_device_type_gpu, 0, &
510 c_null_ptr, num_devices) .ne. cl_success) then
511 call neko_error('Failed to get a device id')
512 end if
513
514 opencl_device_count = num_devices
515
516 end function opencl_device_count
517#endif
518
519end module opencl_intf
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