fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Aligned multiple RHS version with 1-rhs version of MV.

Browse Source
This commit is contained in:
Salvatore Filippone
2007-04-10 15:24:25 +00:00
parent 4e531813b9
commit 176318b11d
3 changed files with 331 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/csr/dcsrmv2.f
+110 -17
View File
@@ -176,7 +176,7 @@ C .. Scalar Arguments ..
INTEGER M, N,LWORK,IERROR,ldx,ldy
CHARACTER DIAG, TRANS
C .. Array Arguments ..
DOUBLE PRECISION AS(*), WORK(*), X(LDX,*), Y(LDY,*)
DOUBLE PRECISION AS(*), WORK(*), X(LDX,NB), Y(LDY,NB)
INTEGER IA(*), JA(*)
C .. Local Scalars ..
DOUBLE PRECISION ACC(nb)
@@ -317,23 +317,116 @@ C
C .......General Not Unit, No Traspose
C
if (beta.ne.zero) then
do 240 i = 1, m
acc(1:nb) = zero
do 220 j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb)
220 continue
y(i,1:nb) = alpha*acc(1:nb) + beta*y(i,1:nb)
240 continue
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb)
if (beta == zero) then
if (alpha==one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
y(i,1:nb) = alpha*acc(1:nb)
enddo
endif
else if (alpha==-one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc
enddo
endif
else if (beta==one) then
if (alpha==one) then
do i = 1, m
acc = y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc + y(i,1:nb)
enddo
endif
else if (beta==-one) then
if (alpha==one) then
do i = 1, m
acc = -y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = -y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc - y(i,1:nb)
enddo
endif
else
if (alpha==one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc + beta*y(i,1:nb)
enddo
else if (alpha==-one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc + beta*y(i,1:nb)
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc + beta*y(i,1:nb)
enddo
endif
end if
c
else if (uni) then
c
base/serial/csr/dcsrmv3.f
+110 -18
View File
@@ -176,7 +176,7 @@ C .. Scalar Arguments ..
INTEGER M, N,LWORK,IERROR,ldx,ldy
CHARACTER DIAG, TRANS
C .. Array Arguments ..
DOUBLE PRECISION AS(*), WORK(*), X(LDX,*), Y(LDY,*)
DOUBLE PRECISION AS(*), WORK(*), X(LDX,NB), Y(LDY,NB)
INTEGER IA(*), JA(*)
C .. Local Scalars ..
DOUBLE PRECISION ACC(nb)
@@ -316,24 +316,116 @@ c
C
C .......General Not Unit, No Traspose
C
if (beta.ne.zero) then
do 240 i = 1, m
acc(1:nb) = zero
do 220 j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb)
220 continue
y(i,1:nb) = alpha*acc(1:nb) + beta*y(i,1:nb)
240 continue
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb)
if (beta == zero) then
if (alpha==one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
y(i,1:nb) = alpha*acc(1:nb)
enddo
endif
else if (alpha==-one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc
enddo
endif
else if (beta==one) then
if (alpha==one) then
do i = 1, m
acc = y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc + y(i,1:nb)
enddo
endif
else if (beta==-one) then
if (alpha==one) then
do i = 1, m
acc = -y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = -y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc - y(i,1:nb)
enddo
endif
else
if (alpha==one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc + beta*y(i,1:nb)
enddo
else if (alpha==-one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc + beta*y(i,1:nb)
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc + beta*y(i,1:nb)
enddo
endif
end if
c
else if (uni) then
c
base/serial/csr/dcsrmv4.f
+111 -18
View File
@@ -176,7 +176,7 @@ C .. Scalar Arguments ..
INTEGER M, N,LWORK,IERROR,ldx,ldy
CHARACTER DIAG, TRANS
C .. Array Arguments ..
DOUBLE PRECISION AS(*), WORK(*), X(LDX,*), Y(LDY,*)
DOUBLE PRECISION AS(*), WORK(*), X(LDX,NB), Y(LDY,NB)
INTEGER IA(*), JA(*)
C .. Local Scalars ..
DOUBLE PRECISION ACC(nb)
@@ -316,24 +316,117 @@ c
C
C .......General Not Unit, No Traspose
C
if (beta.ne.zero) then
do 240 i = 1, m
acc(1:nb) = zero
do 220 j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb)
220 continue
y(i,1:nb) = alpha*acc(1:nb) + beta*y(i,1:nb)
240 continue
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb)
if (beta == zero) then
if (alpha==one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
y(i,1:nb) = alpha*acc(1:nb)
enddo
endif
else if (alpha==-one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc
enddo
endif
else if (beta==one) then
if (alpha==one) then
do i = 1, m
acc = y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc + y(i,1:nb)
enddo
endif
else if (beta==-one) then
if (alpha==one) then
do i = 1, m
acc = -y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else if (alpha==-one) then
do i = 1, m
acc = -y(i,1:nb)
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc - y(i,1:nb)
enddo
endif
else
if (alpha==one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc + beta*y(i,1:nb)
enddo
else if (alpha==-one) then
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc - as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = acc + beta*y(i,1:nb)
enddo
else
do i = 1, m
acc = zero
do j = ia(i), ia(i+1) - 1
acc = acc + as(j)*x(ja(j),1:nb)
enddo
y(i,1:nb) = alpha*acc + beta*y(i,1:nb)
enddo
endif
end if
c
else if (uni) then
c