49 use,
intrinsic :: iso_c_binding
56 logical :: isleaf = .true.
60 integer,
allocatable :: dofs(:)
61 real(kind=
rp) :: xyz(3)
62 real(kind=
rp),
allocatable :: interp_r(:)
63 real(kind=
rp),
allocatable :: interp_p(:)
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
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(:,:)
138 subroutine tamg_init(this, ax, Xh, coef, msh, gs_h, nlvls, blst)
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
156 if (nlvls .lt. 2)
then
157 call neko_error(
"Need to request at least two multigrid levels.")
161 allocate( this%lvl(this%nlvls) )
164 allocate( this%lvl(i)%map_finest2lvl( 0:coef%dof%size() ))
166 call device_map(this%lvl(i)%map_finest2lvl, this%lvl(i)%map_finest2lvl_d, coef%dof%size()+1)
176 if (
allocated(this%lvl))
then
180 do i = 1,
size(this%lvl)
181 call this%lvl(i)%free()
200 integer,
intent(in) :: lvl
201 integer,
intent(in) :: nnodes
202 integer,
intent(in) :: ndofs
205 tamg_lvl%nnodes = nnodes
206 allocate( tamg_lvl%nodes(tamg_lvl%nnodes) )
207 allocate( tamg_lvl%map_f2c(0:ndofs) )
209 call device_map(tamg_lvl%map_f2c, tamg_lvl%map_f2c_d, ndofs+1)
212 tamg_lvl%fine_lvl_dofs = ndofs
213 allocate( tamg_lvl%wrk_in( ndofs ) )
214 allocate( tamg_lvl%wrk_out( ndofs ) )
216 call device_map(tamg_lvl%wrk_in, tamg_lvl%wrk_in_d, ndofs)
218 call device_map(tamg_lvl%wrk_out, tamg_lvl%wrk_out_d, ndofs)
231 if (
allocated(this%nodes))
then
232 do i = 1, this%nnodes
233 call this%nodes(i)%free()
235 deallocate(this%nodes)
237 if (
allocated(this%wrk_in))
then
241 deallocate(this%wrk_in)
243 if (
allocated(this%wrk_out))
then
247 deallocate(this%wrk_out)
249 if (
allocated(this%map_f2c))
then
253 deallocate(this%map_f2c)
255 if (
allocated(this%map_finest2lvl))
then
257 call device_unmap(this%map_finest2lvl, this%map_finest2lvl_d)
259 deallocate(this%map_finest2lvl)
261 if (
allocated(this%agg_ptr))
then
262 deallocate(this%agg_ptr)
264 if (
allocated(this%agg_dof))
then
265 deallocate(this%agg_dof)
267 if (
allocated(this%agg_part))
then
268 deallocate(this%agg_part)
272 this%fine_lvl_dofs = 0
281 integer,
intent(in) :: gid
282 integer,
intent(in) :: ndofs
286 allocate( node%dofs( node%ndofs) )
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
298 if (
allocated(this%dofs))
then
299 deallocate(this%dofs)
301 if (
allocated(this%interp_r))
then
302 deallocate(this%interp_r)
304 if (
allocated(this%interp_p))
then
305 deallocate(this%interp_p)
317 real(kind=
rp),
intent(inout) :: vec_out(:)
318 real(kind=
rp),
intent(inout) :: vec_in(:)
319 integer,
intent(in) :: lvl_out
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
344 call this%gs_h%op(vec_in, n, gs_op_add)
345 call col2( vec_in, this%coef%mult, n)
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)
351 if (lvl_out .ne. 0)
then
352 call col2(vec_out, this%coef%mult, n)
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))
366 wrk_in( node%dofs(i) ) = wrk_in( node%dofs(i) ) + vec_in( node%gid ) * node%interp_p( i )
371 call this%matvec_impl(wrk_out, wrk_in, lvl-1, lvl_out)
374 do n = 1, this%lvl(lvl)%nnodes
375 associate(node => this%lvl(lvl)%nodes(n))
377 vec_out( node%gid ) = vec_out(node%gid ) + wrk_out( node%dofs(i) ) * node%interp_r( i )
382 else if (lvl_out .lt. lvl)
then
384 call this%matvec_impl(vec_out, vec_in, lvl-1, lvl_out)
386 call neko_error(
"TAMG: matvec level numbering problem.")
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
404 n = this%lvl(1)%fine_lvl_dofs
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)
414 nagg = this%lvl(lvl)%nnodes
415 use_partials =
allocated(this%lvl(lvl)%agg_part)
417 if (use_partials) nthrds =
size(this%lvl(lvl)%agg_part, 2)
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)
434 do k = aptr(c), aptr(c + 1) - 1
435 wrk_in(adof(k)) = val
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)
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)
450 call col2(wrk_out, this%coef%mult, n)
459 if (.not. use_partials)
then
463 do k = aptr(c), aptr(c + 1) - 1
464 acc = acc + wrk_out(adof(k))
479 this%lvl(lvl)%agg_part = 0.0_rp
487 this%lvl(lvl)%agg_part(c, tid) = &
488 this%lvl(lvl)%agg_part(c, tid) + wrk_out(i)
496 acc = acc + this%lvl(lvl)%agg_part(c, k)
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
520 if (lvl-1 .eq. 0)
then
521 call col2(vec_in, this%coef%mult, this%lvl(lvl)%fine_lvl_dofs)
523 nagg = this%lvl(lvl)%nnodes
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 )
536 vec_out( this%lvl(lvl)%nodes(n)%gid ) = acc
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
554 nagg = this%lvl(lvl)%nnodes
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 )
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)
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
588 n = this%lvl(1)%fine_lvl_dofs
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)
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)
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)
611 call device_col2( wrk_out_d, this%coef%mult_d, n)
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)
623 type(c_ptr) :: vec_out_d
624 type(c_ptr) :: vec_in_d
625 integer,
intent(in) :: lvl
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)
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)
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
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)
Map a Fortran array to a device (allocate and associate)
Synchronize a device or stream.
Unmap a Fortran array from a device (deassociate and free)
Defines a Matrix-vector product.
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.
subroutine, public device_stream_wait_event(stream, event, flags)
Synchronize a device stream with an event.
type(c_ptr), bind(C), public glb_cmd_queue
Global command queue.
type(c_ptr), bind(C), public glb_cmd_event
Event for the global command queue.
subroutine, public col2(a, b, n)
Vector multiplication .
subroutine, public rzero(a, n)
Zero a real vector.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Defines a function space.
Implements the base type for TreeAMG hierarchy structure.
subroutine tamg_device_matvec_flat_impl(this, vec_out, vec_in, vec_out_d, vec_in_d, lvl_out)
subroutine tamg_device_prolongation_operator(this, vec_out_d, vec_in_d, lvl, vec_out)
subroutine lvl_free(this)
deallocate tamg level
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...
subroutine, public tamg_node_init(node, gid, ndofs)
Initialization of a TreeAMG tree node.
subroutine tamg_restriction_operator(this, vec_out, vec_in, lvl)
Restriction operator for TreeAMG. vec_out = R * vec_in.
subroutine tamg_prolongation_operator(this, vec_out, vec_in, lvl)
Prolongation operator for TreeAMG. vec_out = P * vec_in.
subroutine node_free(this)
deallocate tamg tree node
subroutine, public tamg_lvl_init(tamg_lvl, lvl, nnodes, ndofs)
Initialization of a TreeAMG level.
subroutine tamg_free(this)
deallocate tamg hierarchy
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...
subroutine tamg_device_restriction_operator(this, vec_out_d, vec_in_d, lvl)
subroutine tamg_init(this, ax, xh, coef, msh, gs_h, nlvls, blst)
Initialization of TreeAMG hierarchy.
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.
Base type for a matrix-vector product providing .
A list of allocatable `bc_t`. Follows the standard interface of lists.
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
The function space for the SEM solution fields.
Type for a TreeAMG hierarchy.
Type for storing TreeAMG level information.
Type for storing TreeAMG tree node information.