-
Notifications
You must be signed in to change notification settings - Fork 14
/
Copy pathpsb_s_oacc_csr_scal.F90
53 lines (45 loc) · 1.38 KB
/
psb_s_oacc_csr_scal.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
submodule (psb_s_oacc_csr_mat_mod) psb_s_oacc_csr_scal_impl
use psb_base_mod
contains
module subroutine psb_s_oacc_csr_scal(d, a, info, side)
implicit none
class(psb_s_oacc_csr_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act
character(len=20) :: name='scal'
logical, parameter :: debug=.false.
integer(psb_ipk_) :: i, j
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_host()) call a%sync()
if (present(side)) then
if (side == 'L') then
!$acc parallel loop present(a, d)
do i = 1, a%get_nrows()
do j = a%irp(i), a%irp(i+1) - 1
a%val(j) = a%val(j) * d(i)
end do
end do
else if (side == 'R') then
!$acc parallel loop present(a, d)
do i = 1, a%get_ncols()
do j = a%irp(i), a%irp(i+1) - 1
a%val(j) = a%val(j) * d(a%ja(j))
end do
end do
end if
else
!$acc parallel loop present(a, d)
do i = 1, size(a%val)
a%val(i) = a%val(i) * d(i)
end do
end if
call a%set_dev()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_oacc_csr_scal
end submodule psb_s_oacc_csr_scal_impl