Neko 1.99.6
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
vector_math.f90
Go to the documentation of this file.
1! Copyright (c) 2008-2020, UCHICAGO ARGONNE, LLC.
2!
3! The UChicago Argonne, LLC as Operator of Argonne National
4! Laboratory holds copyright in the Software. The copyright holder
5! reserves all rights except those expressly granted to licensees,
6! and U.S. Government license rights.
7!
8! Redistribution and use in source and binary forms, with or without
9! modification, are permitted provided that the following conditions
10! are met:
11!
12! 1. Redistributions of source code must retain the above copyright
13! notice, this list of conditions and the disclaimer below.
14!
15! 2. Redistributions in binary form must reproduce the above copyright
16! notice, this list of conditions and the disclaimer (as noted below)
17! in the documentation and/or other materials provided with the
18! distribution.
19!
20! 3. Neither the name of ANL nor the names of its contributors
21! may be used to endorse or promote products derived from this software
22! without specific prior written permission.
23!
24! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
25! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
26! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
27! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
28! UCHICAGO ARGONNE, LLC, THE U.S. DEPARTMENT OF
29! ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
30! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
31! TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
32! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
33! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
34! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
35! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36!
37! Additional BSD Notice
38! ---------------------
39! 1. This notice is required to be provided under our contract with
40! the U.S. Department of Energy (DOE). This work was produced at
41! Argonne National Laboratory under Contract
42! No. DE-AC02-06CH11357 with the DOE.
43!
44! 2. Neither the United States Government nor UCHICAGO ARGONNE,
45! LLC nor any of their employees, makes any warranty,
46! express or implied, or assumes any liability or responsibility for the
47! accuracy, completeness, or usefulness of any information, apparatus,
48! product, or process disclosed, or represents that its use would not
49! infringe privately-owned rights.
50!
51! 3. Also, reference herein to any specific commercial products, process,
52! or services by trade name, trademark, manufacturer or otherwise does
53! not necessarily constitute or imply its endorsement, recommendation,
54! or favoring by the United States Government or UCHICAGO ARGONNE LLC.
55! The views and opinions of authors expressed
56! herein do not necessarily state or reflect those of the United States
57! Government or UCHICAGO ARGONNE, LLC, and shall
58! not be used for advertising or product endorsement purposes.
59!
62 use num_types, only : rp
63 use vector, only : vector_t
64 use mask, only : mask_t
65 use device, only : device_get_ptr
66 use utils, only : neko_error
67 use math, only : rzero, rone, copy, cmult, cadd, cfill, invcol1, vdot3, &
86 use, intrinsic :: iso_c_binding, only : c_ptr
87 implicit none
88 private
89
102
103contains
104
106 subroutine vector_rzero(a, n)
107 integer, intent(in), optional :: n
108 type(vector_t), intent(inout) :: a
109 integer :: size
110
111 if (present(n)) then
112 size = n
113 else
114 size = a%size()
115 end if
116
117 if (neko_bcknd_device .eq. 1) then
118 call device_rzero(a%x_d, size)
119 else
120 call rzero(a%x, size)
121 end if
122 end subroutine vector_rzero
123
125 subroutine vector_rone(a, n)
126 integer, intent(in), optional :: n
127 type(vector_t), intent(inout) :: a
128 integer :: size
129
130 if (present(n)) then
131 size = n
132 else
133 size = a%size()
134 end if
135
136 if (neko_bcknd_device .eq. 1) then
137 call device_rone(a%x_d, size)
138 else
139 call rone(a%x, size)
140 end if
141 end subroutine vector_rone
142
144 subroutine vector_copy(a, b, n)
145 integer, intent(in), optional :: n
146 type(vector_t), intent(in) :: b
147 type(vector_t), intent(inout) :: a
148 integer :: size
149
150 if (present(n)) then
151 size = n
152 else
153 size = a%size()
154 end if
155
156 if (neko_bcknd_device .eq. 1) then
157 call device_copy(a%x_d, b%x_d, size)
158 else
159 call copy(a%x, b%x, size)
160 end if
161 end subroutine vector_copy
162
164 subroutine vector_cmult(a, c, n)
165 integer, intent(in), optional :: n
166 type(vector_t), intent(inout) :: a
167 real(kind=rp), intent(in) :: c
168 integer :: size
169
170 if (present(n)) then
171 size = n
172 else
173 size = a%size()
174 end if
175
176 if (neko_bcknd_device .eq. 1) then
177 call device_cmult(a%x_d, c, size)
178 else
179 call cmult(a%x, c, size)
180 end if
181 end subroutine vector_cmult
182
184 subroutine vector_cadd(a, s, n)
185 integer, intent(in), optional :: n
186 type(vector_t), intent(inout) :: a
187 real(kind=rp), intent(in) :: s
188 integer :: size
189
190 if (present(n)) then
191 size = n
192 else
193 size = a%size()
194 end if
195
196 if (neko_bcknd_device .eq. 1) then
197 call device_cadd(a%x_d, s, size)
198 else
199 call cadd(a%x, s, size)
200 end if
201 end subroutine vector_cadd
202
204 subroutine vector_cadd2(a, b, s, n)
205 integer, intent(in), optional :: n
206 type(vector_t), intent(inout) :: a
207 type(vector_t), intent(in) :: b
208 real(kind=rp), intent(in) :: s
209 integer :: size
210
211 if (present(n)) then
212 size = n
213 else
214 size = a%size()
215 end if
216
217 if (neko_bcknd_device .eq. 1) then
218 call device_cadd2(a%x_d, b%x_d, s, size)
219 else
220 call cadd2(a%x, b%x, s, size)
221 end if
222 end subroutine vector_cadd2
223
224
226 subroutine vector_cfill(a, c, n)
227 integer, intent(in), optional :: n
228 type(vector_t), intent(inout) :: a
229 real(kind=rp), intent(in) :: c
230 integer :: size
231
232 if (present(n)) then
233 size = n
234 else
235 size = a%size()
236 end if
237
238 if (neko_bcknd_device .eq. 1) then
239 call device_cfill(a%x_d, c, size)
240 else
241 call cfill(a%x, c, size)
242 end if
243 end subroutine vector_cfill
244
246 subroutine vector_invcol1(a, n)
247 integer, intent(in), optional :: n
248 type(vector_t), intent(inout) :: a
249 integer :: size
250
251 if (present(n)) then
252 size = n
253 else
254 size = a%size()
255 end if
256
257 if (neko_bcknd_device .eq. 1) then
258 call device_invcol1(a%x_d, size)
259 else
260 call invcol1(a%x, size)
261 end if
262
263 end subroutine vector_invcol1
264
266 subroutine vector_invcol3(a, b, c, n)
267 integer, intent(in), optional :: n
268 type(vector_t), intent(inout) :: a
269 type(vector_t), intent(in) :: b
270 type(vector_t), intent(in) :: c
271 integer :: size
272
273 if (present(n)) then
274 size = n
275 else
276 size = a%size()
277 end if
278
279 if (neko_bcknd_device .eq. 1) then
280 call device_invcol3(a%x_d, b%x_d, c%x_d, size)
281 else
282 call invcol3(a%x, b%x, c%x, size)
283 end if
284
285 end subroutine vector_invcol3
286
289 subroutine vector_vdot3(dot, u1, u2, u3, v1, v2, v3, n)
290 integer, intent(in), optional :: n
291 type(vector_t), intent(in) :: u1, u2, u3
292 type(vector_t), intent(in) :: v1, v2, v3
293 type(vector_t), intent(inout) :: dot
294 integer :: size
295
296 if (present(n)) then
297 size = n
298 else
299 size = dot%size()
300 end if
301
302 if (neko_bcknd_device .eq. 1) then
303 call device_vdot3(dot%x_d, &
304 u1%x_d, u2%x_d, u3%x_d, &
305 v1%x_d, v2%x_d, v3%x_d, &
306 size)
307 else
308 call vdot3(dot%x, &
309 u1%x, u2%x, u3%x, &
310 v1%x, v2%x, v3%x, &
311 size)
312 end if
313
314 end subroutine vector_vdot3
315
317 subroutine vector_add2(a, b, n)
318 integer, intent(in), optional :: n
319 type(vector_t), intent(inout) :: a
320 type(vector_t), intent(in) :: b
321 integer :: size
322
323 if (present(n)) then
324 size = n
325 else
326 size = a%size()
327 end if
328
329 if (neko_bcknd_device .eq. 1) then
330 call device_add2(a%x_d, b%x_d, size)
331 else
332 call add2(a%x, b%x, size)
333 end if
334
335 end subroutine vector_add2
336
338 subroutine vector_add3(a, b, c, n)
339 integer, intent(in), optional :: n
340 type(vector_t), intent(inout) :: a
341 type(vector_t), intent(in) :: b, c
342 integer :: size
343
344 if (present(n)) then
345 size = n
346 else
347 size = a%size()
348 end if
349
350 if (neko_bcknd_device .eq. 1) then
351 call device_add3(a%x_d, b%x_d, c%x_d, size)
352 else
353 call add3(a%x, b%x, c%x, size)
354 end if
355
356 end subroutine vector_add3
357
359 subroutine vector_add4(a, b, c, d, n)
360 integer, intent(in), optional :: n
361 type(vector_t), intent(inout) :: a
362 type(vector_t), intent(in) :: b, c, d
363 integer :: size
364
365 if (present(n)) then
366 size = n
367 else
368 size = a%size()
369 end if
370
371 if (neko_bcknd_device .eq. 1) then
372 call device_add4(a%x_d, b%x_d, c%x_d, d%x_d, size)
373 else
374 call add4(a%x, b%x, c%x, d%x, size)
375 end if
376
377 end subroutine vector_add4
378
380 subroutine vector_sub2(a, b, n)
381 integer, intent(in), optional :: n
382 type(vector_t), intent(inout) :: a
383 type(vector_t), intent(inout) :: b
384 integer :: size
385
386 if (present(n)) then
387 size = n
388 else
389 size = a%size()
390 end if
391
392 if (neko_bcknd_device .eq. 1) then
393 call device_sub2(a%x_d, b%x_d, size)
394 else
395 call sub2(a%x, b%x, size)
396 end if
397
398 end subroutine vector_sub2
399
401 subroutine vector_sub3(a, b, c, n)
402 integer, intent(in), optional :: n
403 type(vector_t), intent(inout) :: a
404 type(vector_t), intent(in) :: b
405 type(vector_t), intent(in) :: c
406 integer :: size
407
408 if (present(n)) then
409 size = n
410 else
411 size = a%size()
412 end if
413
414 if (neko_bcknd_device .eq. 1) then
415 call device_sub3(a%x_d, b%x_d, c%x_d, size)
416 else
417 call sub3(a%x, b%x, c%x, size)
418 end if
419
420 end subroutine vector_sub3
421
422
425 subroutine vector_add2s1(a, b, c1, n)
426 integer, intent(in), optional :: n
427 type(vector_t), intent(inout) :: a
428 type(vector_t), intent(inout) :: b
429 real(kind=rp), intent(in) :: c1
430 integer :: size
431
432 if (present(n)) then
433 size = n
434 else
435 size = a%size()
436 end if
437
438 if (neko_bcknd_device .eq. 1) then
439 call device_add2s1(a%x_d, b%x_d, c1, size)
440 else
441 call add2s1(a%x, b%x, c1, size)
442 end if
443
444 end subroutine vector_add2s1
445
448 subroutine vector_add2s2(a, b, c1, n)
449 integer, intent(in), optional :: n
450 type(vector_t), intent(inout) :: a
451 type(vector_t), intent(in) :: b
452 real(kind=rp), intent(in) :: c1
453 integer :: size
454
455 if (present(n)) then
456 size = n
457 else
458 size = a%size()
459 end if
460
461 if (neko_bcknd_device .eq. 1) then
462 call device_add2s2(a%x_d, b%x_d, c1, size)
463 else
464 call add2s2(a%x, b%x, c1, size)
465 end if
466
467 end subroutine vector_add2s2
468
470 subroutine vector_addsqr2s2(a, b, c1, n)
471 integer, intent(in), optional :: n
472 type(vector_t), intent(inout) :: a
473 type(vector_t), intent(in) :: b
474 real(kind=rp), intent(in) :: c1
475 integer :: size
476
477 if (present(n)) then
478 size = n
479 else
480 size = a%size()
481 end if
482
483 if (neko_bcknd_device .eq. 1) then
484 call device_addsqr2s2(a%x_d, b%x_d, c1, size)
485 else
486 call addsqr2s2(a%x, b%x, c1, size)
487 end if
488
489 end subroutine vector_addsqr2s2
490
492 subroutine vector_cmult2(a, b, c, n)
493 integer, intent(in), optional :: n
494 type(vector_t), intent(inout) :: a
495 type(vector_t), intent(in) :: b
496 real(kind=rp), intent(in) :: c
497 integer :: size
498
499 if (present(n)) then
500 size = n
501 else
502 size = a%size()
503 end if
504
505 if (neko_bcknd_device .eq. 1) then
506 call device_cmult2(a%x_d, b%x_d, c, size)
507 else
508 call cmult2(a%x, b%x, c, size)
509 end if
510
511 end subroutine vector_cmult2
512
514 subroutine vector_invcol2(a, b, n)
515 integer, intent(in), optional :: n
516 type(vector_t), intent(inout) :: a
517 type(vector_t), intent(in) :: b
518 integer :: size
519
520 if (present(n)) then
521 size = n
522 else
523 size = a%size()
524 end if
525
526 if (neko_bcknd_device .eq. 1) then
527 call device_invcol2(a%x_d, b%x_d, size)
528 else
529 call invcol2(a%x, b%x, size)
530 end if
531
532 end subroutine vector_invcol2
533
534
536 subroutine vector_col2(a, b, n)
537 integer, intent(in), optional :: n
538 type(vector_t), intent(inout) :: a
539 type(vector_t), intent(in) :: b
540 integer :: size
541
542 if (present(n)) then
543 size = n
544 else
545 size = a%size()
546 end if
547
548 if (neko_bcknd_device .eq. 1) then
549 call device_col2(a%x_d, b%x_d, size)
550 else
551 call col2(a%x, b%x, size)
552 end if
553
554 end subroutine vector_col2
555
557 subroutine vector_col3(a, b, c, n)
558 integer, intent(in), optional :: n
559 type(vector_t), intent(inout) :: a
560 type(vector_t), intent(in) :: b
561 type(vector_t), intent(in) :: c
562 integer :: size
563
564 if (present(n)) then
565 size = n
566 else
567 size = a%size()
568 end if
569
570 if (neko_bcknd_device .eq. 1) then
571 call device_col3(a%x_d, b%x_d, c%x_d, size)
572 else
573 call col3(a%x, b%x, c%x, size)
574 end if
575
576 end subroutine vector_col3
577
579 subroutine vector_subcol3(a, b, c, n)
580 integer, intent(in), optional :: n
581 type(vector_t), intent(inout) :: a
582 type(vector_t), intent(in) :: b
583 type(vector_t), intent(in) :: c
584 integer :: size
585
586 if (present(n)) then
587 size = n
588 else
589 size = a%size()
590 end if
591
592 if (neko_bcknd_device .eq. 1) then
593 call device_subcol3(a%x_d, b%x_d, c%x_d, size)
594 else
595 call subcol3(a%x, b%x, c%x, size)
596 end if
597
598 end subroutine vector_subcol3
599
601 subroutine vector_add3s2(a, b, c, c1, c2, n)
602 integer, intent(in), optional :: n
603 type(vector_t), intent(inout) :: a
604 type(vector_t), intent(in) :: b
605 type(vector_t), intent(in) :: c
606 real(kind=rp), intent(in) :: c1, c2
607 integer :: size
608
609 if (present(n)) then
610 size = n
611 else
612 size = a%size()
613 end if
614
615 if (neko_bcknd_device .eq. 1) then
616 call device_add3s2(a%x_d, b%x_d, c%x_d, c1, c2, size)
617 else
618 call add3s2(a%x, b%x, c%x, c1, c2, size)
619 end if
620
621 end subroutine vector_add3s2
622
624 subroutine vector_addcol3(a, b, c, n)
625 integer, intent(in), optional :: n
626 type(vector_t), intent(inout) :: a
627 type(vector_t), intent(in) :: b
628 type(vector_t), intent(in) :: c
629 integer :: size
630
631 if (present(n)) then
632 size = n
633 else
634 size = a%size()
635 end if
636
637 if (neko_bcknd_device .eq. 1) then
638 call device_addcol3(a%x_d, b%x_d, c%x_d, size)
639 else
640 call addcol3(a%x, b%x, c%x, size)
641 end if
642
643 end subroutine vector_addcol3
644
646 subroutine vector_addcol4(a, b, c, d, n)
647 integer, intent(in), optional :: n
648 type(vector_t), intent(inout) :: a
649 type(vector_t), intent(in) :: b
650 type(vector_t), intent(in) :: c
651 type(vector_t), intent(in) :: d
652 integer :: size
653
654 if (present(n)) then
655 size = n
656 else
657 size = a%size()
658 end if
659
660 if (neko_bcknd_device .eq. 1) then
661 call device_addcol4(a%x_d, b%x_d, c%x_d, d%x_d, size)
662 else
663 call addcol4(a%x, b%x, c%x, d%x, size)
664 end if
665
666 end subroutine vector_addcol4
667
668 function vector_glsum(a, n) result(sum)
669 integer, intent(in), optional :: n
670 type(vector_t), intent(in) :: a
671 real(kind=rp) :: sum
672 integer :: size
673
674 if (present(n)) then
675 size = n
676 else
677 size = a%size()
678 end if
679
680 if (neko_bcknd_device .eq. 1) then
681 sum = device_glsum(a%x_d, size)
682 else
683 sum = glsum(a%x, size)
684 end if
685
686 end function vector_glsum
687
689 function vector_glmax(a, n) result(val)
690 integer, intent(in), optional :: n
691 type(vector_t), intent(in) :: a
692 real(kind=rp) :: val
693 integer :: size
694
695 if (present(n)) then
696 size = n
697 else
698 size = a%size()
699 end if
700
701 if (neko_bcknd_device .eq. 1) then
702 val = device_glmax(a%x_d, size)
703 else
704 val = glmax(a%x, size)
705 end if
706
707 end function vector_glmax
708
710 function vector_glmin(a, n) result(val)
711 integer, intent(in), optional :: n
712 type(vector_t), intent(in) :: a
713 real(kind=rp) :: val
714 integer :: size
715
716 if (present(n)) then
717 size = n
718 else
719 size = a%size()
720 end if
721
722 if (neko_bcknd_device .eq. 1) then
723 val = device_glmin(a%x_d, size)
724 else
725 val = glmin(a%x, size)
726 end if
727
728 end function vector_glmin
729
730 function vector_glsc2(a, b, n) result(norm)
731 integer, intent(in), optional :: n
732 type(vector_t), intent(in) :: a, b
733 real(kind=rp) :: norm
734 integer :: size
735
736 if (present(n)) then
737 size = n
738 else
739 size = a%size()
740 end if
741
742 if (neko_bcknd_device .eq. 1) then
743 norm = device_glsc2(a%x_d, b%x_d, size)
744 else
745 norm = glsc2(a%x, b%x, size)
746 end if
747
748 end function vector_glsc2
749
750 function vector_glsc3(a, b, c, n) result(norm)
751 integer, intent(in), optional :: n
752 type(vector_t), intent(in) :: a, b, c
753 real(kind=rp) :: norm
754 integer :: size
755
756 if (present(n)) then
757 size = n
758 else
759 size = a%size()
760 end if
761
762 if (neko_bcknd_device .eq. 1) then
763 norm = device_glsc3(a%x_d, b%x_d, c%x_d, size)
764 else
765 norm = glsc3(a%x, b%x, c%x, size)
766 end if
767
768 end function vector_glsc3
769
771 subroutine vector_absval(a, n)
772 integer, intent(in), optional :: n
773 type(vector_t), intent(inout) :: a
774 integer :: size
775
776 if (present(n)) then
777 size = n
778 else
779 size = a%size()
780 end if
781
782 if (neko_bcknd_device .eq. 1) then
783 call device_absval(a%x_d, size)
784 else
785 call absval(a%x, size)
786 end if
787
788 end subroutine vector_absval
789
790 function vector_glsubnorm(a, b, n) result(norm)
791 integer, intent(in), optional :: n
792 type(vector_t), intent(in) :: a, b
793 real(kind=rp) :: norm
794 integer :: size
795
796 if (present(n)) then
797 size = n
798 else
799 size = a%size()
800 end if
801
802 if (neko_bcknd_device .eq. 1) then
803 norm = device_glsubnorm(a%x_d, b%x_d, size)
804 else
805 norm = glsubnorm(a%x, b%x, size)
806 end if
807
808 end function vector_glsubnorm
809
818 subroutine vector_masked_gather_copy_0(a, b, mask, n, n_mask)
819 integer, intent(in) :: n, n_mask
820 type(vector_t), intent(inout) :: a
821 real(kind=rp), dimension(n), intent(in) :: b
822 integer, dimension(0:n_mask) :: mask
823 type(c_ptr) :: mask_d, b_d
824
825 if (n .lt. 1 .or. n_mask .lt. 1) return !Avoid getting null pointers
826
827 if (neko_bcknd_device .eq. 1) then
828 mask_d = device_get_ptr(mask)
829 b_d = device_get_ptr(b)
830 call device_masked_gather_copy_0(a%x_d, b_d, mask_d, n, n_mask)
831 else
832 call masked_gather_copy_0(a%x, b, mask, n, n_mask)
833 end if
834
835 end subroutine vector_masked_gather_copy_0
836
846 subroutine vector_face_masked_gather_copy_0(a, b, mask, facet, lx, ly, lz, &
847 n_mask)
848 integer, intent(in) :: lx, ly, lz, n_mask
849 type(vector_t), intent(inout) :: a
850 real(kind=rp), dimension(:, :, :, :), intent(in) :: b
851 integer, dimension(0:n_mask), intent(in) :: mask
852 integer, dimension(0:n_mask), intent(in) :: facet
853 type(c_ptr) :: mask_d, facet_d, b_d
854
855 if (neko_bcknd_device .eq. 1) then
856 mask_d = device_get_ptr(mask)
857 facet_d = device_get_ptr(facet)
858 b_d = device_get_ptr(b)
859 call device_face_masked_gather_copy_0(a%x_d, b_d, mask_d, facet_d, &
860 size(b, 1), size(b, 2), lx, ly, lz, n_mask)
861 else
862 call face_masked_gather_copy_0(a%x, b, mask, facet, lx, ly, lz, n_mask)
863 end if
864
866
873 subroutine vector_masked_gather_copy(a, b, mask, n)
874 type(vector_t), intent(inout) :: a
875 real(kind=rp), dimension(:), intent(in) :: b
876 type(mask_t), intent(in) :: mask
877 integer, intent(in) :: n
878 type(c_ptr) :: mask_d, b_d
879
880 if (n .lt. 1 .or. mask%size() .lt. 1) return !Avoid getting null pointers
881
882 if (neko_bcknd_device .eq. 1) then
883 mask_d = mask%get_d()
884 b_d = device_get_ptr(b)
885 call device_masked_gather_copy_aligned(a%x_d, b_d, mask_d, n, &
886 mask%size())
887 else
888 call masked_gather_copy(a%x, b, mask%get(), n, mask%size())
889 end if
890
891 end subroutine vector_masked_gather_copy
892
901 subroutine vector_masked_scatter_copy_0(a, b, mask, n, n_mask)
902 integer, intent(in) :: n, n_mask
903 real(kind=rp), dimension(n), intent(inout) :: a
904 type(vector_t), intent(in) :: b
905 integer, dimension(0:n_mask) :: mask
906 type(c_ptr) :: mask_d, a_d
907
908 if (n .lt. 1 .or. n_mask .lt. 1) return !Avoid getting null pointers
909
910 if (neko_bcknd_device .eq. 1) then
911 a_d = device_get_ptr(a)
912 mask_d = device_get_ptr(mask)
913 call device_masked_scatter_copy_0(a_d, b%x_d, mask_d, n, n_mask)
914 else
915 call masked_scatter_copy_0(a, b%x, mask, n, n_mask)
916 end if
917
918 end subroutine vector_masked_scatter_copy_0
919
926 subroutine vector_masked_scatter_copy(a, b, mask, n)
927 real(kind=rp), dimension(:), intent(inout) :: a
928 type(vector_t), intent(in) :: b
929 type(mask_t), intent(in) :: mask
930 integer, intent(in) :: n
931 type(c_ptr) :: mask_d, a_d
932
933 if (n .lt. 1 .or. mask%size() .lt. 1) return !Avoid getting null pointers
934
935 if (neko_bcknd_device .eq. 1) then
936 a_d = device_get_ptr(a)
937 mask_d = mask%get_d()
938 call device_masked_scatter_copy_aligned(a_d, b%x_d, mask_d, n, &
939 mask%size())
940 else
941 call masked_scatter_copy(a, b%x, mask%get(), n, mask%size())
942 end if
943
944 end subroutine vector_masked_scatter_copy
945
947 subroutine vector_cwrap(a, min_value, max_value, n)
948 integer, intent(in), optional :: n
949 type(vector_t), intent(inout) :: a
950 real(kind=rp), intent(in) :: min_value, max_value
951 integer :: size
952
953 if (present(n)) then
954 size = n
955 else
956 size = a%size()
957 end if
958
959 if (a%size() .lt. 1) return ! Avoid getting null pointers
960
961 if (neko_bcknd_device .eq. 1) then
962 call device_cwrap(a%x_d, min_value, max_value, size)
963 else
964 call cwrap(a%x, min_value, max_value, size)
965 end if
966
967 end subroutine vector_cwrap
968
970 subroutine vector_sqrt_inplace(a, n)
971 integer, intent(in), optional :: n
972 type(vector_t), intent(inout) :: a
973 integer :: size
974
975 if (present(n)) then
976 size = n
977 else
978 size = a%size()
979 end if
980
981 if (neko_bcknd_device .eq. 1) then
982 call device_sqrt_inplace(a%x_d, size)
983 else
984 call sqrt_inplace(a%x, size)
985 end if
986
987 end subroutine vector_sqrt_inplace
988
990 subroutine vector_power(ap, a, p, n)
991 integer, intent(in), optional :: n
992 type(vector_t), intent(inout) :: ap
993 type(vector_t), intent(in) :: a
994 real(kind=rp), intent(in) :: p
995 integer :: size
996
997 if (present(n)) then
998 size = n
999 else
1000 size = a%size()
1001 end if
1002
1003 if (neko_bcknd_device .eq. 1) then
1004 call device_power(ap%x_d, a%x_d, p, size)
1005 else
1006 call power(ap%x, a%x, p, size)
1007 end if
1008
1009 end subroutine vector_power
1010
1011
1012end module vector_math
Return the device pointer for an associated Fortran array.
Definition device.F90:113
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_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_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_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_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_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_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 .
subroutine, public device_add4(a_d, b_d, c_d, d_d, n, strm)
subroutine, public device_subcol3(a_d, b_d, c_d, n, strm)
Returns .
subroutine, public device_absval(a_d, n, strm)
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_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_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_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.
Device abstraction, common interface for various accelerators.
Definition device.F90:34
Object for handling masks in Neko.
Definition mask.f90:34
Definition math.f90:60
subroutine, public cmult(a, c, n)
Multiplication by constant c .
Definition math.f90:504
subroutine, public cmult2(a, b, c, n)
Multiplication by constant c .
Definition math.f90:519
subroutine, public invcol2(a, b, n)
Vector division .
Definition math.f90:1030
subroutine, public sqrt_inplace(a, n)
Sqrt a vector .
Definition math.f90:1878
real(kind=rp) function, public glsc3(a, b, c, n)
Weighted inner product .
Definition math.f90:1287
subroutine, public masked_scatter_copy(a, b, mask, n, n_mask)
Scatter a contigous vector to masked positions in a target array .
Definition math.f90:470
subroutine, public cadd2(a, b, s, n)
Add a scalar to vector .
Definition math.f90:581
subroutine, public face_masked_gather_copy_0(a, b, mask, facet, lx, ly, lz, n_mask)
Gather values from a face-local SEM field to a reduced contiguous vector.
Definition math.f90:385
subroutine, public cadd(a, s, n)
Add a scalar to vector .
Definition math.f90:566
subroutine, public addsqr2s2(a, b, c1, n)
Returns .
Definition math.f90:1014
subroutine, public cwrap(a, min_val, max_val, n)
Wrap value around a range [min, max)
Definition math.f90:612
subroutine, public add2s1(a, b, c1, n)
Vector addition with scalar multiplication (multiplication on first argument)
Definition math.f90:981
real(kind=rp) function, public glsc2(a, b, n)
Weighted inner product .
Definition math.f90:1266
subroutine, public masked_scatter_copy_0(a, b, mask, n, n_mask)
Scatter a contigous vector to masked positions in a target array .
Definition math.f90:445
subroutine, public subcol3(a, b, c, n)
Returns .
Definition math.f90:1077
subroutine, public rone(a, n)
Set all elements to one.
Definition math.f90:277
subroutine, public masked_gather_copy(a, b, mask, n, n_mask)
Gather a masked vector to reduced contigous vector .
Definition math.f90:420
subroutine, public add3(a, b, c, n)
Vector addition .
Definition math.f90:915
real(kind=rp) function, public glsum(a, n)
Sum a vector of length n.
Definition math.f90:629
subroutine, public sub3(a, b, c, n)
Vector subtraction .
Definition math.f90:963
subroutine, public addcol4(a, b, c, d, n)
Returns .
Definition math.f90:1180
subroutine, public add2(a, b, n)
Vector addition .
Definition math.f90:900
subroutine, public cfill(a, c, n)
Set all elements to a constant c .
Definition math.f90:597
subroutine, public absval(a, n)
Take the absolute value of an array.
Definition math.f90:1640
subroutine, public invcol3(a, b, c, n)
Invert a vector .
Definition math.f90:785
subroutine, public add3s2(a, b, c, c1, c2, n)
Returns .
Definition math.f90:1093
subroutine, public masked_gather_copy_0(a, b, mask, n, n_mask)
Gather a masked vector to reduced contigous vector .
Definition math.f90:360
subroutine, public addcol3(a, b, c, n)
Returns .
Definition math.f90:1164
subroutine, public invcol1(a, n)
Invert a vector .
Definition math.f90:771
subroutine, public col2(a, b, n)
Vector multiplication .
Definition math.f90:1046
real(kind=rp) function, public glmax(a, n)
Max of a vector of length n.
Definition math.f90:650
subroutine, public copy(a, b, n)
Copy a vector .
Definition math.f90:291
subroutine, public add4(a, b, c, d, n)
Vector addition .
Definition math.f90:931
subroutine, public col3(a, b, c, n)
Vector multiplication with 3 vectors .
Definition math.f90:1061
subroutine, public vdot3(dot, u1, u2, u3, v1, v2, v3, n)
Compute a dot product (3-d version) assuming vector components etc.
Definition math.f90:852
subroutine, public rzero(a, n)
Zero a real vector.
Definition math.f90:235
real(kind=rp) function, public glsubnorm(a, b, n)
Returns the norm of the difference of two vectors .
Definition math.f90:1333
subroutine, public sub2(a, b, n)
Vector substraction .
Definition math.f90:948
subroutine, public add2s2(a, b, c1, n)
Vector addition with scalar multiplication (multiplication on second argument)
Definition math.f90:998
real(kind=rp) function, public glmin(a, n)
Min of a vector of length n.
Definition math.f90:688
subroutine, public power(ap, a, p, n)
Take the power of a vector .
Definition math.f90:1892
Build configurations.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Utilities.
Definition utils.f90:35
subroutine, public vector_masked_gather_copy_0(a, b, mask, n, n_mask)
Gather a vector to reduced contigous array .
real(kind=rp) function, public vector_glmin(a, n)
Global minimum of all elements in a vector .
real(kind=rp) function, public vector_glsc3(a, b, c, n)
subroutine, public vector_add2(a, b, n)
Vector addition .
subroutine, public vector_vdot3(dot, u1, u2, u3, v1, v2, v3, n)
Compute a dot product (3-d version) assuming vector components etc.
subroutine, public vector_copy(a, b, n)
Copy a vector .
subroutine, public vector_sub3(a, b, c, n)
Vector subtraction .
subroutine, public vector_power(ap, a, p, n)
Take the power of a vector .
subroutine, public vector_cmult(a, c, n)
Multiplication by constant c .
subroutine, public vector_invcol1(a, n)
Invert a vector .
subroutine, public vector_add3s2(a, b, c, c1, c2, n)
Returns .
subroutine, public vector_masked_gather_copy(a, b, mask, n)
Gather a vector to reduced contigous array .
subroutine, public vector_sub2(a, b, n)
Vector substraction .
subroutine, public vector_face_masked_gather_copy_0(a, b, mask, facet, lx, ly, lz, n_mask)
Gather a face-local SEM field to a reduced contiguous vector.
subroutine, public vector_addsqr2s2(a, b, c1, n)
Returns .
subroutine, public vector_absval(a, n)
Compute the pointwise absolute value of a vector .
subroutine, public vector_col2(a, b, n)
Vector multiplication .
subroutine, public vector_cadd2(a, b, s, n)
Add a scalar to vector .
subroutine, public vector_cfill(a, c, n)
Set all elements to a constant c .
real(kind=rp) function, public vector_glsum(a, n)
subroutine, public vector_cwrap(a, min_value, max_value, n)
Wrap vector elements into the range [min_value, max_value)
real(kind=rp) function, public vector_glsc2(a, b, n)
subroutine, public vector_addcol3(a, b, c, n)
Returns .
real(kind=rp) function, public vector_glsubnorm(a, b, n)
subroutine, public vector_invcol2(a, b, n)
Vector division .
subroutine, public vector_sqrt_inplace(a, n)
Sqrt a vector .
subroutine, public vector_subcol3(a, b, c, n)
Returns .
subroutine, public vector_cadd(a, s, n)
Add a scalar to vector .
subroutine vector_add4(a, b, c, d, n)
Vector addition .
subroutine, public vector_add3(a, b, c, n)
Vector addition .
real(kind=rp) function, public vector_glmax(a, n)
Global maximum of all elements in a vector .
subroutine, public vector_add2s1(a, b, c1, n)
Vector addition with scalar multiplication (multiplication on first argument)
subroutine, public vector_add2s2(a, b, c1, n)
Vector addition with scalar multiplication (multiplication on second argument)
subroutine, public vector_addcol4(a, b, c, d, n)
Returns .
subroutine, public vector_masked_scatter_copy(a, b, mask, n)
Scatter a contiguous vector into an array .
subroutine, public vector_cmult2(a, b, c, n)
Multiplication by constant c .
subroutine, public vector_rone(a, n)
Set all elements to one.
subroutine, public vector_rzero(a, n)
Zero a real vector.
subroutine, public vector_col3(a, b, c, n)
Vector multiplication with 3 vectors .
subroutine, public vector_masked_scatter_copy_0(a, b, mask, n, n_mask)
Scatter a contiguous vector into an array .
subroutine, public vector_invcol3(a, b, c, n)
Invert a vector .
Defines a vector.
Definition vector.f90:34
Type for consistently handling masks in Neko. This type encapsulates the mask array and its associate...
Definition mask.f90:51