fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Minor change to HLL

Browse Source
development
sfilippone 3 days ago
parent caca3613a3
commit 850e0d1cc1
4 changed files with 268 additions and 272 deletions
Show Stats Download Patch File Download Diff File

135
ext/impl/psb_c_hll_csmv.f90
Unescape Escape View File

@ -144,7 +144,7 @@ subroutine psb_c_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_c_hll_csmv_notra_4(i,mxrwl,a%irn(i),& & call psb_c_hll_csmv_notra_4(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -162,7 +162,7 @@ subroutine psb_c_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
&call psb_c_hll_csmv_notra_8(i,mxrwl,a%irn(i),& &call psb_c_hll_csmv_notra_8(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -180,7 +180,7 @@ subroutine psb_c_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_c_hll_csmv_notra_16(i,mxrwl,a%irn(i),& & call psb_c_hll_csmv_notra_16(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -198,7 +198,7 @@ subroutine psb_c_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_c_hll_csmv_notra_24(i,mxrwl,a%irn(i),& & call psb_c_hll_csmv_notra_24(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -216,7 +216,7 @@ subroutine psb_c_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_c_hll_csmv_notra_32(i,mxrwl,a%irn(i),& & call psb_c_hll_csmv_notra_32(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -234,7 +234,7 @@ subroutine psb_c_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_c_hll_csmv_notra_64(i,mxrwl,a%irn(i),& & call psb_c_hll_csmv_notra_64(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -388,17 +388,17 @@ contains
end subroutine psb_c_hll_csmv_inner end subroutine psb_c_hll_csmv_inner
subroutine psb_c_hll_csmv_notra_8(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_c_hll_csmv_notra_4(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=4
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_spk_), intent(inout) :: y(*) complex(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=8
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_spk_) :: tmp(m) complex(psb_spk_) :: tmp(m)
@ -407,36 +407,36 @@ contains
tmp(:) = czero tmp(:) = czero
if (alpha /= czero) then if (alpha /= czero) then
do j=1, maxval(irn(1:8)) do j=1, maxval(irn(1:m))
tmp(1:8) = tmp(1:8) + val(1:8,j)*x(ja(1:8,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == czero) then if (beta == czero) then
y(ir:ir+8-1) = alpha*tmp(1:8) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+8-1) = alpha*tmp(1:8) + beta*y(ir:ir+8-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(8,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_c_hll_csmv_notra_8 end subroutine psb_c_hll_csmv_notra_4
subroutine psb_c_hll_csmv_notra_24(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_c_hll_csmv_notra_8(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=8
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_spk_), intent(inout) :: y(*) complex(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=24
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_spk_) :: tmp(m) complex(psb_spk_) :: tmp(m)
@ -445,36 +445,36 @@ contains
tmp(:) = czero tmp(:) = czero
if (alpha /= czero) then if (alpha /= czero) then
do j=1, maxval(irn(1:24)) do j=1, maxval(irn(1:m))
tmp(1:24) = tmp(1:24) + val(1:24,j)*x(ja(1:24,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == czero) then if (beta == czero) then
y(ir:ir+24-1) = alpha*tmp(1:24) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+24-1) = alpha*tmp(1:24) + beta*y(ir:ir+24-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(24,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_c_hll_csmv_notra_24 end subroutine psb_c_hll_csmv_notra_8
subroutine psb_c_hll_csmv_notra_16(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_c_hll_csmv_notra_16(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=16
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_spk_), intent(inout) :: y(*) complex(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=16
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_spk_) :: tmp(m) complex(psb_spk_) :: tmp(m)
@ -483,36 +483,36 @@ contains
tmp(:) = czero tmp(:) = czero
if (alpha /= czero) then if (alpha /= czero) then
do j=1, maxval(irn(1:16)) do j=1, maxval(irn(1:m))
tmp(1:16) = tmp(1:16) + val(1:16,j)*x(ja(1:16,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == czero) then if (beta == czero) then
y(ir:ir+16-1) = alpha*tmp(1:16) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+16-1) = alpha*tmp(1:16) + beta*y(ir:ir+16-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(16,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_c_hll_csmv_notra_16 end subroutine psb_c_hll_csmv_notra_16
subroutine psb_c_hll_csmv_notra_32(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_c_hll_csmv_notra_24(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=24
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_spk_), intent(inout) :: y(*) complex(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=32
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_spk_) :: tmp(m) complex(psb_spk_) :: tmp(m)
@ -521,36 +521,36 @@ contains
tmp(:) = czero tmp(:) = czero
if (alpha /= czero) then if (alpha /= czero) then
do j=1, maxval(irn(1:32)) do j=1, maxval(irn(1:m))
tmp(1:32) = tmp(1:32) + val(1:32,j)*x(ja(1:32,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == czero) then if (beta == czero) then
y(ir:ir+32-1) = alpha*tmp(1:32) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+32-1) = alpha*tmp(1:32) + beta*y(ir:ir+32-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(32,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_c_hll_csmv_notra_32 end subroutine psb_c_hll_csmv_notra_24
subroutine psb_c_hll_csmv_notra_64(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_c_hll_csmv_notra_32(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=32
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_spk_), intent(inout) :: y(*) complex(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=64
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_spk_) :: tmp(m) complex(psb_spk_) :: tmp(m)
@ -559,37 +559,36 @@ contains
tmp(:) = czero tmp(:) = czero
if (alpha /= czero) then if (alpha /= czero) then
do j=1, maxval(irn(1:64)) do j=1, maxval(irn(1:m))
tmp(1:64) = tmp(1:64) + val(1:64,j)*x(ja(1:64,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == czero) then if (beta == czero) then
y(ir:ir+64-1) = alpha*tmp(1:64) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+64-1) = alpha*tmp(1:64) + beta*y(ir:ir+64-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(64,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_c_hll_csmv_notra_64 end subroutine psb_c_hll_csmv_notra_32
subroutine psb_c_hll_csmv_notra_64(ir,n,irn,alpha,ja,val,&
subroutine psb_c_hll_csmv_notra_4(ir,n,irn,alpha,ja,ldj,val,ldv,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=64
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_spk_), intent(inout) :: y(*) complex(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=4
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_spk_) :: tmp(m) complex(psb_spk_) :: tmp(m)
@ -598,23 +597,23 @@ contains
tmp(:) = czero tmp(:) = czero
if (alpha /= czero) then if (alpha /= czero) then
do j=1, maxval(irn(1:4)) do j=1, maxval(irn(1:m))
tmp(1:4) = tmp(1:4) + val(1:4,j)*x(ja(1:4,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == czero) then if (beta == czero) then
y(ir:ir+4-1) = alpha*tmp(1:4) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+4-1) = alpha*tmp(1:4) + beta*y(ir:ir+4-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(4,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_c_hll_csmv_notra_4 end subroutine psb_c_hll_csmv_notra_64
end subroutine psb_c_hll_csmv end subroutine psb_c_hll_csmv

135
ext/impl/psb_d_hll_csmv.f90
Unescape Escape View File

@ -144,7 +144,7 @@ subroutine psb_d_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_d_hll_csmv_notra_4(i,mxrwl,a%irn(i),& & call psb_d_hll_csmv_notra_4(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -162,7 +162,7 @@ subroutine psb_d_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
&call psb_d_hll_csmv_notra_8(i,mxrwl,a%irn(i),& &call psb_d_hll_csmv_notra_8(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -180,7 +180,7 @@ subroutine psb_d_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_d_hll_csmv_notra_16(i,mxrwl,a%irn(i),& & call psb_d_hll_csmv_notra_16(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -198,7 +198,7 @@ subroutine psb_d_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_d_hll_csmv_notra_24(i,mxrwl,a%irn(i),& & call psb_d_hll_csmv_notra_24(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -216,7 +216,7 @@ subroutine psb_d_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_d_hll_csmv_notra_32(i,mxrwl,a%irn(i),& & call psb_d_hll_csmv_notra_32(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -234,7 +234,7 @@ subroutine psb_d_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_d_hll_csmv_notra_64(i,mxrwl,a%irn(i),& & call psb_d_hll_csmv_notra_64(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -388,17 +388,17 @@ contains
end subroutine psb_d_hll_csmv_inner end subroutine psb_d_hll_csmv_inner
subroutine psb_d_hll_csmv_notra_8(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_d_hll_csmv_notra_4(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=4
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_dpk_), intent(inout) :: y(*) real(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=8
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_dpk_) :: tmp(m) real(psb_dpk_) :: tmp(m)
@ -407,36 +407,36 @@ contains
tmp(:) = dzero tmp(:) = dzero
if (alpha /= dzero) then if (alpha /= dzero) then
do j=1, maxval(irn(1:8)) do j=1, maxval(irn(1:m))
tmp(1:8) = tmp(1:8) + val(1:8,j)*x(ja(1:8,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == dzero) then if (beta == dzero) then
y(ir:ir+8-1) = alpha*tmp(1:8) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+8-1) = alpha*tmp(1:8) + beta*y(ir:ir+8-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(8,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_d_hll_csmv_notra_8 end subroutine psb_d_hll_csmv_notra_4
subroutine psb_d_hll_csmv_notra_24(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_d_hll_csmv_notra_8(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=8
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_dpk_), intent(inout) :: y(*) real(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=24
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_dpk_) :: tmp(m) real(psb_dpk_) :: tmp(m)
@ -445,36 +445,36 @@ contains
tmp(:) = dzero tmp(:) = dzero
if (alpha /= dzero) then if (alpha /= dzero) then
do j=1, maxval(irn(1:24)) do j=1, maxval(irn(1:m))
tmp(1:24) = tmp(1:24) + val(1:24,j)*x(ja(1:24,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == dzero) then if (beta == dzero) then
y(ir:ir+24-1) = alpha*tmp(1:24) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+24-1) = alpha*tmp(1:24) + beta*y(ir:ir+24-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(24,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_d_hll_csmv_notra_24 end subroutine psb_d_hll_csmv_notra_8
subroutine psb_d_hll_csmv_notra_16(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_d_hll_csmv_notra_16(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=16
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_dpk_), intent(inout) :: y(*) real(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=16
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_dpk_) :: tmp(m) real(psb_dpk_) :: tmp(m)
@ -483,36 +483,36 @@ contains
tmp(:) = dzero tmp(:) = dzero
if (alpha /= dzero) then if (alpha /= dzero) then
do j=1, maxval(irn(1:16)) do j=1, maxval(irn(1:m))
tmp(1:16) = tmp(1:16) + val(1:16,j)*x(ja(1:16,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == dzero) then if (beta == dzero) then
y(ir:ir+16-1) = alpha*tmp(1:16) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+16-1) = alpha*tmp(1:16) + beta*y(ir:ir+16-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(16,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_d_hll_csmv_notra_16 end subroutine psb_d_hll_csmv_notra_16
subroutine psb_d_hll_csmv_notra_32(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_d_hll_csmv_notra_24(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=24
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_dpk_), intent(inout) :: y(*) real(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=32
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_dpk_) :: tmp(m) real(psb_dpk_) :: tmp(m)
@ -521,36 +521,36 @@ contains
tmp(:) = dzero tmp(:) = dzero
if (alpha /= dzero) then if (alpha /= dzero) then
do j=1, maxval(irn(1:32)) do j=1, maxval(irn(1:m))
tmp(1:32) = tmp(1:32) + val(1:32,j)*x(ja(1:32,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == dzero) then if (beta == dzero) then
y(ir:ir+32-1) = alpha*tmp(1:32) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+32-1) = alpha*tmp(1:32) + beta*y(ir:ir+32-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(32,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_d_hll_csmv_notra_32 end subroutine psb_d_hll_csmv_notra_24
subroutine psb_d_hll_csmv_notra_64(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_d_hll_csmv_notra_32(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=32
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_dpk_), intent(inout) :: y(*) real(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=64
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_dpk_) :: tmp(m) real(psb_dpk_) :: tmp(m)
@ -559,37 +559,36 @@ contains
tmp(:) = dzero tmp(:) = dzero
if (alpha /= dzero) then if (alpha /= dzero) then
do j=1, maxval(irn(1:64)) do j=1, maxval(irn(1:m))
tmp(1:64) = tmp(1:64) + val(1:64,j)*x(ja(1:64,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == dzero) then if (beta == dzero) then
y(ir:ir+64-1) = alpha*tmp(1:64) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+64-1) = alpha*tmp(1:64) + beta*y(ir:ir+64-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(64,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_d_hll_csmv_notra_64 end subroutine psb_d_hll_csmv_notra_32
subroutine psb_d_hll_csmv_notra_64(ir,n,irn,alpha,ja,val,&
subroutine psb_d_hll_csmv_notra_4(ir,n,irn,alpha,ja,ldj,val,ldv,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, dzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=64
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_dpk_), intent(inout) :: y(*) real(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=4
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_dpk_) :: tmp(m) real(psb_dpk_) :: tmp(m)
@ -598,23 +597,23 @@ contains
tmp(:) = dzero tmp(:) = dzero
if (alpha /= dzero) then if (alpha /= dzero) then
do j=1, maxval(irn(1:4)) do j=1, maxval(irn(1:m))
tmp(1:4) = tmp(1:4) + val(1:4,j)*x(ja(1:4,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == dzero) then if (beta == dzero) then
y(ir:ir+4-1) = alpha*tmp(1:4) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+4-1) = alpha*tmp(1:4) + beta*y(ir:ir+4-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(4,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_d_hll_csmv_notra_4 end subroutine psb_d_hll_csmv_notra_64
end subroutine psb_d_hll_csmv end subroutine psb_d_hll_csmv

135
ext/impl/psb_s_hll_csmv.f90
Unescape Escape View File

@ -144,7 +144,7 @@ subroutine psb_s_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_s_hll_csmv_notra_4(i,mxrwl,a%irn(i),& & call psb_s_hll_csmv_notra_4(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -162,7 +162,7 @@ subroutine psb_s_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
&call psb_s_hll_csmv_notra_8(i,mxrwl,a%irn(i),& &call psb_s_hll_csmv_notra_8(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -180,7 +180,7 @@ subroutine psb_s_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_s_hll_csmv_notra_16(i,mxrwl,a%irn(i),& & call psb_s_hll_csmv_notra_16(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -198,7 +198,7 @@ subroutine psb_s_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_s_hll_csmv_notra_24(i,mxrwl,a%irn(i),& & call psb_s_hll_csmv_notra_24(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -216,7 +216,7 @@ subroutine psb_s_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_s_hll_csmv_notra_32(i,mxrwl,a%irn(i),& & call psb_s_hll_csmv_notra_32(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -234,7 +234,7 @@ subroutine psb_s_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_s_hll_csmv_notra_64(i,mxrwl,a%irn(i),& & call psb_s_hll_csmv_notra_64(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -388,17 +388,17 @@ contains
end subroutine psb_s_hll_csmv_inner end subroutine psb_s_hll_csmv_inner
subroutine psb_s_hll_csmv_notra_8(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_s_hll_csmv_notra_4(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=4
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_spk_), intent(inout) :: y(*) real(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=8
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_spk_) :: tmp(m) real(psb_spk_) :: tmp(m)
@ -407,36 +407,36 @@ contains
tmp(:) = szero tmp(:) = szero
if (alpha /= szero) then if (alpha /= szero) then
do j=1, maxval(irn(1:8)) do j=1, maxval(irn(1:m))
tmp(1:8) = tmp(1:8) + val(1:8,j)*x(ja(1:8,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == szero) then if (beta == szero) then
y(ir:ir+8-1) = alpha*tmp(1:8) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+8-1) = alpha*tmp(1:8) + beta*y(ir:ir+8-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(8,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_s_hll_csmv_notra_8 end subroutine psb_s_hll_csmv_notra_4
subroutine psb_s_hll_csmv_notra_24(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_s_hll_csmv_notra_8(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=8
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_spk_), intent(inout) :: y(*) real(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=24
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_spk_) :: tmp(m) real(psb_spk_) :: tmp(m)
@ -445,36 +445,36 @@ contains
tmp(:) = szero tmp(:) = szero
if (alpha /= szero) then if (alpha /= szero) then
do j=1, maxval(irn(1:24)) do j=1, maxval(irn(1:m))
tmp(1:24) = tmp(1:24) + val(1:24,j)*x(ja(1:24,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == szero) then if (beta == szero) then
y(ir:ir+24-1) = alpha*tmp(1:24) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+24-1) = alpha*tmp(1:24) + beta*y(ir:ir+24-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(24,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_s_hll_csmv_notra_24 end subroutine psb_s_hll_csmv_notra_8
subroutine psb_s_hll_csmv_notra_16(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_s_hll_csmv_notra_16(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=16
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_spk_), intent(inout) :: y(*) real(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=16
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_spk_) :: tmp(m) real(psb_spk_) :: tmp(m)
@ -483,36 +483,36 @@ contains
tmp(:) = szero tmp(:) = szero
if (alpha /= szero) then if (alpha /= szero) then
do j=1, maxval(irn(1:16)) do j=1, maxval(irn(1:m))
tmp(1:16) = tmp(1:16) + val(1:16,j)*x(ja(1:16,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == szero) then if (beta == szero) then
y(ir:ir+16-1) = alpha*tmp(1:16) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+16-1) = alpha*tmp(1:16) + beta*y(ir:ir+16-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(16,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_s_hll_csmv_notra_16 end subroutine psb_s_hll_csmv_notra_16
subroutine psb_s_hll_csmv_notra_32(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_s_hll_csmv_notra_24(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=24
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_spk_), intent(inout) :: y(*) real(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=32
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_spk_) :: tmp(m) real(psb_spk_) :: tmp(m)
@ -521,36 +521,36 @@ contains
tmp(:) = szero tmp(:) = szero
if (alpha /= szero) then if (alpha /= szero) then
do j=1, maxval(irn(1:32)) do j=1, maxval(irn(1:m))
tmp(1:32) = tmp(1:32) + val(1:32,j)*x(ja(1:32,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == szero) then if (beta == szero) then
y(ir:ir+32-1) = alpha*tmp(1:32) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+32-1) = alpha*tmp(1:32) + beta*y(ir:ir+32-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(32,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_s_hll_csmv_notra_32 end subroutine psb_s_hll_csmv_notra_24
subroutine psb_s_hll_csmv_notra_64(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_s_hll_csmv_notra_32(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=32
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_spk_), intent(inout) :: y(*) real(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=64
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_spk_) :: tmp(m) real(psb_spk_) :: tmp(m)
@ -559,37 +559,36 @@ contains
tmp(:) = szero tmp(:) = szero
if (alpha /= szero) then if (alpha /= szero) then
do j=1, maxval(irn(1:64)) do j=1, maxval(irn(1:m))
tmp(1:64) = tmp(1:64) + val(1:64,j)*x(ja(1:64,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == szero) then if (beta == szero) then
y(ir:ir+64-1) = alpha*tmp(1:64) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+64-1) = alpha*tmp(1:64) + beta*y(ir:ir+64-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(64,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_s_hll_csmv_notra_64 end subroutine psb_s_hll_csmv_notra_32
subroutine psb_s_hll_csmv_notra_64(ir,n,irn,alpha,ja,val,&
subroutine psb_s_hll_csmv_notra_4(ir,n,irn,alpha,ja,ldj,val,ldv,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_spk_, szero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=64
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
real(psb_spk_), intent(in) :: alpha, beta, x(*),val(m,*)
real(psb_spk_), intent(inout) :: y(*) real(psb_spk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=4
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
real(psb_spk_) :: tmp(m) real(psb_spk_) :: tmp(m)
@ -598,23 +597,23 @@ contains
tmp(:) = szero tmp(:) = szero
if (alpha /= szero) then if (alpha /= szero) then
do j=1, maxval(irn(1:4)) do j=1, maxval(irn(1:m))
tmp(1:4) = tmp(1:4) + val(1:4,j)*x(ja(1:4,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == szero) then if (beta == szero) then
y(ir:ir+4-1) = alpha*tmp(1:4) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+4-1) = alpha*tmp(1:4) + beta*y(ir:ir+4-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(4,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_s_hll_csmv_notra_4 end subroutine psb_s_hll_csmv_notra_64
end subroutine psb_s_hll_csmv end subroutine psb_s_hll_csmv

135
ext/impl/psb_z_hll_csmv.f90
Unescape Escape View File

@ -144,7 +144,7 @@ subroutine psb_z_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_z_hll_csmv_notra_4(i,mxrwl,a%irn(i),& & call psb_z_hll_csmv_notra_4(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -162,7 +162,7 @@ subroutine psb_z_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
&call psb_z_hll_csmv_notra_8(i,mxrwl,a%irn(i),& &call psb_z_hll_csmv_notra_8(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -180,7 +180,7 @@ subroutine psb_z_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_z_hll_csmv_notra_16(i,mxrwl,a%irn(i),& & call psb_z_hll_csmv_notra_16(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -198,7 +198,7 @@ subroutine psb_z_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_z_hll_csmv_notra_24(i,mxrwl,a%irn(i),& & call psb_z_hll_csmv_notra_24(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -216,7 +216,7 @@ subroutine psb_z_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_z_hll_csmv_notra_32(i,mxrwl,a%irn(i),& & call psb_z_hll_csmv_notra_32(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -234,7 +234,7 @@ subroutine psb_z_hll_csmv(alpha,a,x,beta,y,info,trans)
hkpnt = a%hkoffs(j) + 1 hkpnt = a%hkoffs(j) + 1
if (info == psb_success_) & if (info == psb_success_) &
& call psb_z_hll_csmv_notra_64(i,mxrwl,a%irn(i),& & call psb_z_hll_csmv_notra_64(i,mxrwl,a%irn(i),&
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,& & alpha,a%ja(hkpnt),a%val(hkpnt),&
& a%is_triangle(),a%is_unit(),& & a%is_triangle(),a%is_unit(),&
& x,beta,y,info) & x,beta,y,info)
end if end if
@ -388,17 +388,17 @@ contains
end subroutine psb_z_hll_csmv_inner end subroutine psb_z_hll_csmv_inner
subroutine psb_z_hll_csmv_notra_8(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_z_hll_csmv_notra_4(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=4
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_dpk_), intent(inout) :: y(*) complex(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=8
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_dpk_) :: tmp(m) complex(psb_dpk_) :: tmp(m)
@ -407,36 +407,36 @@ contains
tmp(:) = zzero tmp(:) = zzero
if (alpha /= zzero) then if (alpha /= zzero) then
do j=1, maxval(irn(1:8)) do j=1, maxval(irn(1:m))
tmp(1:8) = tmp(1:8) + val(1:8,j)*x(ja(1:8,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == zzero) then if (beta == zzero) then
y(ir:ir+8-1) = alpha*tmp(1:8) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+8-1) = alpha*tmp(1:8) + beta*y(ir:ir+8-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(8,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_z_hll_csmv_notra_8 end subroutine psb_z_hll_csmv_notra_4
subroutine psb_z_hll_csmv_notra_24(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_z_hll_csmv_notra_8(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=8
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_dpk_), intent(inout) :: y(*) complex(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=24
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_dpk_) :: tmp(m) complex(psb_dpk_) :: tmp(m)
@ -445,36 +445,36 @@ contains
tmp(:) = zzero tmp(:) = zzero
if (alpha /= zzero) then if (alpha /= zzero) then
do j=1, maxval(irn(1:24)) do j=1, maxval(irn(1:m))
tmp(1:24) = tmp(1:24) + val(1:24,j)*x(ja(1:24,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == zzero) then if (beta == zzero) then
y(ir:ir+24-1) = alpha*tmp(1:24) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+24-1) = alpha*tmp(1:24) + beta*y(ir:ir+24-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(24,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_z_hll_csmv_notra_24 end subroutine psb_z_hll_csmv_notra_8
subroutine psb_z_hll_csmv_notra_16(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_z_hll_csmv_notra_16(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=16
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_dpk_), intent(inout) :: y(*) complex(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=16
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_dpk_) :: tmp(m) complex(psb_dpk_) :: tmp(m)
@ -483,36 +483,36 @@ contains
tmp(:) = zzero tmp(:) = zzero
if (alpha /= zzero) then if (alpha /= zzero) then
do j=1, maxval(irn(1:16)) do j=1, maxval(irn(1:m))
tmp(1:16) = tmp(1:16) + val(1:16,j)*x(ja(1:16,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == zzero) then if (beta == zzero) then
y(ir:ir+16-1) = alpha*tmp(1:16) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+16-1) = alpha*tmp(1:16) + beta*y(ir:ir+16-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(16,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_z_hll_csmv_notra_16 end subroutine psb_z_hll_csmv_notra_16
subroutine psb_z_hll_csmv_notra_32(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_z_hll_csmv_notra_24(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=24
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_dpk_), intent(inout) :: y(*) complex(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=32
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_dpk_) :: tmp(m) complex(psb_dpk_) :: tmp(m)
@ -521,36 +521,36 @@ contains
tmp(:) = zzero tmp(:) = zzero
if (alpha /= zzero) then if (alpha /= zzero) then
do j=1, maxval(irn(1:32)) do j=1, maxval(irn(1:m))
tmp(1:32) = tmp(1:32) + val(1:32,j)*x(ja(1:32,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == zzero) then if (beta == zzero) then
y(ir:ir+32-1) = alpha*tmp(1:32) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+32-1) = alpha*tmp(1:32) + beta*y(ir:ir+32-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(32,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_z_hll_csmv_notra_32 end subroutine psb_z_hll_csmv_notra_24
subroutine psb_z_hll_csmv_notra_64(ir,n,irn,alpha,ja,ldj,val,ldv,& subroutine psb_z_hll_csmv_notra_32(ir,n,irn,alpha,ja,val,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=32
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_dpk_), intent(inout) :: y(*) complex(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=64
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_dpk_) :: tmp(m) complex(psb_dpk_) :: tmp(m)
@ -559,37 +559,36 @@ contains
tmp(:) = zzero tmp(:) = zzero
if (alpha /= zzero) then if (alpha /= zzero) then
do j=1, maxval(irn(1:64)) do j=1, maxval(irn(1:m))
tmp(1:64) = tmp(1:64) + val(1:64,j)*x(ja(1:64,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == zzero) then if (beta == zzero) then
y(ir:ir+64-1) = alpha*tmp(1:64) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+64-1) = alpha*tmp(1:64) + beta*y(ir:ir+64-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(64,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_z_hll_csmv_notra_64 end subroutine psb_z_hll_csmv_notra_32
subroutine psb_z_hll_csmv_notra_64(ir,n,irn,alpha,ja,val,&
subroutine psb_z_hll_csmv_notra_4(ir,n,irn,alpha,ja,ldj,val,ldv,&
& is_triangle,is_unit, x,beta,y,info) & is_triangle,is_unit, x,beta,y,info)
use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_ use psb_base_mod, only : psb_ipk_, psb_dpk_, zzero, psb_success_
implicit none implicit none
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) integer(psb_ipk_), parameter :: m=64
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) integer(psb_ipk_), intent(in) :: ir,n,ja(m,*),irn(*)
complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(m,*)
complex(psb_dpk_), intent(inout) :: y(*) complex(psb_dpk_), intent(inout) :: y(*)
logical, intent(in) :: is_triangle,is_unit logical, intent(in) :: is_triangle,is_unit
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), parameter :: m=4
integer(psb_ipk_) :: i,j,k, m4, jc integer(psb_ipk_) :: i,j,k, m4, jc
complex(psb_dpk_) :: tmp(m) complex(psb_dpk_) :: tmp(m)
@ -598,23 +597,23 @@ contains
tmp(:) = zzero tmp(:) = zzero
if (alpha /= zzero) then if (alpha /= zzero) then
do j=1, maxval(irn(1:4)) do j=1, maxval(irn(1:m))
tmp(1:4) = tmp(1:4) + val(1:4,j)*x(ja(1:4,j)) tmp(1:m) = tmp(1:m) + val(1:m,j)*x(ja(1:m,j))
end do end do
end if end if
if (beta == zzero) then if (beta == zzero) then
y(ir:ir+4-1) = alpha*tmp(1:4) y(ir:ir+m-1) = alpha*tmp(1:m)
else else
y(ir:ir+4-1) = alpha*tmp(1:4) + beta*y(ir:ir+4-1) y(ir:ir+m-1) = alpha*tmp(1:m) + beta*y(ir:ir+m-1)
end if end if
if (is_unit) then if (is_unit) then
do i=1, min(4,n) do i=1, min(m,n)
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1) y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
end do end do
end if end if
end subroutine psb_z_hll_csmv_notra_4 end subroutine psb_z_hll_csmv_notra_64
end subroutine psb_z_hll_csmv end subroutine psb_z_hll_csmv

Write Preview
Loading…
Cancel
Save