Neko 1.99.6
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-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!
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
1665 subroutine device_absval(a_d, n, strm)
1666 integer, intent(in) :: n
1667 type(c_ptr) :: a_d
1668 type(c_ptr), optional :: strm
1669 type(c_ptr) :: strm_
1670
1671 if (n .lt. 1) return
1672
1673 if (present(strm)) then
1674 strm_ = strm
1675 else
1676 strm_ = glb_cmd_queue
1677 end if
1678
1679#ifdef HAVE_HIP
1680 call hip_absval(a_d, n, strm_)
1681#elif HAVE_CUDA
1682 call cuda_absval(a_d, n, strm_)
1683#elif HAVE_OPENCL
1684 call opencl_absval(a_d, n, strm_)
1685#elif HAVE_METAL
1686 call metal_absval(a_d, n, strm_)
1687#else
1688 call neko_error('No device backend configured')
1689#endif
1690
1691 end subroutine device_absval
1692
1693 ! ========================================================================== !
1694 ! Device point-wise max
1695
1698 subroutine device_pwmax2(a_d, b_d, n, strm)
1699 type(c_ptr) :: a_d, b_d
1700 integer :: n
1701 type(c_ptr), optional :: strm
1702 type(c_ptr) :: strm_
1703
1704 if (n .lt. 1) return
1705
1706 if (present(strm)) then
1707 strm_ = strm
1708 else
1709 strm_ = glb_cmd_queue
1710 end if
1711
1712#if HAVE_HIP
1713 call hip_pwmax_vec2(a_d, b_d, n, strm_)
1714#elif HAVE_CUDA
1715 call cuda_pwmax_vec2(a_d, b_d, n, strm_)
1716#elif HAVE_OPENCL
1717 call opencl_pwmax_vec2(a_d, b_d, n, strm_)
1718#elif HAVE_METAL
1719 call metal_pwmax_vec2(a_d, b_d, n, strm_)
1720#else
1721 call neko_error('No device backend configured')
1722#endif
1723 end subroutine device_pwmax2
1724
1727 subroutine device_pwmax3(a_d, b_d, c_d, n, strm)
1728 type(c_ptr) :: a_d, b_d, c_d
1729 integer :: n
1730 type(c_ptr), optional :: strm
1731 type(c_ptr) :: strm_
1732
1733 if (n .lt. 1) return
1734
1735 if (present(strm)) then
1736 strm_ = strm
1737 else
1738 strm_ = glb_cmd_queue
1739 end if
1740
1741#if HAVE_HIP
1742 call hip_pwmax_vec3(a_d, b_d, c_d, n, strm_)
1743#elif HAVE_CUDA
1744 call cuda_pwmax_vec3(a_d, b_d, c_d, n, strm_)
1745#elif HAVE_OPENCL
1746 call opencl_pwmax_vec3(a_d, b_d, c_d, n, strm_)
1747#elif HAVE_METAL
1748 call metal_pwmax_vec3(a_d, b_d, c_d, n, strm_)
1749#else
1750 call neko_error('No device backend configured')
1751#endif
1752
1753 end subroutine device_pwmax3
1754
1757 subroutine device_cpwmax2(a_d, c, n, strm)
1758 type(c_ptr) :: a_d
1759 real(kind=rp), intent(in) :: c
1760 integer :: n
1761 type(c_ptr), optional :: strm
1762 type(c_ptr) :: strm_
1763
1764 if (n .lt. 1) return
1765
1766 if (present(strm)) then
1767 strm_ = strm
1768 else
1769 strm_ = glb_cmd_queue
1770 end if
1771
1772#if HAVE_HIP
1773 call hip_pwmax_sca2(a_d, c, n, strm_)
1774#elif HAVE_CUDA
1775 call cuda_pwmax_sca2(a_d, c, n, strm_)
1776#elif HAVE_OPENCL
1777 call opencl_pwmax_sca2(a_d, c, n, strm_)
1778#elif HAVE_METAL
1779 call metal_pwmax_sca2(a_d, c, n, strm_)
1780#else
1781 call neko_error('No device backend configured')
1782#endif
1783
1784 end subroutine device_cpwmax2
1785
1788 subroutine device_cpwmax3(a_d, b_d, c, n, strm)
1789 type(c_ptr) :: a_d, b_d
1790 real(kind=rp), intent(in) :: c
1791 integer :: n
1792 type(c_ptr), optional :: strm
1793 type(c_ptr) :: strm_
1794
1795 if (n .lt. 1) return
1796
1797 if (present(strm)) then
1798 strm_ = strm
1799 else
1800 strm_ = glb_cmd_queue
1801 end if
1802
1803#if HAVE_HIP
1804 call hip_pwmax_sca3(a_d, b_d, c, n, strm_)
1805#elif HAVE_CUDA
1806 call cuda_pwmax_sca3(a_d, b_d, c, n, strm_)
1807#elif HAVE_OPENCL
1808 call opencl_pwmax_sca3(a_d, b_d, c, n, strm_)
1809#elif HAVE_METAL
1810 call metal_pwmax_sca3(a_d, b_d, c, n, strm_)
1811#else
1812 call neko_error('No device backend configured')
1813#endif
1814
1815 end subroutine device_cpwmax3
1816
1817 ! ========================================================================== !
1818 ! Device point-wise min
1819
1822 subroutine device_pwmin2(a_d, b_d, n, strm)
1823 type(c_ptr) :: a_d, b_d
1824 integer :: n
1825 type(c_ptr), optional :: strm
1826 type(c_ptr) :: strm_
1827
1828 if (n .lt. 1) return
1829
1830 if (present(strm)) then
1831 strm_ = strm
1832 else
1833 strm_ = glb_cmd_queue
1834 end if
1835
1836#if HAVE_HIP
1837 call hip_pwmin_vec2(a_d, b_d, n, strm_)
1838#elif HAVE_CUDA
1839 call cuda_pwmin_vec2(a_d, b_d, n, strm_)
1840#elif HAVE_OPENCL
1841 call opencl_pwmin_vec2(a_d, b_d, n, strm_)
1842#elif HAVE_METAL
1843 call metal_pwmin_vec2(a_d, b_d, n, strm_)
1844#else
1845 call neko_error('No device backend configured')
1846#endif
1847 end subroutine device_pwmin2
1848
1851 subroutine device_pwmin3(a_d, b_d, c_d, n, strm)
1852 type(c_ptr) :: a_d, b_d, c_d
1853 integer :: n
1854 type(c_ptr), optional :: strm
1855 type(c_ptr) :: strm_
1856
1857 if (n .lt. 1) return
1858
1859 if (present(strm)) then
1860 strm_ = strm
1861 else
1862 strm_ = glb_cmd_queue
1863 end if
1864
1865#if HAVE_HIP
1866 call hip_pwmin_vec3(a_d, b_d, c_d, n, strm_)
1867#elif HAVE_CUDA
1868 call cuda_pwmin_vec3(a_d, b_d, c_d, n, strm_)
1869#elif HAVE_OPENCL
1870 call opencl_pwmin_vec3(a_d, b_d, c_d, n, strm_)
1871#elif HAVE_METAL
1872 call metal_pwmin_vec3(a_d, b_d, c_d, n, strm_)
1873#else
1874 call neko_error('No device backend configured')
1875#endif
1876
1877 end subroutine device_pwmin3
1878
1881 subroutine device_cpwmin2(a_d, c, n, strm)
1882 type(c_ptr) :: a_d
1883 real(kind=rp), intent(in) :: c
1884 integer :: n
1885 type(c_ptr), optional :: strm
1886 type(c_ptr) :: strm_
1887
1888 if (n .lt. 1) return
1889
1890 if (present(strm)) then
1891 strm_ = strm
1892 else
1893 strm_ = glb_cmd_queue
1894 end if
1895
1896#if HAVE_HIP
1897 call hip_pwmin_sca2(a_d, c, n, strm_)
1898#elif HAVE_CUDA
1899 call cuda_pwmin_sca2(a_d, c, n, strm_)
1900#elif HAVE_OPENCL
1901 call opencl_pwmin_sca2(a_d, c, n, strm_)
1902#elif HAVE_METAL
1903 call metal_pwmin_sca2(a_d, c, n, strm_)
1904#else
1905 call neko_error('No device backend configured')
1906#endif
1907
1908 end subroutine device_cpwmin2
1909
1912 subroutine device_cpwmin3(a_d, b_d, c, n, strm)
1913 type(c_ptr) :: a_d, b_d
1914 real(kind=rp), intent(in) :: c
1915 integer :: n
1916 type(c_ptr), optional :: strm
1917 type(c_ptr) :: strm_
1918
1919 if (n .lt. 1) return
1920
1921 if (present(strm)) then
1922 strm_ = strm
1923 else
1924 strm_ = glb_cmd_queue
1925 end if
1926
1927#if HAVE_HIP
1928 call hip_pwmin_sca3(a_d, b_d, c, n, strm_)
1929#elif HAVE_CUDA
1930 call cuda_pwmin_sca3(a_d, b_d, c, n, strm_)
1931#elif HAVE_OPENCL
1932 call opencl_pwmin_sca3(a_d, b_d, c, n, strm_)
1933#elif HAVE_METAL
1934 call metal_pwmin_sca3(a_d, b_d, c, n, strm_)
1935#else
1936 call neko_error('No device backend configured')
1937#endif
1938
1939 end subroutine device_cpwmin3
1940
1941 ! ========================================================================== !
1942 ! Integer operations
1943
1945 subroutine device_iadd(a_d, c, n, strm)
1946 type(c_ptr), intent(inout) :: a_d
1947 integer, intent(in) :: c
1948 integer, intent(in) :: n
1949 type(c_ptr), optional :: strm
1950 type(c_ptr) :: strm_
1951 if (n .lt. 1) return
1952
1953 if (present(strm)) then
1954 strm_ = strm
1955 else
1956 strm_ = glb_cmd_queue
1957 end if
1958
1959#if HAVE_HIP
1960 call hip_iadd(a_d, c, n, strm_)
1961#elif HAVE_CUDA
1962 call cuda_iadd(a_d, c, n, strm_)
1963#elif HAVE_OPENCL
1964 call opencl_iadd(a_d, c, n, strm_)
1965#elif HAVE_METAL
1966 call metal_iadd(a_d, c, n, strm_)
1967#else
1968 call neko_error('No device backend configured')
1969#endif
1970 end subroutine device_iadd
1971
1972
1973end 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.
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:15
integer, parameter, public xp
Definition num_types.f90:14
integer, parameter, public c_rp
Definition num_types.f90:13
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Utilities.
Definition utils.f90:35