Neko 1.99.9
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
device_math.F90
Go to the documentation of this file.
1! Copyright (c) 2021-2026, 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!
34 use, intrinsic :: iso_c_binding, only : c_ptr, c_int
35 use num_types, only : rp, xp, c_rp, c_xp
36 use utils, only : neko_error
38 use mpi_f08, only : mpi_sum, mpi_min, mpi_max, mpi_in_place, mpi_allreduce
39 use device, only : glb_cmd_queue
40 ! ========================================================================== !
41 ! Device math interfaces
42
43 use hip_math
44 use cuda_math
45 use opencl_math
46 use metal_math
47
48 implicit none
49 private
50
51 interface device_cadd
52 module procedure device_radd, device_iadd
53 end interface device_cadd
54
73
74contains
75
77 subroutine device_copy(a_d, b_d, n, strm)
78 type(c_ptr) :: a_d, b_d
79 integer :: n
80 type(c_ptr), optional :: strm
81 type(c_ptr) :: strm_
82
83 if (n .lt. 1) return
84
85 if (present(strm)) then
86 strm_ = strm
87 else
88 strm_ = glb_cmd_queue
89 end if
90
91#if HAVE_HIP
92 call hip_copy(a_d, b_d, n, strm_)
93#elif HAVE_CUDA
94 call cuda_copy(a_d, b_d, n, strm_)
95#elif HAVE_OPENCL
96 call opencl_copy(a_d, b_d, n, strm_)
97#elif HAVE_METAL
98 call metal_copy(a_d, b_d, n, strm_)
99#else
100 call neko_error('no device backend configured')
101#endif
102 end subroutine device_copy
103
106 subroutine device_masked_copy_0(a_d, b_d, mask_d, n, n_mask, strm)
107 type(c_ptr) :: a_d, b_d, mask_d
108 integer :: n, n_mask
109 type(c_ptr), optional :: strm
110 type(c_ptr) :: strm_
111
112 if (n .lt. 1 .or. n_mask .lt. 1) return
113
114 if (present(strm)) then
115 strm_ = strm
116 else
117 strm_ = glb_cmd_queue
118 end if
119
120#if HAVE_HIP
121 call hip_masked_copy_0(a_d, b_d, mask_d, n, n_mask, strm_)
122#elif HAVE_CUDA
123 call cuda_masked_copy_0(a_d, b_d, mask_d, n, n_mask, strm_)
124#elif HAVE_OPENCL
125 call opencl_masked_copy_0(a_d, b_d, mask_d, n, n_mask, strm_)
126#elif HAVE_METAL
127 call metal_masked_copy_0(a_d, b_d, mask_d, n, n_mask, strm_)
128#else
129 call neko_error('no device backend configured')
130#endif
131 end subroutine device_masked_copy_0
132
135 subroutine device_masked_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm)
136 type(c_ptr) :: a_d, b_d, mask_d
137 integer :: n, n_mask
138 type(c_ptr), optional :: strm
139 type(c_ptr) :: strm_
140
141 if (n .lt. 1 .or. n_mask .lt. 1) return
142
143 if (present(strm)) then
144 strm_ = strm
145 else
146 strm_ = glb_cmd_queue
147 end if
148
149#if HAVE_HIP
150 call hip_masked_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
151#elif HAVE_CUDA
152 call cuda_masked_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
153#elif HAVE_OPENCL
154 call opencl_masked_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
155#else
156 call neko_error('no device backend configured')
157#endif
158 end subroutine device_masked_copy_aligned
159
161 subroutine device_masked_gather_copy_0(a_d, b_d, mask_d, n, n_mask, strm)
162 type(c_ptr) :: a_d, b_d, mask_d
163 integer :: n, n_mask
164 type(c_ptr), optional :: strm
165 type(c_ptr) :: strm_
166
167 if (n .lt. 1 .or. n_mask .lt. 1) return
168
169 if (present(strm)) then
170 strm_ = strm
171 else
172 strm_ = glb_cmd_queue
173 end if
174
175#if HAVE_HIP
176 call hip_masked_gather_copy(a_d, b_d, mask_d, n, n_mask, strm_)
177#elif HAVE_CUDA
178 call cuda_masked_gather_copy(a_d, b_d, mask_d, n, n_mask, strm_)
179#elif HAVE_OPENCL
180 call opencl_masked_gather_copy(a_d, b_d, mask_d, n, n_mask, strm_)
181#elif HAVE_METAL
182 call metal_masked_gather_copy(a_d, b_d, mask_d, n, n_mask, strm_)
183#else
184 call neko_error('no device backend configured')
185#endif
186 end subroutine device_masked_gather_copy_0
187
189 subroutine device_face_masked_gather_copy_0(a_d, b_d, mask_d, facet_d, n1, &
190 n2, lx, ly, lz, n_mask, strm)
191 type(c_ptr) :: a_d, b_d, mask_d, facet_d
192 integer :: n1, n2, lx, ly, lz, n_mask
193 type(c_ptr), optional :: strm
194 type(c_ptr) :: strm_
195
196 if (n_mask .lt. 1) return
197
198 if (present(strm)) then
199 strm_ = strm
200 else
201 strm_ = glb_cmd_queue
202 end if
203
204#if HAVE_HIP
205 call hip_face_masked_gather_copy(a_d, b_d, mask_d, facet_d, n1, n2, lx, &
206 ly, lz, n_mask, strm_)
207#elif HAVE_CUDA
208 call cuda_face_masked_gather_copy(a_d, b_d, mask_d, facet_d, n1, n2, lx, &
209 ly, lz, n_mask, strm_)
210#elif HAVE_OPENCL
211 call opencl_face_masked_gather_copy(a_d, b_d, mask_d, facet_d, n1, n2, &
212 lx, ly, lz, n_mask, strm_)
213#elif HAVE_METAL
214 call metal_face_masked_gather_copy(a_d, b_d, mask_d, facet_d, n1, n2, &
215 lx, ly, lz, n_mask, strm_)
216#else
217 call neko_error('no device backend configured')
218#endif
220
222 ! In this case, the mask comes from a mask_t type
223 subroutine device_masked_gather_copy_aligned(a_d, b_d, mask_d, n, &
224 n_mask, strm)
225 type(c_ptr) :: a_d, b_d, mask_d
226 integer :: n, n_mask
227 type(c_ptr), optional :: strm
228 type(c_ptr) :: strm_
229
230 if (n .lt. 1 .or. n_mask .lt. 1) return
231
232 if (present(strm)) then
233 strm_ = strm
234 else
235 strm_ = glb_cmd_queue
236 end if
237
238#if HAVE_HIP
239 call hip_masked_gather_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
240#elif HAVE_CUDA
241 call cuda_masked_gather_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
242#elif HAVE_OPENCL
243 call opencl_masked_gather_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
244#elif HAVE_METAL
245 call metal_masked_gather_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
246#else
247 call neko_error('no device backend configured')
248#endif
250
252 subroutine device_masked_scatter_copy_0(a_d, b_d, mask_d, n, n_mask, strm)
253 type(c_ptr) :: a_d, b_d, mask_d
254 integer :: n, n_mask
255 type(c_ptr), optional :: strm
256 type(c_ptr) :: strm_
257
258 if (n .lt. 1 .or. n_mask .lt. 1) return
259
260 if (present(strm)) then
261 strm_ = strm
262 else
263 strm_ = glb_cmd_queue
264 end if
265
266#if HAVE_HIP
267 call hip_masked_scatter_copy(a_d, b_d, mask_d, n, n_mask, strm_)
268#elif HAVE_CUDA
269 call cuda_masked_scatter_copy(a_d, b_d, mask_d, n, n_mask, strm_)
270#elif HAVE_OPENCL
271 call opencl_masked_scatter_copy(a_d, b_d, mask_d, n, n_mask, strm_)
272#elif HAVE_METAL
273 call metal_masked_scatter_copy(a_d, b_d, mask_d, n, n_mask, strm_)
274#else
275 call neko_error('no device backend configured')
276#endif
277 end subroutine device_masked_scatter_copy_0
278
280 ! In this case, the mask comes from a mask_t type
281 subroutine device_masked_scatter_copy_aligned(a_d, b_d, mask_d, n, &
282 n_mask, strm)
283 type(c_ptr) :: a_d, b_d, mask_d
284 integer :: n, n_mask
285 type(c_ptr), optional :: strm
286 type(c_ptr) :: strm_
287
288 if (n .lt. 1 .or. n_mask .lt. 1) return
289
290 if (present(strm)) then
291 strm_ = strm
292 else
293 strm_ = glb_cmd_queue
294 end if
295
296#if HAVE_HIP
297 call hip_masked_scatter_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
298#elif HAVE_CUDA
299 call cuda_masked_scatter_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
300#elif HAVE_OPENCL
301 call opencl_masked_scatter_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
302#elif HAVE_METAL
303 call metal_masked_scatter_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm_)
304#else
305 call neko_error('no device backend configured')
306#endif
308
309 subroutine device_masked_atomic_reduction_0(a_d, b_d, mask_d, n, n_mask, strm)
310 type(c_ptr) :: a_d, b_d, mask_d
311 integer :: n, n_mask
312 type(c_ptr), optional :: strm
313 type(c_ptr) :: strm_
314
315 if (n .lt. 1 .or. n_mask .lt. 1) return
316
317 if (present(strm)) then
318 strm_ = strm
319 else
320 strm_ = glb_cmd_queue
321 end if
322
323#if HAVE_HIP
324 call hip_masked_atomic_reduction(a_d, b_d, mask_d, n, n_mask, strm_)
325#elif HAVE_CUDA
326 call cuda_masked_atomic_reduction(a_d, b_d, mask_d, n, n_mask, strm_)
327#elif HAVE_OPENCL
328 call neko_error('No OpenCL bcknd, masked atomic reduction')
329#elif HAVE_METAL
330 call metal_masked_atomic_reduction(a_d, b_d, mask_d, n, n_mask, strm_)
331#else
332 call neko_error('no device backend configured')
333#endif
335
338 subroutine device_cfill_mask(a_d, c, n, mask_d, n_mask, strm)
339 type(c_ptr) :: a_d
340 real(kind=rp), intent(in) :: c
341 integer :: n
342 type(c_ptr) :: mask_d
343 integer :: n_mask
344 type(c_ptr), optional :: strm
345 type(c_ptr) :: strm_
346
347 if (n .lt. 1 .or. n_mask .lt. 1) return
348
349 if (present(strm)) then
350 strm_ = strm
351 else
352 strm_ = glb_cmd_queue
353 end if
354
355#if HAVE_HIP
356 call hip_cfill_mask(a_d, c, n, mask_d, n_mask, strm_)
357#elif HAVE_CUDA
358 call cuda_cfill_mask(a_d, c, n, mask_d, n_mask, strm_)
359#elif HAVE_OPENCL
360 call opencl_cfill_mask(a_d, c, n, mask_d, n_mask, strm_)
361#elif HAVE_METAL
362 call metal_cfill_mask(a_d, c, n, mask_d, n_mask, strm_)
363#else
364 call neko_error('No device backend configured')
365#endif
366 end subroutine device_cfill_mask
367
369 subroutine device_rzero(a_d, n, strm)
370 type(c_ptr) :: a_d
371 integer :: n
372 type(c_ptr), optional :: strm
373 type(c_ptr) :: strm_
374
375 if (n .lt. 1) return
376
377 if (present(strm)) then
378 strm_ = strm
379 else
380 strm_ = glb_cmd_queue
381 end if
382
383#if HAVE_HIP
384 call hip_rzero(a_d, n, strm_)
385#elif HAVE_CUDA
386 call cuda_rzero(a_d, n, strm_)
387#elif HAVE_OPENCL
388 call opencl_rzero(a_d, n, strm_)
389#elif HAVE_METAL
390 call metal_rzero(a_d, n, strm_)
391#else
392 call neko_error('No device backend configured')
393#endif
394 end subroutine device_rzero
395
397 subroutine device_rone(a_d, n, strm)
398 type(c_ptr) :: a_d
399 integer :: n
400 type(c_ptr), optional :: strm
401 type(c_ptr) :: strm_
402 real(kind=rp), parameter :: one = 1.0_rp
403
404 if (n .lt. 1) return
405
406 if (present(strm)) then
407 strm_ = strm
408 else
409 strm_ = glb_cmd_queue
410 end if
411
412#if HAVE_HIP || HAVE_CUDA || HAVE_OPENCL || HAVE_METAL
413 call device_cfill(a_d, one, n, strm_)
414#else
415 call neko_error('No device backend configured')
416#endif
417 end subroutine device_rone
418
420 subroutine device_cmult(a_d, c, n, strm)
421 type(c_ptr) :: a_d
422 real(kind=rp), intent(in) :: c
423 integer :: n
424 type(c_ptr), optional :: strm
425 type(c_ptr) :: strm_
426
427 if (n .lt. 1) return
428
429 if (present(strm)) then
430 strm_ = strm
431 else
432 strm_ = glb_cmd_queue
433 end if
434
435#if HAVE_HIP
436 call hip_cmult(a_d, c, n, strm_)
437#elif HAVE_CUDA
438 call cuda_cmult(a_d, c, n, strm_)
439#elif HAVE_OPENCL
440 call opencl_cmult(a_d, c, n, strm_)
441#elif HAVE_METAL
442 call metal_cmult(a_d, c, n, strm_)
443#else
444 call neko_error('No device backend configured')
445#endif
446 end subroutine device_cmult
447
449 subroutine device_cmult2(a_d, b_d, c, n, strm)
450 type(c_ptr) :: a_d, b_d
451 real(kind=rp), intent(in) :: c
452 integer :: n
453 type(c_ptr), optional :: strm
454 type(c_ptr) :: strm_
455
456 if (n .lt. 1) return
457
458 if (present(strm)) then
459 strm_ = strm
460 else
461 strm_ = glb_cmd_queue
462 end if
463
464#if HAVE_HIP
465 call hip_cmult2(a_d, b_d, c, n, strm_)
466#elif HAVE_CUDA
467 call cuda_cmult2(a_d, b_d, c, n, strm_)
468#elif HAVE_OPENCL
469 call opencl_cmult2(a_d, b_d, c, n, strm_)
470#elif HAVE_METAL
471 call metal_cmult2(a_d, b_d, c, n, strm_)
472#else
473 call neko_error('No device backend configured')
474#endif
475 end subroutine device_cmult2
476
478 subroutine device_cdiv(a_d, c, n, strm)
479 type(c_ptr) :: a_d
480 real(kind=rp), intent(in) :: c
481 integer :: n
482 type(c_ptr), optional :: strm
483 type(c_ptr) :: strm_
484
485 if (present(strm)) then
486 strm_ = strm
487 else
488 strm_ = glb_cmd_queue
489 end if
490
491#if HAVE_HIP
492 call hip_cdiv(a_d, c, n, strm_)
493#elif HAVE_CUDA
494 call cuda_cdiv(a_d, c, n, strm_)
495#elif HAVE_OPENCL
496 call opencl_cdiv(a_d, c, n, strm_)
497#elif HAVE_METAL
498 call metal_cdiv(a_d, c, n, strm_)
499#else
500 call neko_error('No device backend configured')
501#endif
502 end subroutine device_cdiv
503
505 subroutine device_cdiv2(a_d, b_d, c, n, strm)
506 type(c_ptr) :: a_d, b_d
507 real(kind=rp), intent(in) :: c
508 integer :: n
509 type(c_ptr), optional :: strm
510 type(c_ptr) :: strm_
511
512 if (present(strm)) then
513 strm_ = strm
514 else
515 strm_ = glb_cmd_queue
516 end if
517
518#if HAVE_HIP
519 call hip_cdiv2(a_d, b_d, c, n, strm_)
520#elif HAVE_CUDA
521 call cuda_cdiv2(a_d, b_d, c, n, strm_)
522#elif HAVE_OPENCL
523 call opencl_cdiv2(a_d, b_d, c, n, strm_)
524#elif HAVE_METAL
525 call metal_cdiv2(a_d, b_d, c, n, strm_)
526#else
527 call neko_error('No device backend configured')
528#endif
529 end subroutine device_cdiv2
530
532 subroutine device_radd(a_d, c, n, strm)
533 type(c_ptr) :: a_d
534 real(kind=rp), intent(in) :: c
535 integer :: n
536 type(c_ptr), optional :: strm
537 type(c_ptr) :: strm_
538
539 if (n .lt. 1) return
540
541 if (present(strm)) then
542 strm_ = strm
543 else
544 strm_ = glb_cmd_queue
545 end if
546
547#if HAVE_HIP
548 call hip_radd(a_d, c, n, strm_)
549#elif HAVE_CUDA
550 call cuda_radd(a_d, c, n, strm_)
551#elif HAVE_OPENCL
552 call opencl_radd(a_d, c, n, strm_)
553#elif HAVE_METAL
554 call metal_radd(a_d, c, n, strm_)
555#else
556 call neko_error('No device backend configured')
557#endif
558 end subroutine device_radd
559
561 subroutine device_cadd2(a_d, b_d, c, n, strm)
562 type(c_ptr) :: a_d
563 type(c_ptr) :: b_d
564 real(kind=rp), intent(in) :: c
565 integer :: n
566 type(c_ptr), optional :: strm
567 type(c_ptr) :: strm_
568
569 if (n .lt. 1) return
570
571 if (present(strm)) then
572 strm_ = strm
573 else
574 strm_ = glb_cmd_queue
575 end if
576
577#if HAVE_HIP
578 call hip_cadd2(a_d, b_d, c, n, strm_)
579#elif HAVE_CUDA
580 call cuda_cadd2(a_d, b_d, c, n, strm_)
581#elif HAVE_OPENCL
582 call opencl_cadd2(a_d, b_d, c, n, strm_)
583#elif HAVE_METAL
584 call metal_cadd2(a_d, b_d, c, n, strm_)
585#else
586 call neko_error('No device backend configured')
587#endif
588 end subroutine device_cadd2
589
591 subroutine device_cwrap(a_d, min_val, max_val, n, strm)
592 type(c_ptr) :: a_d
593 real(kind=rp), intent(in) :: min_val, max_val
594 integer :: n
595 type(c_ptr), optional :: strm
596 type(c_ptr) :: strm_
597
598 if (n .lt. 1 .or. max_val .le. min_val) return
599
600 if (present(strm)) then
601 strm_ = strm
602 else
603 strm_ = glb_cmd_queue
604 end if
605
606#if HAVE_HIP
607 call hip_cwrap(a_d, min_val, max_val, n, strm_)
608#elif HAVE_CUDA
609 call cuda_cwrap(a_d, min_val, max_val, n, strm_)
610#elif HAVE_OPENCL
611 call opencl_cwrap(a_d, min_val, max_val, n, strm_)
612#elif HAVE_METAL
613 call metal_cwrap(a_d, min_val, max_val, n, strm_)
614#else
615 call neko_error('No device backend configured')
616#endif
617 end subroutine device_cwrap
618
620 subroutine device_sqrt_inplace(a_d, n, strm)
621 type(c_ptr) :: a_d
622 integer :: n
623 type(c_ptr), optional :: strm
624 type(c_ptr) :: strm_
625
626 if (n .lt. 1) return
627
628 if (present(strm)) then
629 strm_ = strm
630 else
631 strm_ = glb_cmd_queue
632 end if
633
634#if HAVE_HIP
635 call hip_sqrt_inplace(a_d, n, strm_)
636#elif HAVE_CUDA
637 call cuda_sqrt_inplace(a_d, n, strm_)
638#elif HAVE_OPENCL
639 call opencl_sqrt_inplace(a_d, n, strm_)
640#else
641 call neko_error('No device backend configured')
642#endif
643 end subroutine device_sqrt_inplace
644
646 subroutine device_power(ap_d, a_d, p, n, strm)
647 type(c_ptr) :: ap_d, a_d
648 real(kind=rp), intent(in) :: p
649 integer :: n
650 type(c_ptr), optional :: strm
651 type(c_ptr) :: strm_
652
653 if (n .lt. 1) return
654
655 if (present(strm)) then
656 strm_ = strm
657 else
658 strm_ = glb_cmd_queue
659 end if
660
661#if HAVE_HIP
662 call hip_power(ap_d, a_d, p, n, strm_)
663#elif HAVE_CUDA
664 call cuda_power(ap_d, a_d, p, n, strm_)
665#elif HAVE_OPENCL
666 call opencl_power(ap_d, a_d, p, n, strm_)
667#else
668 call neko_error('No device backend configured')
669#endif
670 end subroutine device_power
671
673 subroutine device_cfill(a_d, c, n, strm)
674 type(c_ptr) :: a_d
675 real(kind=rp), intent(in) :: c
676 integer :: n
677 type(c_ptr), optional ::strm
678 type(c_ptr) :: strm_
679
680 if (n .lt. 1) return
681
682 if (present(strm)) then
683 strm_ = strm
684 else
685 strm_ = glb_cmd_queue
686 end if
687
688#if HAVE_HIP
689 call hip_cfill(a_d, c, n, strm_)
690#elif HAVE_CUDA
691 call cuda_cfill(a_d, c, n, strm_)
692#elif HAVE_OPENCL
693 call opencl_cfill(a_d, c, n, strm_)
694#elif HAVE_METAL
695 call metal_cfill(a_d, c, n, strm_)
696#else
697 call neko_error('No device backend configured')
698#endif
699 end subroutine device_cfill
700
702 subroutine device_add2(a_d, b_d, n, strm)
703 type(c_ptr) :: a_d, b_d
704 integer :: n
705 type(c_ptr), optional :: strm
706 type(c_ptr) :: strm_
707
708 if (n .lt. 1) return
709
710 if (present(strm)) then
711 strm_ = strm
712 else
713 strm_ = glb_cmd_queue
714 end if
715
716#if HAVE_HIP
717 call hip_add2(a_d, b_d, n, strm_)
718#elif HAVE_CUDA
719 call cuda_add2(a_d, b_d, n, strm_)
720#elif HAVE_OPENCL
721 call opencl_add2(a_d, b_d, n, strm_)
722#elif HAVE_METAL
723 call metal_add2(a_d, b_d, n, strm_)
724#else
725 call neko_error('No device backend configured')
726#endif
727 end subroutine device_add2
728
729 subroutine device_add4(a_d, b_d, c_d, d_d, n, strm)
730 type(c_ptr) :: a_d, b_d, c_d, d_d
731 integer :: n
732 type(c_ptr), optional :: strm
733 type(c_ptr) :: strm_
734
735 if (n .lt. 1) return
736
737 if (present(strm)) then
738 strm_ = strm
739 else
740 strm_ = glb_cmd_queue
741 end if
742
743#if HAVE_HIP
744 call hip_add4(a_d, b_d, c_d, d_d, n, strm_)
745#elif HAVE_CUDA
746 call cuda_add4(a_d, b_d, c_d, d_d, n, strm_)
747#elif HAVE_OPENCL
748 call opencl_add4(a_d, b_d, c_d, d_d, n, strm_)
749#elif HAVE_METAL
750 call metal_add4(a_d, b_d, c_d, d_d, n, strm_)
751#else
752 call neko_error('No device backend configured')
753#endif
754 end subroutine device_add4
755
756 subroutine device_add2s1(a_d, b_d, c1, n, strm)
757 type(c_ptr) :: a_d, b_d
758 real(kind=rp) :: c1
759 integer :: n
760 type(c_ptr), optional :: strm
761 type(c_ptr) :: strm_
762
763 if (n .lt. 1) return
764
765 if (present(strm)) then
766 strm_ = strm
767 else
768 strm_ = glb_cmd_queue
769 end if
770
771#if HAVE_HIP
772 call hip_add2s1(a_d, b_d, c1, n, strm_)
773#elif HAVE_CUDA
774 call cuda_add2s1(a_d, b_d, c1, n, strm_)
775#elif HAVE_OPENCL
776 call opencl_add2s1(a_d, b_d, c1, n, strm_)
777#elif HAVE_METAL
778 call metal_add2s1(a_d, b_d, c1, n, strm_)
779#else
780 call neko_error('No device backend configured')
781#endif
782 end subroutine device_add2s1
783
786 subroutine device_add2s2(a_d, b_d, c1, n, strm)
787 type(c_ptr) :: a_d, b_d
788 real(kind=rp) :: c1
789 integer :: n
790 type(c_ptr), optional :: strm
791 type(c_ptr) :: strm_
792
793 if (n .lt. 1) return
794
795 if (present(strm)) then
796 strm_ = strm
797 else
798 strm_ = glb_cmd_queue
799 end if
800
801#if HAVE_HIP
802 call hip_add2s2(a_d, b_d, c1, n, strm_)
803#elif HAVE_CUDA
804 call cuda_add2s2(a_d, b_d, c1, n, strm_)
805#elif HAVE_OPENCL
806 call opencl_add2s2(a_d, b_d, c1, n, strm_)
807#elif HAVE_METAL
808 call metal_add2s2(a_d, b_d, c1, n, strm_)
809#else
810 call neko_error('No device backend configured')
811#endif
812 end subroutine device_add2s2
813
815 subroutine device_addsqr2s2(a_d, b_d, c1, n, strm)
816 type(c_ptr) :: a_d, b_d
817 real(kind=rp) :: c1
818 integer :: n
819 type(c_ptr), optional :: strm
820 type(c_ptr) :: strm_
821
822 if (n .lt. 1) return
823
824 if (present(strm)) then
825 strm_ = strm
826 else
827 strm_ = glb_cmd_queue
828 end if
829
830#if HAVE_HIP
831 call hip_addsqr2s2(a_d, b_d, c1, n, strm_)
832#elif HAVE_CUDA
833 call cuda_addsqr2s2(a_d, b_d, c1, n, strm_)
834#elif HAVE_OPENCL
835 call opencl_addsqr2s2(a_d, b_d, c1, n, strm_)
836#elif HAVE_METAL
837 call metal_addsqr2s2(a_d, b_d, c1, n, strm_)
838#else
839 call neko_error('No device backend configured')
840#endif
841 end subroutine device_addsqr2s2
842
844 subroutine device_add3(a_d, b_d, c_d, n, strm)
845 type(c_ptr) :: a_d, b_d, c_d
846 integer :: n
847 type(c_ptr), optional :: strm
848 type(c_ptr) :: strm_
849
850 if (n .lt. 1) return
851
852 if (present(strm)) then
853 strm_ = strm
854 else
855 strm_ = glb_cmd_queue
856 end if
857
858#if HAVE_HIP
859 call hip_add3(a_d, b_d, c_d, n, strm_)
860#elif HAVE_CUDA
861 call cuda_add3(a_d, b_d, c_d, n, strm_)
862#elif HAVE_OPENCL
863 call opencl_add3(a_d, b_d, c_d, n, strm_)
864#elif HAVE_METAL
865 call metal_add3(a_d, b_d, c_d, n, strm_)
866#else
867 call neko_error('No device backend configured')
868#endif
869 end subroutine device_add3
870
872 subroutine device_add3s2(a_d, b_d, c_d, c1, c2 , n, strm)
873 type(c_ptr) :: a_d, b_d, c_d
874 real(kind=rp) :: c1, c2
875 integer :: n
876 type(c_ptr), optional :: strm
877 type(c_ptr) :: strm_
878
879 if (n .lt. 1) return
880
881 if (present(strm)) then
882 strm_ = strm
883 else
884 strm_ = glb_cmd_queue
885 end if
886
887#if HAVE_HIP
888 call hip_add3s2(a_d, b_d, c_d, c1, c2, n, strm_)
889#elif HAVE_CUDA
890 call cuda_add3s2(a_d, b_d, c_d, c1, c2, n, strm_)
891#elif HAVE_OPENCL
892 call opencl_add3s2(a_d, b_d, c_d, c1, c2, n, strm_)
893#elif HAVE_METAL
894 call metal_add3s2(a_d, b_d, c_d, c1, c2, n, strm_)
895#else
896 call neko_error('No device backend configured')
897#endif
898 end subroutine device_add3s2
899
901 subroutine device_add4s3(a_d, b_d, c_d, d_d, c1, c2 , c3, n, strm)
902 type(c_ptr) :: a_d, b_d, c_d, d_d
903 real(kind=rp) :: c1, c2, c3
904 integer :: n
905 type(c_ptr), optional :: strm
906 type(c_ptr) :: strm_
907
908 if (n .lt. 1) return
909
910 if (present(strm)) then
911 strm_ = strm
912 else
913 strm_ = glb_cmd_queue
914 end if
915
916#if HAVE_HIP
917 call hip_add4s3(a_d, b_d, c_d, d_d, c1, c2, c3, n, strm_)
918#elif HAVE_CUDA
919 call cuda_add4s3(a_d, b_d, c_d, d_d, c1, c2, c3, n, strm_)
920#elif HAVE_OPENCL
921 call opencl_add4s3(a_d, b_d, c_d, d_d, c1, c2, c3, n, strm_)
922#elif HAVE_METAL
923 call metal_add4s3(a_d, b_d, c_d, d_d, c1, c2, c3, n, strm_)
924#else
925 call neko_error('No device backend configured')
926#endif
927 end subroutine device_add4s3
928
930 subroutine device_add5s4(a_d, b_d, c_d, d_d, e_d, c1, c2 , c3, c4, n, strm)
931 type(c_ptr) :: a_d, b_d, c_d, d_d, e_d
932 real(kind=rp) :: c1, c2, c3, c4
933 integer :: n
934 type(c_ptr), optional :: strm
935 type(c_ptr) :: strm_
936
937 if (n .lt. 1) return
938
939 if (present(strm)) then
940 strm_ = strm
941 else
942 strm_ = glb_cmd_queue
943 end if
944
945#if HAVE_HIP
946 call hip_add5s4(a_d, b_d, c_d, d_d, e_d, c1, c2, c3, c4, n, strm_)
947#elif HAVE_CUDA
948 call cuda_add5s4(a_d, b_d, c_d, d_d, e_d, c1, c2, c3, c4, n, strm_)
949#elif HAVE_OPENCL
950 call opencl_add5s4(a_d, b_d, c_d, d_d, e_d, c1, c2, c3, c4, n, strm_)
951#elif HAVE_METAL
952 call metal_add5s4(a_d, b_d, c_d, d_d, e_d, c1, c2, c3, c4, n, strm_)
953#else
954 call neko_error('No device backend configured')
955#endif
956 end subroutine device_add5s4
957
959 subroutine device_invcol1(a_d, n, strm)
960 type(c_ptr) :: a_d
961 integer :: n
962 type(c_ptr), optional :: strm
963 type(c_ptr) :: strm_
964
965 if (n .lt. 1) return
966
967 if (present(strm)) then
968 strm_ = strm
969 else
970 strm_ = glb_cmd_queue
971 end if
972
973#if HAVE_HIP
974 call hip_invcol1(a_d, n, strm_)
975#elif HAVE_CUDA
976 call cuda_invcol1(a_d, n, strm_)
977#elif HAVE_OPENCL
978 call opencl_invcol1(a_d, n, strm_)
979#elif HAVE_METAL
980 call metal_invcol1(a_d, n, strm_)
981#else
982 call neko_error('No device backend configured')
983#endif
984 end subroutine device_invcol1
985
987 subroutine device_invcol2(a_d, b_d, n, strm)
988 type(c_ptr) :: a_d, b_d
989 integer :: n
990 type(c_ptr), optional :: strm
991 type(c_ptr) :: strm_
992
993 if (n .lt. 1) return
994
995 if (present(strm)) then
996 strm_ = strm
997 else
998 strm_ = glb_cmd_queue
999 end if
1000
1001#if HAVE_HIP
1002 call hip_invcol2(a_d, b_d, n, strm_)
1003#elif HAVE_CUDA
1004 call cuda_invcol2(a_d, b_d, n, strm_)
1005#elif HAVE_OPENCL
1006 call opencl_invcol2(a_d, b_d, n, strm_)
1007#elif HAVE_METAL
1008 call metal_invcol2(a_d, b_d, n, strm_)
1009#else
1010 call neko_error('No device backend configured')
1011#endif
1012 end subroutine device_invcol2
1013
1015 subroutine device_invcol3(a_d, b_d, c_d, n, strm)
1016 type(c_ptr) :: a_d, b_d, c_d
1017 integer :: n
1018 type(c_ptr), optional :: strm
1019 type(c_ptr) :: strm_
1020
1021 if (present(strm)) then
1022 strm_ = strm
1023 else
1024 strm_ = glb_cmd_queue
1025 end if
1026
1027#ifdef HAVE_HIP
1028 call hip_invcol3(a_d, b_d, c_d, n, strm_)
1029#elif HAVE_CUDA
1030 call cuda_invcol3(a_d, b_d, c_d, n, strm_)
1031#elif HAVE_OPENCL
1032 call opencl_invcol3(a_d, b_d, c_d, n, strm_)
1033#elif HAVE_METAL
1034 call metal_invcol3(a_d, b_d, c_d, n, strm_)
1035#else
1036 call neko_error('No device backend configured')
1037#endif
1038 end subroutine device_invcol3
1039
1041 subroutine device_col2(a_d, b_d, n, strm)
1042 type(c_ptr) :: a_d, b_d
1043 integer :: n
1044 type(c_ptr), optional :: strm
1045 type(c_ptr) :: strm_
1046
1047 if (present(strm)) then
1048 strm_ = strm
1049 else
1050 strm_ = glb_cmd_queue
1051 end if
1052
1053 if (n .lt. 1) return
1054#if HAVE_HIP
1055 call hip_col2(a_d, b_d, n, strm_)
1056#elif HAVE_CUDA
1057 call cuda_col2(a_d, b_d, n, strm_)
1058#elif HAVE_OPENCL
1059 call opencl_col2(a_d, b_d, n, strm_)
1060#elif HAVE_METAL
1061 call metal_col2(a_d, b_d, n, strm_)
1062#else
1063 call neko_error('No device backend configured')
1064#endif
1065 end subroutine device_col2
1066
1068 subroutine device_col3(a_d, b_d, c_d, n, strm)
1069 type(c_ptr) :: a_d, b_d, c_d
1070 integer :: n
1071 type(c_ptr), optional :: strm
1072 type(c_ptr) :: strm_
1073
1074 if (n .lt. 1) return
1075
1076 if (present(strm)) then
1077 strm_ = strm
1078 else
1079 strm_ = glb_cmd_queue
1080 end if
1081
1082#if HAVE_HIP
1083 call hip_col3(a_d, b_d, c_d, n, strm_)
1084#elif HAVE_CUDA
1085 call cuda_col3(a_d, b_d, c_d, n, strm_)
1086#elif HAVE_OPENCL
1087 call opencl_col3(a_d, b_d, c_d, n, strm_)
1088#elif HAVE_METAL
1089 call metal_col3(a_d, b_d, c_d, n, strm_)
1090#else
1091 call neko_error('No device backend configured')
1092#endif
1093 end subroutine device_col3
1094
1096 subroutine device_subcol3(a_d, b_d, c_d, n, strm)
1097 type(c_ptr) :: a_d, b_d, c_d
1098 integer :: n
1099 type(c_ptr), optional :: strm
1100 type(c_ptr) :: strm_
1101
1102 if (n .lt. 1) return
1103
1104 if (present(strm)) then
1105 strm_ = strm
1106 else
1107 strm_ = glb_cmd_queue
1108 end if
1109
1110#if HAVE_HIP
1111 call hip_subcol3(a_d, b_d, c_d, n, strm_)
1112#elif HAVE_CUDA
1113 call cuda_subcol3(a_d, b_d, c_d, n, strm_)
1114#elif HAVE_OPENCL
1115 call opencl_subcol3(a_d, b_d, c_d, n, strm_)
1116#elif HAVE_METAL
1117 call metal_subcol3(a_d, b_d, c_d, n, strm_)
1118#else
1119 call neko_error('No device backend configured')
1120#endif
1121 end subroutine device_subcol3
1122
1124 subroutine device_sub2(a_d, b_d, n, strm)
1125 type(c_ptr) :: a_d, b_d
1126 integer :: n
1127 type(c_ptr), optional :: strm
1128 type(c_ptr) :: strm_
1129
1130 if (n .lt. 1) return
1131
1132 if (present(strm)) then
1133 strm_ = strm
1134 else
1135 strm_ = glb_cmd_queue
1136 end if
1137
1138#if HAVE_HIP
1139 call hip_sub2(a_d, b_d, n, strm_)
1140#elif HAVE_CUDA
1141 call cuda_sub2(a_d, b_d, n, strm_)
1142#elif HAVE_OPENCL
1143 call opencl_sub2(a_d, b_d, n, strm_)
1144#elif HAVE_METAL
1145 call metal_sub2(a_d, b_d, n, strm_)
1146#else
1147 call neko_error('No device backend configured')
1148#endif
1149 end subroutine device_sub2
1150
1152 subroutine device_sub3(a_d, b_d, c_d, n, strm)
1153 type(c_ptr) :: a_d, b_d, c_d
1154 integer :: n
1155 type(c_ptr), optional :: strm
1156 type(c_ptr) :: strm_
1157
1158 if (n .lt. 1) return
1159
1160 if (present(strm)) then
1161 strm_ = strm
1162 else
1163 strm_ = glb_cmd_queue
1164 end if
1165
1166#if HAVE_HIP
1167 call hip_sub3(a_d, b_d, c_d, n, strm_)
1168#elif HAVE_CUDA
1169 call cuda_sub3(a_d, b_d, c_d, n, strm_)
1170#elif HAVE_OPENCL
1171 call opencl_sub3(a_d, b_d, c_d, n, strm_)
1172#elif HAVE_METAL
1173 call metal_sub3(a_d, b_d, c_d, n, strm_)
1174#else
1175 call neko_error('No device backend configured')
1176#endif
1177 end subroutine device_sub3
1178
1180 subroutine device_addcol3(a_d, b_d, c_d, n, strm)
1181 type(c_ptr) :: a_d, b_d, c_d
1182 integer :: n
1183 type(c_ptr), optional :: strm
1184 type(c_ptr) :: strm_
1185
1186 if (n .lt. 1) return
1187
1188 if (present(strm)) then
1189 strm_ = strm
1190 else
1191 strm_ = glb_cmd_queue
1192 end if
1193
1194#if HAVE_HIP
1195 call hip_addcol3(a_d, b_d, c_d, n, strm_)
1196#elif HAVE_CUDA
1197 call cuda_addcol3(a_d, b_d, c_d, n, strm_)
1198#elif HAVE_OPENCL
1199 call opencl_addcol3(a_d, b_d, c_d, n, strm_)
1200#elif HAVE_METAL
1201 call metal_addcol3(a_d, b_d, c_d, n, strm_)
1202#else
1203 call neko_error('No device backend configured')
1204#endif
1205 end subroutine device_addcol3
1206
1208 subroutine device_addcol4(a_d, b_d, c_d, d_d, n, strm)
1209 type(c_ptr) :: a_d, b_d, c_d, d_d
1210 integer :: n
1211 type(c_ptr), optional :: strm
1212 type(c_ptr) :: strm_
1213
1214 if (n .lt. 1) return
1215
1216 if (present(strm)) then
1217 strm_ = strm
1218 else
1219 strm_ = glb_cmd_queue
1220 end if
1221
1222#if HAVE_HIP
1223 call hip_addcol4(a_d, b_d, c_d, d_d, n, strm_)
1224#elif HAVE_CUDA
1225 call cuda_addcol4(a_d, b_d, c_d, d_d, n, strm_)
1226#elif HAVE_OPENCL
1227 call opencl_addcol4(a_d, b_d, c_d, d_d, n, strm_)
1228#elif HAVE_METAL
1229 call metal_addcol4(a_d, b_d, c_d, d_d, n, strm_)
1230#else
1231 call neko_error('No device backend configured')
1232#endif
1233 end subroutine device_addcol4
1234
1236 subroutine device_addcol3s2(a_d, b_d, c_d, s, n, strm)
1237 type(c_ptr) :: a_d, b_d, c_d
1238 real(kind=rp) :: s
1239 integer :: n
1240 type(c_ptr), optional :: strm
1241 type(c_ptr) :: strm_
1242
1243 if (n .lt. 1) return
1244
1245 if (present(strm)) then
1246 strm_ = strm
1247 else
1248 strm_ = glb_cmd_queue
1249 end if
1250
1251#if HAVE_HIP
1252 call hip_addcol3s2(a_d, b_d, c_d, s, n, strm_)
1253#elif HAVE_CUDA
1254 call cuda_addcol3s2(a_d, b_d, c_d, s, n, strm_)
1255#elif HAVE_OPENCL
1256 call opencl_addcol3s2(a_d, b_d, c_d, s, n, strm_)
1257#elif HAVE_METAL
1258 call metal_addcol3s2(a_d, b_d, c_d, s, n, strm_)
1259#else
1260 call neko_error('No device backend configured')
1261#endif
1262 end subroutine device_addcol3s2
1263
1266 subroutine device_vdot3(dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, n, strm)
1267 type(c_ptr) :: dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d
1268 integer :: n
1269 type(c_ptr), optional :: strm
1270 type(c_ptr) :: strm_
1271
1272 if (n .lt. 1) return
1273
1274 if (present(strm)) then
1275 strm_ = strm
1276 else
1277 strm_ = glb_cmd_queue
1278 end if
1279
1280#if HAVE_HIP
1281 call hip_vdot3(dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, n, strm_)
1282#elif HAVE_CUDA
1283 call cuda_vdot3(dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, n, strm_)
1284#elif HAVE_OPENCL
1285 call opencl_vdot3(dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, n, strm_)
1286#elif HAVE_METAL
1287 call metal_vdot3(dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, n, strm_)
1288#else
1289 call neko_error('No device backend configured')
1290#endif
1291 end subroutine device_vdot3
1292
1295 subroutine device_vcross(u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, &
1296 w1_d, w2_d, w3_d, n, strm)
1297 type(c_ptr) :: u1_d, u2_d, u3_d
1298 type(c_ptr) :: v1_d, v2_d, v3_d
1299 type(c_ptr) :: w1_d, w2_d, w3_d
1300 integer :: n
1301 type(c_ptr), optional :: strm
1302 type(c_ptr) :: strm_
1303
1304 if (n .lt. 1) return
1305
1306 if (present(strm)) then
1307 strm_ = strm
1308 else
1309 strm_ = glb_cmd_queue
1310 end if
1311
1312#if HAVE_HIP
1313 call hip_vcross(u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, &
1314 w1_d, w2_d, w3_d, n, strm_)
1315#elif HAVE_CUDA
1316 call cuda_vcross(u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, &
1317 w1_d, w2_d, w3_d, n, strm_)
1318#elif HAVE_OPENCL
1319 call opencl_vcross(u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, &
1320 w1_d, w2_d, w3_d, n, strm_)
1321#elif HAVE_METAL
1322 call metal_vcross(u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, &
1323 w1_d, w2_d, w3_d, n, strm_)
1324#else
1325 call neko_error('No device backend configured')
1326#endif
1327 end subroutine device_vcross
1328
1329
1331 function device_vlsc3(u_d, v_d, w_d, n, strm) result(res)
1332 type(c_ptr) :: u_d, v_d, w_d
1333 integer :: n
1334 type(c_ptr), optional :: strm
1335 type(c_ptr) :: strm_
1336 real(kind=rp) :: res
1337
1338 res = 0.0_rp
1339
1340 if (n .lt. 1) return
1341
1342 if (present(strm)) then
1343 strm_ = strm
1344 else
1345 strm_ = glb_cmd_queue
1346 end if
1347
1348#if HAVE_HIP
1349 res = hip_vlsc3(u_d, v_d, w_d, n, strm_)
1350#elif HAVE_CUDA
1351 res = cuda_vlsc3(u_d, v_d, w_d, n, strm_)
1352#elif HAVE_OPENCL
1353 ! Same kernel as glsc3 (currently no device MPI for OpenCL)
1354 res = opencl_glsc3(u_d, v_d, w_d, n, strm_)
1355#elif HAVE_METAL
1356 ! Same kernel as glsc3 (currently no device MPI for OpenCL)
1357 res = metal_glsc3(u_d, v_d, w_d, n, strm_)
1358#else
1359 call neko_error('No device backend configured')
1360#endif
1361 end function device_vlsc3
1362
1364 function device_glsc3(a_d, b_d, c_d, n, strm) result(res)
1365 type(c_ptr) :: a_d, b_d, c_d
1366 integer :: n, ierr
1367 type(c_ptr), optional :: strm
1368 type(c_ptr) :: strm_
1369 real(kind=rp) :: res
1370 real(kind=xp) :: res_xp
1371
1372 if (present(strm)) then
1373 strm_ = strm
1374 else
1375 strm_ = glb_cmd_queue
1376 end if
1377
1378 res_xp = 0.0_xp
1379#if HAVE_HIP
1380 res_xp = hip_glsc3(a_d, b_d, c_d, n, strm_)
1381#elif HAVE_CUDA
1382 res_xp = cuda_glsc3(a_d, b_d, c_d, n, strm_)
1383#elif HAVE_OPENCL
1384 res_xp = opencl_glsc3(a_d, b_d, c_d, n, strm_)
1385#elif HAVE_METAL
1386 res = metal_glsc3(a_d, b_d, c_d, n, strm_)
1387 res_xp = real(res, kind=xp)
1388#else
1389 call neko_error('No device backend configured')
1390#endif
1391
1392#ifndef HAVE_DEVICE_MPI
1393 if (pe_size .gt. 1) then
1394 call mpi_allreduce(mpi_in_place, res_xp, 1, &
1395 mpi_extra_precision, mpi_sum, neko_comm, ierr)
1396 end if
1397#endif
1398 res = real(res_xp, kind=rp)
1399 end function device_glsc3
1400
1401 subroutine device_glsc3_many(h, w_d, v_d_d, mult_d, j, n, strm)
1402 type(c_ptr), value :: w_d, v_d_d, mult_d
1403 integer(c_int) :: j, n
1404 real(c_rp) :: h(j)
1405 real(c_xp) :: h_xp(j)
1406 type(c_ptr), optional :: strm
1407 type(c_ptr) :: strm_
1408 integer :: ierr
1409
1410 if (present(strm)) then
1411 strm_ = strm
1412 else
1413 strm_ = glb_cmd_queue
1414 end if
1415
1416#if HAVE_HIP
1417 h_xp = 0.0_c_xp
1418 call hip_glsc3_many(h_xp, w_d, v_d_d, mult_d, j, n, strm_)
1419#elif HAVE_CUDA
1420 h_xp = 0.0_c_xp
1421 call cuda_glsc3_many(h_xp, w_d, v_d_d, mult_d, j, n, strm_)
1422#elif HAVE_OPENCL
1423 h_xp = 0.0_c_xp
1424 call opencl_glsc3_many(h_xp, w_d, v_d_d, mult_d, j, n, strm_)
1425#elif HAVE_METAL
1426 call metal_glsc3_many(h, w_d, v_d_d, mult_d, j, n, strm_)
1427 h_xp = real(h, kind=c_xp)
1428#else
1429 call neko_error('No device backend configured')
1430#endif
1431
1432#ifndef HAVE_DEVICE_MPI
1433 if (pe_size .gt. 1) then
1434 call mpi_allreduce(mpi_in_place, h_xp, j, &
1435 mpi_extra_precision, mpi_sum, neko_comm, ierr)
1436 end if
1437#endif
1438 h = real(h_xp, kind=c_rp)
1439 end subroutine device_glsc3_many
1440
1441 subroutine device_add2s2_many(y_d, x_d_d, a_d, j, n, strm)
1442 type(c_ptr), value :: y_d, x_d_d, a_d
1443 integer(c_int) :: j, n
1444 type(c_ptr), optional :: strm
1445 type(c_ptr) :: strm_
1446
1447 if (n .lt. 1) return
1448
1449 if (present(strm)) then
1450 strm_ = strm
1451 else
1452 strm_ = glb_cmd_queue
1453 end if
1454
1455#if HAVE_HIP
1456 call hip_add2s2_many(y_d, x_d_d, a_d, j, n, strm_)
1457#elif HAVE_CUDA
1458 call cuda_add2s2_many(y_d, x_d_d, a_d, j, n, strm_)
1459#elif HAVE_OPENCL
1460 call opencl_add2s2_many(y_d, x_d_d, a_d, j, n, strm_)
1461#elif HAVE_METAL
1462 call metal_add2s2_many(y_d, x_d_d, a_d, j, n, strm_)
1463#else
1464 call neko_error('No device backend configured')
1465#endif
1466 end subroutine device_add2s2_many
1467
1469 function device_glsc2(a_d, b_d, n, strm) result(res)
1470 type(c_ptr) :: a_d, b_d
1471 integer :: n, ierr
1472 real(kind=rp) :: res
1473 real(kind=xp) :: res_xp
1474 type(c_ptr), optional :: strm
1475 type(c_ptr) :: strm_
1476
1477 if (present(strm)) then
1478 strm_ = strm
1479 else
1480 strm_ = glb_cmd_queue
1481 end if
1482
1483 res_xp = 0.0_xp
1484#if HAVE_HIP
1485 res_xp = hip_glsc2(a_d, b_d, n, strm_)
1486#elif HAVE_CUDA
1487 res_xp = cuda_glsc2(a_d, b_d, n, strm_)
1488#elif HAVE_OPENCL
1489 res_xp = opencl_glsc2(a_d, b_d, n, strm_)
1490#elif HAVE_METAL
1491 res = metal_glsc2(a_d, b_d, n, strm_)
1492 res_xp = real(res, kind=xp)
1493#else
1494 call neko_error('No device backend configured')
1495#endif
1496
1497#ifndef HAVE_DEVICE_MPI
1498 if (pe_size .gt. 1) then
1499 call mpi_allreduce(mpi_in_place, res_xp, 1, &
1500 mpi_extra_precision, mpi_sum, neko_comm, ierr)
1501 end if
1502#endif
1503 res = real(res_xp, kind=rp)
1504 end function device_glsc2
1505
1508 function device_glsubnorm(a_d, b_d, n, strm) result(res)
1509 type(c_ptr), intent(in) :: a_d, b_d
1510 integer, intent(in) :: n
1511 integer :: ierr
1512 real(kind=rp) :: res
1513 real(kind=xp) :: res_xp
1514 type(c_ptr), optional :: strm
1515 type(c_ptr) :: strm_
1516
1517 if (present(strm)) then
1518 strm_ = strm
1519 else
1520 strm_ = glb_cmd_queue
1521 end if
1522
1523 res_xp = 0.0_xp
1524#if HAVE_HIP
1525 res_xp = hip_glsubnorm2(a_d, b_d, n, strm_)
1526#elif HAVE_CUDA
1527 res_xp = cuda_glsubnorm2(a_d, b_d, n, strm_)
1528#elif HAVE_OPENCL
1529 res_xp = opencl_glsubnorm2(a_d, b_d, n, strm_)
1530#elif HAVE_METAL
1531 res = metal_glsubnorm2(a_d, b_d, n, strm_)
1532 res_xp = real(res, kind=xp)
1533#else
1534 call neko_error('No device backend configured')
1535#endif
1536
1537#ifndef HAVE_DEVICE_MPI
1538 if (pe_size .gt. 1) then
1539 call mpi_allreduce(mpi_in_place, res_xp, 1, &
1540 mpi_extra_precision, mpi_sum, neko_comm, ierr)
1541 end if
1542#endif
1543
1544 res = real(sqrt(res_xp), kind=rp)
1545 end function device_glsubnorm
1546
1548 function device_glsum(a_d, n, strm) result(res)
1549 type(c_ptr) :: a_d
1550 integer :: n, ierr
1551 real(kind=rp) :: res
1552 real(kind=xp) :: res_xp
1553 type(c_ptr), optional :: strm
1554 type(c_ptr) :: strm_
1555
1556 if (present(strm)) then
1557 strm_ = strm
1558 else
1559 strm_ = glb_cmd_queue
1560 end if
1561
1562 res_xp = 0.0_xp
1563#if HAVE_HIP
1564 res_xp = hip_glsum(a_d, n, strm_)
1565#elif HAVE_CUDA
1566 res_xp = cuda_glsum(a_d, n, strm_)
1567#elif HAVE_OPENCL
1568 res_xp = opencl_glsum(a_d, n, strm_)
1569#elif HAVE_METAL
1570 res = metal_glsum(a_d, n, strm_)
1571 res_xp = real(res, kind=xp)
1572#else
1573 call neko_error('No device backend configured')
1574#endif
1575
1576#ifndef HAVE_DEVICE_MPI
1577 if (pe_size .gt. 1) then
1578 call mpi_allreduce(mpi_in_place, res_xp, 1, &
1579 mpi_extra_precision, mpi_sum, neko_comm, ierr)
1580 end if
1581#endif
1582 res = real(res_xp, kind=rp)
1583 end function device_glsum
1584
1586 function device_glmax(a_d, n, strm) result(res)
1587 type(c_ptr) :: a_d
1588 integer :: n, ierr
1589 real(kind=rp) :: res, ninf
1590 type(c_ptr), optional :: strm
1591 type(c_ptr) :: strm_
1592
1593 if (n .lt. 1) then
1594 res = -huge(0.0_rp)
1595 return
1596 end if
1597
1598 if (present(strm)) then
1599 strm_ = strm
1600 else
1601 strm_ = glb_cmd_queue
1602 end if
1603
1604 ninf = -huge(0.0_rp)
1605#if HAVE_HIP
1606 res = hip_glmax(a_d, ninf, n, strm_)
1607#elif HAVE_CUDA
1608 res = cuda_glmax(a_d, ninf, n, strm_)
1609#elif HAVE_OPENCL
1610 res = opencl_glmax(a_d, n, strm_)
1611#elif HAVE_METAL
1612 res = metal_glmax(a_d, ninf, n, strm_)
1613#else
1614 call neko_error('No device backend configured')
1615#endif
1616
1617#ifndef HAVE_DEVICE_MPI
1618 if (pe_size .gt. 1) then
1619 call mpi_allreduce(mpi_in_place, res, 1, &
1620 mpi_real_precision, mpi_max, neko_comm, ierr)
1621 end if
1622#endif
1623 end function device_glmax
1624
1626 function device_glmin(a_d, n, strm) result(res)
1627 type(c_ptr) :: a_d
1628 integer :: n, ierr
1629 real(kind=rp) :: res, pinf
1630 type(c_ptr), optional :: strm
1631 type(c_ptr) :: strm_
1632
1633 if (n .lt. 1) then
1634 res = huge(0.0_rp)
1635 return
1636 end if
1637
1638 if (present(strm)) then
1639 strm_ = strm
1640 else
1641 strm_ = glb_cmd_queue
1642 end if
1643
1644 pinf = huge(0.0_rp)
1645#if HAVE_HIP
1646 res = hip_glmin(a_d, pinf, n, strm_)
1647#elif HAVE_CUDA
1648 res = cuda_glmin(a_d, pinf, n, strm_)
1649#elif HAVE_OPENCL
1650 res = opencl_glmin(a_d, n, strm_)
1651#elif HAVE_METAL
1652 res = metal_glmin(a_d, pinf, n, strm_)
1653#else
1654 call neko_error('No device backend configured')
1655#endif
1656
1657#ifndef HAVE_DEVICE_MPI
1658 if (pe_size .gt. 1) then
1659 call mpi_allreduce(mpi_in_place, res, 1, &
1660 mpi_real_precision, mpi_min, neko_comm, ierr)
1661 end if
1662#endif
1663 end function device_glmin
1664
1669 function device_glamax(a_d, n, strm) result(res)
1670 type(c_ptr) :: a_d
1671 integer :: n, ierr
1672 real(kind=rp) :: res
1673 type(c_ptr), optional :: strm
1674 type(c_ptr) :: strm_
1675
1676 if (n .lt. 1) then
1677 res = 0.0_rp
1678 return
1679 end if
1680
1681 if (present(strm)) then
1682 strm_ = strm
1683 else
1684 strm_ = glb_cmd_queue
1685 end if
1686
1687#if HAVE_HIP
1688 res = hip_glamax(a_d, n, strm_)
1689#elif HAVE_CUDA
1690 res = cuda_glamax(a_d, n, strm_)
1691#elif HAVE_OPENCL
1692 res = opencl_glamax(a_d, n, strm_)
1693#elif HAVE_METAL
1694 res = metal_glamax(a_d, n, strm_)
1695#else
1696 call neko_error('No device backend configured')
1697#endif
1698
1699#ifndef HAVE_DEVICE_MPI
1700 if (pe_size .gt. 1) then
1701 call mpi_allreduce(mpi_in_place, res, 1, &
1702 mpi_real_precision, mpi_max, neko_comm, ierr)
1703 end if
1704#endif
1705 end function device_glamax
1706
1707 subroutine device_absval(a_d, n, strm)
1708 integer, intent(in) :: n
1709 type(c_ptr) :: a_d
1710 type(c_ptr), optional :: strm
1711 type(c_ptr) :: strm_
1712
1713 if (n .lt. 1) return
1714
1715 if (present(strm)) then
1716 strm_ = strm
1717 else
1718 strm_ = glb_cmd_queue
1719 end if
1720
1721#ifdef HAVE_HIP
1722 call hip_absval(a_d, n, strm_)
1723#elif HAVE_CUDA
1724 call cuda_absval(a_d, n, strm_)
1725#elif HAVE_OPENCL
1726 call opencl_absval(a_d, n, strm_)
1727#elif HAVE_METAL
1728 call metal_absval(a_d, n, strm_)
1729#else
1730 call neko_error('No device backend configured')
1731#endif
1732
1733 end subroutine device_absval
1734
1735 ! ========================================================================== !
1736 ! Device point-wise max
1737
1740 subroutine device_pwmax2(a_d, b_d, n, strm)
1741 type(c_ptr) :: a_d, b_d
1742 integer :: n
1743 type(c_ptr), optional :: strm
1744 type(c_ptr) :: strm_
1745
1746 if (n .lt. 1) return
1747
1748 if (present(strm)) then
1749 strm_ = strm
1750 else
1751 strm_ = glb_cmd_queue
1752 end if
1753
1754#if HAVE_HIP
1755 call hip_pwmax_vec2(a_d, b_d, n, strm_)
1756#elif HAVE_CUDA
1757 call cuda_pwmax_vec2(a_d, b_d, n, strm_)
1758#elif HAVE_OPENCL
1759 call opencl_pwmax_vec2(a_d, b_d, n, strm_)
1760#elif HAVE_METAL
1761 call metal_pwmax_vec2(a_d, b_d, n, strm_)
1762#else
1763 call neko_error('No device backend configured')
1764#endif
1765 end subroutine device_pwmax2
1766
1769 subroutine device_pwmax3(a_d, b_d, c_d, n, strm)
1770 type(c_ptr) :: a_d, b_d, c_d
1771 integer :: n
1772 type(c_ptr), optional :: strm
1773 type(c_ptr) :: strm_
1774
1775 if (n .lt. 1) return
1776
1777 if (present(strm)) then
1778 strm_ = strm
1779 else
1780 strm_ = glb_cmd_queue
1781 end if
1782
1783#if HAVE_HIP
1784 call hip_pwmax_vec3(a_d, b_d, c_d, n, strm_)
1785#elif HAVE_CUDA
1786 call cuda_pwmax_vec3(a_d, b_d, c_d, n, strm_)
1787#elif HAVE_OPENCL
1788 call opencl_pwmax_vec3(a_d, b_d, c_d, n, strm_)
1789#elif HAVE_METAL
1790 call metal_pwmax_vec3(a_d, b_d, c_d, n, strm_)
1791#else
1792 call neko_error('No device backend configured')
1793#endif
1794
1795 end subroutine device_pwmax3
1796
1799 subroutine device_cpwmax2(a_d, c, n, strm)
1800 type(c_ptr) :: a_d
1801 real(kind=rp), intent(in) :: c
1802 integer :: n
1803 type(c_ptr), optional :: strm
1804 type(c_ptr) :: strm_
1805
1806 if (n .lt. 1) return
1807
1808 if (present(strm)) then
1809 strm_ = strm
1810 else
1811 strm_ = glb_cmd_queue
1812 end if
1813
1814#if HAVE_HIP
1815 call hip_pwmax_sca2(a_d, c, n, strm_)
1816#elif HAVE_CUDA
1817 call cuda_pwmax_sca2(a_d, c, n, strm_)
1818#elif HAVE_OPENCL
1819 call opencl_pwmax_sca2(a_d, c, n, strm_)
1820#elif HAVE_METAL
1821 call metal_pwmax_sca2(a_d, c, n, strm_)
1822#else
1823 call neko_error('No device backend configured')
1824#endif
1825
1826 end subroutine device_cpwmax2
1827
1830 subroutine device_cpwmax3(a_d, b_d, c, n, strm)
1831 type(c_ptr) :: a_d, b_d
1832 real(kind=rp), intent(in) :: c
1833 integer :: n
1834 type(c_ptr), optional :: strm
1835 type(c_ptr) :: strm_
1836
1837 if (n .lt. 1) return
1838
1839 if (present(strm)) then
1840 strm_ = strm
1841 else
1842 strm_ = glb_cmd_queue
1843 end if
1844
1845#if HAVE_HIP
1846 call hip_pwmax_sca3(a_d, b_d, c, n, strm_)
1847#elif HAVE_CUDA
1848 call cuda_pwmax_sca3(a_d, b_d, c, n, strm_)
1849#elif HAVE_OPENCL
1850 call opencl_pwmax_sca3(a_d, b_d, c, n, strm_)
1851#elif HAVE_METAL
1852 call metal_pwmax_sca3(a_d, b_d, c, n, strm_)
1853#else
1854 call neko_error('No device backend configured')
1855#endif
1856
1857 end subroutine device_cpwmax3
1858
1859 ! ========================================================================== !
1860 ! Device point-wise min
1861
1864 subroutine device_pwmin2(a_d, b_d, n, strm)
1865 type(c_ptr) :: a_d, b_d
1866 integer :: n
1867 type(c_ptr), optional :: strm
1868 type(c_ptr) :: strm_
1869
1870 if (n .lt. 1) return
1871
1872 if (present(strm)) then
1873 strm_ = strm
1874 else
1875 strm_ = glb_cmd_queue
1876 end if
1877
1878#if HAVE_HIP
1879 call hip_pwmin_vec2(a_d, b_d, n, strm_)
1880#elif HAVE_CUDA
1881 call cuda_pwmin_vec2(a_d, b_d, n, strm_)
1882#elif HAVE_OPENCL
1883 call opencl_pwmin_vec2(a_d, b_d, n, strm_)
1884#elif HAVE_METAL
1885 call metal_pwmin_vec2(a_d, b_d, n, strm_)
1886#else
1887 call neko_error('No device backend configured')
1888#endif
1889 end subroutine device_pwmin2
1890
1893 subroutine device_pwmin3(a_d, b_d, c_d, n, strm)
1894 type(c_ptr) :: a_d, b_d, c_d
1895 integer :: n
1896 type(c_ptr), optional :: strm
1897 type(c_ptr) :: strm_
1898
1899 if (n .lt. 1) return
1900
1901 if (present(strm)) then
1902 strm_ = strm
1903 else
1904 strm_ = glb_cmd_queue
1905 end if
1906
1907#if HAVE_HIP
1908 call hip_pwmin_vec3(a_d, b_d, c_d, n, strm_)
1909#elif HAVE_CUDA
1910 call cuda_pwmin_vec3(a_d, b_d, c_d, n, strm_)
1911#elif HAVE_OPENCL
1912 call opencl_pwmin_vec3(a_d, b_d, c_d, n, strm_)
1913#elif HAVE_METAL
1914 call metal_pwmin_vec3(a_d, b_d, c_d, n, strm_)
1915#else
1916 call neko_error('No device backend configured')
1917#endif
1918
1919 end subroutine device_pwmin3
1920
1923 subroutine device_cpwmin2(a_d, c, n, strm)
1924 type(c_ptr) :: a_d
1925 real(kind=rp), intent(in) :: c
1926 integer :: n
1927 type(c_ptr), optional :: strm
1928 type(c_ptr) :: strm_
1929
1930 if (n .lt. 1) return
1931
1932 if (present(strm)) then
1933 strm_ = strm
1934 else
1935 strm_ = glb_cmd_queue
1936 end if
1937
1938#if HAVE_HIP
1939 call hip_pwmin_sca2(a_d, c, n, strm_)
1940#elif HAVE_CUDA
1941 call cuda_pwmin_sca2(a_d, c, n, strm_)
1942#elif HAVE_OPENCL
1943 call opencl_pwmin_sca2(a_d, c, n, strm_)
1944#elif HAVE_METAL
1945 call metal_pwmin_sca2(a_d, c, n, strm_)
1946#else
1947 call neko_error('No device backend configured')
1948#endif
1949
1950 end subroutine device_cpwmin2
1951
1954 subroutine device_cpwmin3(a_d, b_d, c, n, strm)
1955 type(c_ptr) :: a_d, b_d
1956 real(kind=rp), intent(in) :: c
1957 integer :: n
1958 type(c_ptr), optional :: strm
1959 type(c_ptr) :: strm_
1960
1961 if (n .lt. 1) return
1962
1963 if (present(strm)) then
1964 strm_ = strm
1965 else
1966 strm_ = glb_cmd_queue
1967 end if
1968
1969#if HAVE_HIP
1970 call hip_pwmin_sca3(a_d, b_d, c, n, strm_)
1971#elif HAVE_CUDA
1972 call cuda_pwmin_sca3(a_d, b_d, c, n, strm_)
1973#elif HAVE_OPENCL
1974 call opencl_pwmin_sca3(a_d, b_d, c, n, strm_)
1975#elif HAVE_METAL
1976 call metal_pwmin_sca3(a_d, b_d, c, n, strm_)
1977#else
1978 call neko_error('No device backend configured')
1979#endif
1980
1981 end subroutine device_cpwmin3
1982
1983 ! ========================================================================== !
1984 ! Integer operations
1985
1987 subroutine device_iadd(a_d, c, n, strm)
1988 type(c_ptr), intent(inout) :: a_d
1989 integer, intent(in) :: c
1990 integer, intent(in) :: n
1991 type(c_ptr), optional :: strm
1992 type(c_ptr) :: strm_
1993 if (n .lt. 1) return
1994
1995 if (present(strm)) then
1996 strm_ = strm
1997 else
1998 strm_ = glb_cmd_queue
1999 end if
2000
2001#if HAVE_HIP
2002 call hip_iadd(a_d, c, n, strm_)
2003#elif HAVE_CUDA
2004 call cuda_iadd(a_d, c, n, strm_)
2005#elif HAVE_OPENCL
2006 call opencl_iadd(a_d, c, n, strm_)
2007#elif HAVE_METAL
2008 call metal_iadd(a_d, c, n, strm_)
2009#else
2010 call neko_error('No device backend configured')
2011#endif
2012 end subroutine device_iadd
2013
2014
2015end module device_math
double real
Definition comm.F90:1
type(mpi_datatype), public mpi_real_precision
MPI type for working precision of REAL types.
Definition comm.F90:54
integer, public pe_size
MPI size of communicator.
Definition comm.F90:62
type(mpi_comm), public neko_comm
MPI communicator.
Definition comm.F90:46
type(mpi_datatype), public mpi_extra_precision
Definition comm.F90:55
subroutine, public device_pwmin2(a_d, b_d, n, strm)
Compute the point-wise minimum of two vectors .
subroutine, public device_masked_scatter_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm)
Scatter a masked vector .
subroutine, public device_add2s1(a_d, b_d, c1, n, strm)
subroutine, public device_add2s2_many(y_d, x_d_d, a_d, j, n, strm)
subroutine, public device_add4s3(a_d, b_d, c_d, d_d, c1, c2, c3, n, strm)
Returns .
subroutine, public device_sub3(a_d, b_d, c_d, n, strm)
Vector subtraction .
subroutine, public device_masked_scatter_copy_0(a_d, b_d, mask_d, n, n_mask, strm)
Scatter a masked vector .
subroutine, public device_add2s2(a_d, b_d, c1, n, strm)
Vector addition with scalar multiplication (multiplication on first argument)
real(kind=rp) function, public device_glmax(a_d, n, strm)
Max of a vector of length n.
subroutine, public device_add2(a_d, b_d, n, strm)
Vector addition .
subroutine, public device_addcol3(a_d, b_d, c_d, n, strm)
Returns .
real(kind=rp) function, public device_glsum(a_d, n, strm)
Sum a vector of length n.
subroutine, public device_pwmax3(a_d, b_d, c_d, n, strm)
Compute the point-wise maximum of two vectors .
subroutine, public device_invcol1(a_d, n, strm)
Invert a vector .
subroutine, public device_add3s2(a_d, b_d, c_d, c1, c2, n, strm)
Returns .
subroutine, public device_masked_atomic_reduction_0(a_d, b_d, mask_d, n, n_mask, strm)
subroutine, public device_cpwmax3(a_d, b_d, c, n, strm)
Compute the point-wise maximum of a vector and a scalar .
subroutine, public device_rzero(a_d, n, strm)
Zero a real vector.
subroutine, public device_rone(a_d, n, strm)
Set all elements to one.
subroutine, public device_vcross(u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, w1_d, w2_d, w3_d, n, strm)
Compute a cross product (3-d version) assuming vector components etc.
subroutine, public device_cmult(a_d, c, n, strm)
Multiplication by constant c .
subroutine, public device_vdot3(dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, n, strm)
Compute a dot product (3-d version) assuming vector components etc.
real(kind=rp) function, public device_glsubnorm(a_d, b_d, n, strm)
Returns the norm of the difference of two vectors .
subroutine, public device_glsc3_many(h, w_d, v_d_d, mult_d, j, n, strm)
subroutine, public device_cfill_mask(a_d, c, n, mask_d, n_mask, strm)
Fill a constant to a masked vector. .
subroutine, public device_cadd2(a_d, b_d, c, n, strm)
Add a scalar to vector .
subroutine, public device_sub2(a_d, b_d, n, strm)
Vector substraction .
subroutine, public device_copy(a_d, b_d, n, strm)
Copy a vector .
subroutine, public device_invcol3(a_d, b_d, c_d, n, strm)
Vector division .
subroutine, public device_pwmin3(a_d, b_d, c_d, n, strm)
Compute the point-wise minimum of two vectors .
subroutine, public device_power(ap_d, a_d, p, n, strm)
Take the power of a vector .
subroutine, public device_col2(a_d, b_d, n, strm)
Vector multiplication .
subroutine, public device_masked_gather_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm)
Gather a masked vector .
real(kind=rp) function, public device_vlsc3(u_d, v_d, w_d, n, strm)
Compute multiplication sum .
subroutine, public device_cdiv2(a_d, b_d, c, n, strm)
Division of constant c by array .
subroutine, public device_add5s4(a_d, b_d, c_d, d_d, e_d, c1, c2, c3, c4, n, strm)
Returns .
subroutine, public device_add4(a_d, b_d, c_d, d_d, n, strm)
subroutine, public device_cpwmax2(a_d, c, n, strm)
Compute the point-wise maximum of a vector and a scalar .
subroutine, public device_masked_copy_0(a_d, b_d, mask_d, n, n_mask, strm)
Copy a masked vector .
subroutine, public device_subcol3(a_d, b_d, c_d, n, strm)
Returns .
subroutine, public device_cdiv(a_d, c, n, strm)
Division of constant c by array .
subroutine, public device_absval(a_d, n, strm)
subroutine device_iadd(a_d, c, n, strm)
Add an integer scalar to vector .
subroutine, public device_masked_gather_copy_0(a_d, b_d, mask_d, n, n_mask, strm)
Gather a masked vector .
subroutine, public device_invcol2(a_d, b_d, n, strm)
Vector division .
subroutine, public device_addsqr2s2(a_d, b_d, c1, n, strm)
Returns .
real(kind=rp) function, public device_glsc3(a_d, b_d, c_d, n, strm)
Weighted inner product .
subroutine, public device_cpwmin3(a_d, b_d, c, n, strm)
Compute the point-wise minimum of a vector and a scalar .
subroutine, public device_cwrap(a_d, min_val, max_val, n, strm)
Wrap value around a range (min, max)
subroutine, public device_face_masked_gather_copy_0(a_d, b_d, mask_d, facet_d, n1, n2, lx, ly, lz, n_mask, strm)
Gather a face-local SEM field .
real(kind=rp) function, public device_glsc2(a_d, b_d, n, strm)
Weighted inner product .
subroutine, public device_cmult2(a_d, b_d, c, n, strm)
Multiplication by constant c .
subroutine, public device_masked_copy_aligned(a_d, b_d, mask_d, n, n_mask, strm)
Copy a masked vector .
subroutine, public device_col3(a_d, b_d, c_d, n, strm)
Vector multiplication with 3 vectors .
subroutine, public device_addcol4(a_d, b_d, c_d, d_d, n, strm)
Returns .
subroutine, public device_cfill(a_d, c, n, strm)
Set all elements to a constant c .
subroutine, public device_cpwmin2(a_d, c, n, strm)
Compute the point-wise minimum of a vector and a scalar .
subroutine, public device_add3(a_d, b_d, c_d, n, strm)
Vector addition .
subroutine, public device_sqrt_inplace(a_d, n, strm)
Sqrt a vector .
real(kind=rp) function, public device_glmin(a_d, n, strm)
Min of a vector of length n.
real(kind=rp) function, public device_glamax(a_d, n, strm)
Max of the absolute value of a vector of length n.
subroutine, public device_addcol3s2(a_d, b_d, c_d, s, n, strm)
Returns .
subroutine, public device_pwmax2(a_d, b_d, n, strm)
Compute the point-wise maximum of two vectors .
subroutine device_radd(a_d, c, n, strm)
Add a scalar to vector .
Device abstraction, common interface for various accelerators.
Definition device.F90:34
type(c_ptr), bind(C), public glb_cmd_queue
Global command queue.
Definition device.F90:52
integer, parameter, public c_xp
Definition num_types.f90:17
integer, parameter, public xp
Definition num_types.f90:16
integer, parameter, public c_rp
Definition num_types.f90:15
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:14
Utilities.
Definition utils.f90:35