Neko 1.99.7
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
tree_amg.f90
Go to the documentation of this file.
1! Copyright (c) 2024-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!
35 use num_types, only : rp
36 use utils, only : neko_error
37 use math, only : rzero, col2
40 use coefs, only : coef_t
41 use mesh, only : mesh_t
42 use space, only : space_t
43 use ax_product, only: ax_t
44 use bc_list, only: bc_list_t
45 use gather_scatter, only : gs_t, gs_op_add
49 use, intrinsic :: iso_c_binding
50 !$ use omp_lib, only : omp_get_thread_num
51 implicit none
52 private
53
55 type, private :: tamg_node_t
56 logical :: isleaf = .true.
57 integer :: gid = -1
58 integer :: lvl = -1
59 integer :: ndofs = 0
60 integer, allocatable :: dofs(:)
61 real(kind=rp) :: xyz(3)
62 real(kind=rp), allocatable :: interp_r(:)
63 real(kind=rp), allocatable :: interp_p(:)
64 contains
65 procedure, pass(this) :: free => node_free
66 end type tamg_node_t
67
69 type, private :: tamg_lvl_t
70 integer :: lvl = -1
71 integer :: nnodes = 0
72 type(tamg_node_t), allocatable :: nodes(:)
73 integer :: fine_lvl_dofs = 0
74 real(kind=rp), allocatable :: wrk_in(:)
75 type(c_ptr) :: wrk_in_d = c_null_ptr
76 real(kind=rp), allocatable :: wrk_out(:)
77 type(c_ptr) :: wrk_out_d = c_null_ptr
78 integer, allocatable :: map_finest2lvl(:)
79 type(c_ptr) :: map_finest2lvl_d = c_null_ptr
80 !--!
81 integer, allocatable :: map_f2c(:)
82 type(c_ptr) :: map_f2c_d = c_null_ptr
87 integer, allocatable :: agg_ptr(:)
88 integer, allocatable :: agg_dof(:)
94 real(kind=rp), allocatable :: agg_part(:,:)
95 contains
96 procedure, pass(this) :: free => lvl_free
97 end type tamg_lvl_t
98
100 type, public :: tamg_hierarchy_t
102 integer :: nlvls
104 type(tamg_lvl_t), allocatable :: lvl(:)
105
107 class(ax_t), pointer :: ax
108 type(mesh_t), pointer :: msh
109 type(space_t), pointer :: xh
110 type(coef_t), pointer :: coef
111 type(gs_t), pointer :: gs_h
112 type(bc_list_t), pointer :: blst
113
114 contains
115 procedure, pass(this) :: init => tamg_init
116 procedure, pass(this) :: free => tamg_free
117 procedure, pass(this) :: matvec => tamg_matvec
118 procedure, pass(this) :: matvec_impl => tamg_matvec_impl
119 procedure, pass(this) :: interp_f2c => tamg_restriction_operator
120 procedure, pass(this) :: interp_c2f => tamg_prolongation_operator
121 procedure, pass(this) :: interp_f2c_d => tamg_device_restriction_operator
122 procedure, pass(this) :: interp_c2f_d => tamg_device_prolongation_operator
123 procedure, pass(this) :: device_matvec => tamg_device_matvec_flat_impl
124 end type tamg_hierarchy_t
125
127
128contains
129
138 subroutine tamg_init(this, ax, Xh, coef, msh, gs_h, nlvls, blst)
139 class(tamg_hierarchy_t), target, intent(inout) :: this
140 class(ax_t), target, intent(in) :: ax
141 type(space_t),target, intent(in) :: Xh
142 type(coef_t), target, intent(in) :: coef
143 type(mesh_t), target, intent(in) :: msh
144 type(gs_t), target, intent(in) :: gs_h
145 integer, intent(in) :: nlvls
146 type(bc_list_t), target, intent(in) :: blst
147 integer :: i, n
148
149 this%ax => ax
150 this%msh => msh
151 this%Xh => xh
152 this%coef => coef
153 this%gs_h => gs_h
154 this%blst => blst
155
156 if (nlvls .lt. 2) then
157 call neko_error("Need to request at least two multigrid levels.")
158 end if
159
160 this%nlvls = nlvls
161 allocate( this%lvl(this%nlvls) )
162
163 do i = 1, nlvls
164 allocate( this%lvl(i)%map_finest2lvl( 0:coef%dof%size() ))
165 if (neko_bcknd_device .eq. 1) then
166 call device_map(this%lvl(i)%map_finest2lvl, this%lvl(i)%map_finest2lvl_d, coef%dof%size()+1)
167 end if
168 end do
169
170 end subroutine tamg_init
171
173 subroutine tamg_free(this)
174 class(tamg_hierarchy_t), intent(inout) :: this
175 integer :: i
176 if (allocated(this%lvl)) then
177 ! using size() instead of this%nlvls since
178 ! this%nlvls may be less than the allocated number of levels due to early
179 ! termination of aggregation
180 do i = 1, size(this%lvl)
181 call this%lvl(i)%free()
182 end do
183 deallocate(this%lvl)
184 end if
185 nullify(this%ax)
186 nullify(this%msh)
187 nullify(this%Xh)
188 nullify(this%coef)
189 nullify(this%gs_h)
190 nullify(this%blst)
191 end subroutine tamg_free
192
198 subroutine tamg_lvl_init(tamg_lvl, lvl, nnodes, ndofs)
199 type(tamg_lvl_t), intent(inout) :: tamg_lvl
200 integer, intent(in) :: lvl
201 integer, intent(in) :: nnodes
202 integer, intent(in) :: ndofs
203
204 tamg_lvl%lvl = lvl
205 tamg_lvl%nnodes = nnodes
206 allocate( tamg_lvl%nodes(tamg_lvl%nnodes) )
207 allocate( tamg_lvl%map_f2c(0:ndofs) )
208 if (neko_bcknd_device .eq. 1) then
209 call device_map(tamg_lvl%map_f2c, tamg_lvl%map_f2c_d, ndofs+1)
210 end if
211
212 tamg_lvl%fine_lvl_dofs = ndofs
213 allocate( tamg_lvl%wrk_in( ndofs ) )
214 allocate( tamg_lvl%wrk_out( ndofs ) )
215 if (neko_bcknd_device .eq. 1) then
216 call device_map(tamg_lvl%wrk_in, tamg_lvl%wrk_in_d, ndofs)
217 call device_cfill(tamg_lvl%wrk_in_d, 0.0_rp, ndofs)
218 call device_map(tamg_lvl%wrk_out, tamg_lvl%wrk_out_d, ndofs)
219 call device_cfill(tamg_lvl%wrk_out_d, 0.0_rp, ndofs)
220 ! Order the async fills against host writes; on unified memory
221 ! the device pointers may alias the work arrays
222 call device_sync()
223 end if
224 end subroutine tamg_lvl_init
225
227 subroutine lvl_free(this)
228 class(tamg_lvl_t), intent(inout) :: this
229 integer :: i
230
231 if (allocated(this%nodes)) then
232 do i = 1, this%nnodes
233 call this%nodes(i)%free()
234 end do
235 deallocate(this%nodes)
236 end if
237 if (allocated(this%wrk_in)) then
238 if (neko_bcknd_device .eq. 1 .and. c_associated(this%wrk_in_d)) then
239 call device_unmap(this%wrk_in, this%wrk_in_d)
240 end if
241 deallocate(this%wrk_in)
242 end if
243 if (allocated(this%wrk_out)) then
244 if (neko_bcknd_device .eq. 1 .and. c_associated(this%wrk_out_d)) then
245 call device_unmap(this%wrk_out, this%wrk_out_d)
246 end if
247 deallocate(this%wrk_out)
248 end if
249 if (allocated(this%map_f2c)) then
250 if (neko_bcknd_device .eq. 1 .and. c_associated(this%map_f2c_d)) then
251 call device_unmap(this%map_f2c, this%map_f2c_d)
252 end if
253 deallocate(this%map_f2c)
254 end if
255 if (allocated(this%map_finest2lvl)) then
256 if (neko_bcknd_device .eq. 1 .and. c_associated(this%map_finest2lvl_d)) then
257 call device_unmap(this%map_finest2lvl, this%map_finest2lvl_d)
258 end if
259 deallocate(this%map_finest2lvl)
260 end if
261 if (allocated(this%agg_ptr)) then
262 deallocate(this%agg_ptr)
263 end if
264 if (allocated(this%agg_dof)) then
265 deallocate(this%agg_dof)
266 end if
267 if (allocated(this%agg_part)) then
268 deallocate(this%agg_part)
269 end if
270 this%nnodes = 0
271 this%lvl = -1
272 this%fine_lvl_dofs = 0
273 end subroutine lvl_free
274
279 subroutine tamg_node_init(node, gid, ndofs)
280 type(tamg_node_t), intent(inout) :: node
281 integer, intent(in) :: gid
282 integer, intent(in) :: ndofs
283
284 node%gid = gid
285 node%ndofs = ndofs
286 allocate( node%dofs( node%ndofs) )
287 node%dofs = -1
288 allocate( node%interp_r( node%ndofs) )
289 allocate( node%interp_p( node%ndofs) )
290 node%interp_r = 1.0_rp
291 node%interp_p = 1.0_rp
292 end subroutine tamg_node_init
293
295 subroutine node_free(this)
296 class(tamg_node_t), intent(inout) :: this
297
298 if (allocated(this%dofs)) then
299 deallocate(this%dofs)
300 end if
301 if (allocated(this%interp_r)) then
302 deallocate(this%interp_r)
303 end if
304 if (allocated(this%interp_p)) then
305 deallocate(this%interp_p)
306 end if
307 end subroutine node_free
308
315 recursive subroutine tamg_matvec(this, vec_out, vec_in, lvl_out)
316 class(tamg_hierarchy_t), intent(inout) :: this
317 real(kind=rp), intent(inout) :: vec_out(:)
318 real(kind=rp), intent(inout) :: vec_in(:)
319 integer, intent(in) :: lvl_out
320 integer :: i, n, e
321 !call this%matvec_impl(vec_out, vec_in, this%nlvls, lvl_out)
322 call tamg_matvec_flat_impl(this, vec_out, vec_in, this%nlvls, lvl_out)
323 end subroutine tamg_matvec
324
332 recursive subroutine tamg_matvec_impl(this, vec_out, vec_in, lvl, lvl_out)
333 class(tamg_hierarchy_t), intent(inout) :: this
334 real(kind=rp), intent(inout) :: vec_out(:)
335 real(kind=rp), intent(inout) :: vec_in(:)
336 integer, intent(in) :: lvl
337 integer, intent(in) :: lvl_out
338 integer :: i, n, e
339
340 if (lvl .eq. 0) then
342 n = size(vec_in)
344 call this%gs_h%op(vec_in, n, gs_op_add)
345 call col2( vec_in, this%coef%mult, n)
346
347 call this%ax%compute(vec_out, vec_in, this%coef, this%msh, this%Xh)
348 call this%gs_h%op(vec_out, n, gs_op_add)
349 call this%blst%apply(vec_out, n)
350
351 if (lvl_out .ne. 0) then
352 call col2(vec_out, this%coef%mult, n)
353 end if
355 else
356 if (lvl_out .ge. lvl) then
359 associate( wrk_in => this%lvl(lvl)%wrk_in, wrk_out => this%lvl(lvl)%wrk_out)
360 n = this%lvl(lvl)%fine_lvl_dofs
361 call rzero(wrk_in, n)
362 call rzero(vec_out, this%lvl(lvl)%nnodes)
363 do n = 1, this%lvl(lvl)%nnodes
364 associate(node => this%lvl(lvl)%nodes(n))
365 do i = 1, node%ndofs
366 wrk_in( node%dofs(i) ) = wrk_in( node%dofs(i) ) + vec_in( node%gid ) * node%interp_p( i )
367 end do
368 end associate
369 end do
370
371 call this%matvec_impl(wrk_out, wrk_in, lvl-1, lvl_out)
372
374 do n = 1, this%lvl(lvl)%nnodes
375 associate(node => this%lvl(lvl)%nodes(n))
376 do i = 1, node%ndofs
377 vec_out( node%gid ) = vec_out(node%gid ) + wrk_out( node%dofs(i) ) * node%interp_r( i )
378 end do
379 end associate
380 end do
381 end associate
382 else if (lvl_out .lt. lvl) then
384 call this%matvec_impl(vec_out, vec_in, lvl-1, lvl_out)
385 else
386 call neko_error("TAMG: matvec level numbering problem.")
387 end if
388 end if
389 end subroutine tamg_matvec_impl
390
391
393 recursive subroutine tamg_matvec_flat_impl(this, vec_out, vec_in, lvl_blah, lvl_out)
394 class(tamg_hierarchy_t), intent(inout) :: this
395 real(kind=rp), intent(inout) :: vec_out(:)
396 real(kind=rp), intent(inout) :: vec_in(:)
397 integer, intent(in) :: lvl_blah
398 integer, intent(in) :: lvl_out
399 integer :: i, n, lvl, c, k, nagg, tid, nthrds
400 real(kind=rp) :: val, acc
401 logical :: use_partials
402
403 lvl = lvl_out
404 n = this%lvl(1)%fine_lvl_dofs
405 if (lvl .eq. 0) then
406 call this%ax%compute(vec_out, vec_in, this%coef, this%msh, this%Xh)
407 call this%gs_h%op(vec_out, n, gs_op_add)
408 call this%blst%apply(vec_out, n)
409 else
410 ! Hoisted out of the associate below: associate names in OpenMP
411 ! data-sharing contexts have been unreliable with frt and CCE, and
412 ! an associate name to an allocatable is not itself allocatable, so
413 ! the branch below cannot query it.
414 nagg = this%lvl(lvl)%nnodes
415 use_partials = allocated(this%lvl(lvl)%agg_part)
416 nthrds = 1
417 if (use_partials) nthrds = size(this%lvl(lvl)%agg_part, 2)
418
419 ! agg_part is deliberately not associated here: it is unallocated on
420 ! the levels that take the aggregate-parallel branch, and associating
421 ! with an unallocated allocatable is not conforming even when the
422 ! branch using it is never taken.
423 associate( wrk_in => this%lvl(1)%wrk_in, &
424 wrk_out => this%lvl(1)%wrk_out, &
425 aptr => this%lvl(lvl)%agg_ptr, adof => this%lvl(lvl)%agg_dof, &
426 map => this%lvl(lvl)%map_finest2lvl)
427
431 !$omp parallel do private(c, k, val)
432 do c = 1, nagg
433 val = vec_in(c)
434 do k = aptr(c), aptr(c + 1) - 1
435 wrk_in(adof(k)) = val
436 end do
437 end do
438 !$omp end parallel do
439
441 call this%gs_h%op(wrk_in, n, gs_op_add)
442 call col2( wrk_in, this%coef%mult, n)
443 call this%blst%apply(wrk_in, n)
444
446 call this%ax%compute(wrk_out, wrk_in, this%coef, this%msh, this%Xh)
447 call this%gs_h%op(wrk_out, n, gs_op_add)
448 call this%blst%apply(wrk_out, n)
449
450 call col2(wrk_out, this%coef%mult, n)
451
459 if (.not. use_partials) then
460 !$omp parallel do private(c, k, acc)
461 do c = 1, nagg
462 acc = 0.0_rp
463 do k = aptr(c), aptr(c + 1) - 1
464 acc = acc + wrk_out(adof(k))
465 end do
466 vec_out(c) = acc
467 end do
468 !$omp end parallel do
469 else
479 this%lvl(lvl)%agg_part = 0.0_rp
480
481 !$omp parallel num_threads(nthrds) private(tid, i, c)
482 tid = 1
483 !$ tid = omp_get_thread_num() + 1
484 !$omp do
485 do i = 1, n
486 c = map(i)
487 this%lvl(lvl)%agg_part(c, tid) = &
488 this%lvl(lvl)%agg_part(c, tid) + wrk_out(i)
489 end do
490 !$omp end do
491 !$omp end parallel
492
493 do c = 1, nagg
494 acc = 0.0_rp
495 do k = 1, nthrds
496 acc = acc + this%lvl(lvl)%agg_part(c, k)
497 end do
498 vec_out(c) = acc
499 end do
500 end if
501 end associate
502 end if
503 end subroutine tamg_matvec_flat_impl
504
505
506
511 subroutine tamg_restriction_operator(this, vec_out, vec_in, lvl)
512 class(tamg_hierarchy_t), intent(inout) :: this
513 real(kind=rp), intent(inout) :: vec_out(:)
514 real(kind=rp), intent(inout) :: vec_in(:)
515 integer, intent(in) :: lvl
516 integer :: i, n, nagg, node_start, node_end, node_id
517 real(kind=rp) :: acc
518
519 vec_out = 0d0
520 if (lvl-1 .eq. 0) then
521 call col2(vec_in, this%coef%mult, this%lvl(lvl)%fine_lvl_dofs)
522 end if
523 nagg = this%lvl(lvl)%nnodes
524 ! Each node contributes to vec_out(node%gid) only, and gids are unique
525 ! across the nodes of a level, so the writes are already disjoint:
526 ! accumulate into a scalar and the node loop threads as-is. Indexed
527 ! rather than associated, since associate names inside an OpenMP loop
528 ! have been unreliable with frt and CCE.
529 !$omp parallel do private(i, acc)
530 do n = 1, nagg
531 acc = 0.0_rp
532 do i = 1, this%lvl(lvl)%nodes(n)%ndofs
533 acc = acc + vec_in( this%lvl(lvl)%nodes(n)%dofs(i) ) &
534 * this%lvl(lvl)%nodes(n)%interp_r( i )
535 end do
536 vec_out( this%lvl(lvl)%nodes(n)%gid ) = acc
537 end do
538 !$omp end parallel do
539 end subroutine tamg_restriction_operator
540
545 subroutine tamg_prolongation_operator(this, vec_out, vec_in, lvl)
546 class(tamg_hierarchy_t), intent(inout) :: this
547 real(kind=rp), intent(inout) :: vec_out(:)
548 real(kind=rp), intent(inout) :: vec_in(:)
549 integer, intent(in) :: lvl
550 integer :: i, n, nagg, node_start, node_end, node_id
551 real(kind=rp) :: val
552
553 vec_out = 0d0
554 nagg = this%lvl(lvl)%nnodes
555 ! The nodes of a level partition the dofs of the level below (checked
556 ! once in build_agg_csr), so no two nodes write the same vec_out entry
557 ! and the node loop threads as-is. vec_in(node%gid) is loop-invariant,
558 ! hoist it. Indexed rather than associated, since associate names
559 ! inside an OpenMP loop have been unreliable with frt and CCE.
560 !$omp parallel do private(i, val)
561 do n = 1, nagg
562 val = vec_in( this%lvl(lvl)%nodes(n)%gid )
563 do i = 1, this%lvl(lvl)%nodes(n)%ndofs
564 vec_out( this%lvl(lvl)%nodes(n)%dofs(i) ) = &
565 vec_out( this%lvl(lvl)%nodes(n)%dofs(i) ) &
566 + val * this%lvl(lvl)%nodes(n)%interp_p( i )
567 end do
568 end do
569 !$omp end parallel do
570 if (lvl-1 .eq. 0) then
571 call this%gs_h%op(vec_out, this%lvl(lvl)%fine_lvl_dofs, gs_op_add)
572 call col2(vec_out, this%coef%mult, this%lvl(lvl)%fine_lvl_dofs)
573 call this%blst%apply(vec_out, this%lvl(lvl)%fine_lvl_dofs)
574 end if
575 end subroutine tamg_prolongation_operator
576
577
578 subroutine tamg_device_matvec_flat_impl(this, vec_out, vec_in, vec_out_d, vec_in_d, lvl_out)
579 class(tamg_hierarchy_t), intent(inout) :: this
580 real(kind=rp), intent(inout) :: vec_out(:)
581 real(kind=rp), intent(inout) :: vec_in(:)
582 type(c_ptr) :: vec_out_d
583 type(c_ptr) :: vec_in_d
584 integer, intent(in) :: lvl_out
585 integer :: i, n, cdof, lvl
586
587 lvl = lvl_out
588 n = this%lvl(1)%fine_lvl_dofs
589 if (lvl .eq. 0) then
590 call this%ax%compute(vec_out, vec_in, this%coef, this%msh, this%Xh)
591 call this%gs_h%op(vec_out, n, gs_op_add, glb_cmd_event)
592 call device_stream_wait_event(glb_cmd_queue, glb_cmd_event, 0)
593 call this%blst%apply(vec_out, n)
594 else
595
596 associate( wrk_in_d => this%lvl(1)%wrk_in_d, wrk_out_d => this%lvl(1)%wrk_out_d)
598 call device_masked_gather_copy_0(wrk_in_d, vec_in_d, this%lvl(lvl)%map_finest2lvl_d, this%lvl(lvl)%nnodes, n)
600 call this%gs_h%op(this%lvl(1)%wrk_in, n, gs_op_add, glb_cmd_event)
601 call device_stream_wait_event(glb_cmd_queue, glb_cmd_event, 0)
602 call device_col2( wrk_in_d, this%coef%mult_d, n)
603 call this%blst%apply(this%lvl(1)%wrk_in, n)
604
606 call this%ax%compute(this%lvl(1)%wrk_out, this%lvl(1)%wrk_in, this%coef, this%msh, this%Xh)
607 call this%gs_h%op(this%lvl(1)%wrk_out, n, gs_op_add, glb_cmd_event)
608 call device_stream_wait_event(glb_cmd_queue, glb_cmd_event, 0)
609 call this%blst%apply(this%lvl(1)%wrk_out, n)
610
611 call device_col2( wrk_out_d, this%coef%mult_d, n)
612
614 call device_rzero(vec_out_d, this%lvl(lvl)%nnodes)
615 call device_masked_atomic_reduction_0(vec_out_d, wrk_out_d, this%lvl(lvl)%map_finest2lvl_d, this%lvl(lvl)%nnodes, n)
616 end associate
617
618 end if
619 end subroutine tamg_device_matvec_flat_impl
620
621 subroutine tamg_device_restriction_operator(this, vec_out_d, vec_in_d, lvl)
622 class(tamg_hierarchy_t), intent(inout) :: this
623 type(c_ptr) :: vec_out_d
624 type(c_ptr) :: vec_in_d
625 integer, intent(in) :: lvl
626 integer :: i, n, m
627 n = this%lvl(lvl)%nnodes
628 m = this%lvl(lvl)%fine_lvl_dofs
629 if (lvl-1 .eq. 0) then
630 call device_col2(vec_in_d, this%coef%mult_d, m)
631 end if
632 call device_rzero(vec_out_d, n)
633 call device_masked_atomic_reduction_0(vec_out_d, vec_in_d, this%lvl(lvl)%map_f2c_d, n, m)
635
636 subroutine tamg_device_prolongation_operator(this, vec_out_d, vec_in_d, lvl, vec_out)
637 class(tamg_hierarchy_t), intent(inout) :: this
638 real(kind=rp), intent(inout) :: vec_out(:)
639 type(c_ptr) :: vec_out_d
640 type(c_ptr) :: vec_in_d
641 integer, intent(in) :: lvl
642 integer :: i, n, m
643 n = this%lvl(lvl)%nnodes
644 m = this%lvl(lvl)%fine_lvl_dofs
645 call device_masked_gather_copy_0(vec_out_d, vec_in_d, this%lvl(lvl)%map_f2c_d, n, m)
646 if (lvl-1 .eq. 0) then
647 call this%gs_h%op(vec_out, m, gs_op_add, glb_cmd_event)
648 call device_stream_wait_event(glb_cmd_queue, glb_cmd_event, 0)
649 call device_col2( vec_out_d, this%coef%mult_d, m)
650 call this%blst%apply( vec_out, m)
651 end if
653
654end module tree_amg
Map a Fortran array to a device (allocate and associate)
Definition device.F90:83
Synchronize a device or stream.
Definition device.F90:119
Unmap a Fortran array from a device (deassociate and free)
Definition device.F90:89
Defines a Matrix-vector product.
Definition ax.f90:34
Defines a list of bc_t.
Definition bc_list.f90:34
Coefficients.
Definition coef.f90:34
subroutine, public device_masked_atomic_reduction_0(a_d, b_d, mask_d, n, n_mask, strm)
subroutine, public device_rzero(a_d, n, strm)
Zero a real vector.
subroutine, public device_col2(a_d, b_d, n, strm)
Vector multiplication .
subroutine, public device_masked_gather_copy_0(a_d, b_d, mask_d, n, n_mask, strm)
Gather a masked vector .
subroutine, public device_cfill(a_d, c, n, strm)
Set all elements to a constant c .
Device abstraction, common interface for various accelerators.
Definition device.F90:34
subroutine, public device_stream_wait_event(stream, event, flags)
Synchronize a device stream with an event.
Definition device.F90:1544
type(c_ptr), bind(C), public glb_cmd_queue
Global command queue.
Definition device.F90:52
type(c_ptr), bind(C), public glb_cmd_event
Event for the global command queue.
Definition device.F90:63
Gather-scatter.
NEKTON map.
Definition map.f90:3
Definition math.f90:60
subroutine, public col2(a, b, n)
Vector multiplication .
Definition math.f90:1046
subroutine, public rzero(a, n)
Zero a real vector.
Definition math.f90:235
Defines a mesh.
Definition mesh.f90:34
Build configurations.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Defines a function space.
Definition space.f90:34
Implements the base type for TreeAMG hierarchy structure.
Definition tree_amg.f90:34
subroutine tamg_device_matvec_flat_impl(this, vec_out, vec_in, vec_out_d, vec_in_d, lvl_out)
Definition tree_amg.f90:579
subroutine tamg_device_prolongation_operator(this, vec_out_d, vec_in_d, lvl, vec_out)
Definition tree_amg.f90:637
subroutine lvl_free(this)
deallocate tamg level
Definition tree_amg.f90:228
recursive subroutine tamg_matvec_impl(this, vec_out, vec_in, lvl, lvl_out)
Matrix vector product using the TreeAMG hierarchy structure b=Ax done as vec_out = A * vec_in This is...
Definition tree_amg.f90:333
subroutine, public tamg_node_init(node, gid, ndofs)
Initialization of a TreeAMG tree node.
Definition tree_amg.f90:280
subroutine tamg_restriction_operator(this, vec_out, vec_in, lvl)
Restriction operator for TreeAMG. vec_out = R * vec_in.
Definition tree_amg.f90:512
subroutine tamg_prolongation_operator(this, vec_out, vec_in, lvl)
Prolongation operator for TreeAMG. vec_out = P * vec_in.
Definition tree_amg.f90:546
subroutine node_free(this)
deallocate tamg tree node
Definition tree_amg.f90:296
subroutine, public tamg_lvl_init(tamg_lvl, lvl, nnodes, ndofs)
Initialization of a TreeAMG level.
Definition tree_amg.f90:199
subroutine tamg_free(this)
deallocate tamg hierarchy
Definition tree_amg.f90:174
recursive subroutine tamg_matvec(this, vec_out, vec_in, lvl_out)
Wrapper for matrix vector product using the TreeAMG hierarchy structure b=Ax done as vec_out = A * ve...
Definition tree_amg.f90:316
subroutine tamg_device_restriction_operator(this, vec_out_d, vec_in_d, lvl)
Definition tree_amg.f90:622
subroutine tamg_init(this, ax, xh, coef, msh, gs_h, nlvls, blst)
Initialization of TreeAMG hierarchy.
Definition tree_amg.f90:139
recursive subroutine tamg_matvec_flat_impl(this, vec_out, vec_in, lvl_blah, lvl_out)
Ignore this. For piecewise constant, can create index map directly to finest level.
Definition tree_amg.f90:394
Utilities.
Definition utils.f90:35
Base type for a matrix-vector product providing .
Definition ax.f90:43
A list of allocatable `bc_t`. Follows the standard interface of lists.
Definition bc_list.f90:49
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Definition coef.f90:63
Gather-scatter kernel.
The function space for the SEM solution fields.
Definition space.f90:64
Type for a TreeAMG hierarchy.
Definition tree_amg.f90:100
Type for storing TreeAMG level information.
Definition tree_amg.f90:69
Type for storing TreeAMG tree node information.
Definition tree_amg.f90:55