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

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

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 4e531813b9
commit 176318b11d
3 changed files with 329 additions and 51 deletions
Show Stats Download Patch File Download Diff File

115
base/serial/csr/dcsrmv2.f
Unescape Escape View File

@ -176,7 +176,7 @@ C .. Scalar Arguments ..
INTEGER M, N,LWORK,IERROR,ldx,ldy INTEGER M, N,LWORK,IERROR,ldx,ldy
CHARACTER DIAG, TRANS CHARACTER DIAG, TRANS
C .. Array Arguments .. C .. Array Arguments ..
DOUBLE PRECISION AS(*), WORK(*), X(LDX,*), Y(LDY,*) DOUBLE PRECISION AS(*), WORK(*), X(LDX,NB), Y(LDY,NB)
INTEGER IA(*), JA(*) INTEGER IA(*), JA(*)
C .. Local Scalars .. C .. Local Scalars ..
DOUBLE PRECISION ACC(nb) DOUBLE PRECISION ACC(nb)
@ -317,22 +317,115 @@ C
C .......General Not Unit, No Traspose C .......General Not Unit, No Traspose
C C
if (beta.ne.zero) then if (beta == zero) then
do 240 i = 1, m if (alpha==one) then
acc(1:nb) = zero do i = 1, m
do 220 j = ia(i), ia(i+1) - 1 acc = zero
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb) do j = ia(i), ia(i+1) - 1
220 continue acc = acc + as(j)*x(ja(j),1:nb)
y(i,1:nb) = alpha*acc(1:nb) + beta*y(i,1:nb) enddo
240 continue y(i,1:nb) = acc
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
enddo
else else
do i = 1, m do i = 1, m
acc = zero acc = zero
do j = ia(i), ia(i+1) - 1 do j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb) 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 enddo
y(i,1:nb) = alpha*acc(1:nb) 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 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 end if
c c
else if (uni) then else if (uni) then

114
base/serial/csr/dcsrmv3.f
Unescape Escape View File

@ -176,7 +176,7 @@ C .. Scalar Arguments ..
INTEGER M, N,LWORK,IERROR,ldx,ldy INTEGER M, N,LWORK,IERROR,ldx,ldy
CHARACTER DIAG, TRANS CHARACTER DIAG, TRANS
C .. Array Arguments .. C .. Array Arguments ..
DOUBLE PRECISION AS(*), WORK(*), X(LDX,*), Y(LDY,*) DOUBLE PRECISION AS(*), WORK(*), X(LDX,NB), Y(LDY,NB)
INTEGER IA(*), JA(*) INTEGER IA(*), JA(*)
C .. Local Scalars .. C .. Local Scalars ..
DOUBLE PRECISION ACC(nb) DOUBLE PRECISION ACC(nb)
@ -316,24 +316,116 @@ c
C C
C .......General Not Unit, No Traspose C .......General Not Unit, No Traspose
C C
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
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
if (beta.ne.zero) then endif
do 240 i = 1, m
acc(1:nb) = zero else if (beta==one) then
do 220 j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb) if (alpha==one) then
220 continue do i = 1, m
y(i,1:nb) = alpha*acc(1:nb) + beta*y(i,1:nb) acc = y(i,1:nb)
240 continue 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 else
do i = 1, m do i = 1, m
acc = zero acc = zero
do j = ia(i), ia(i+1) - 1 do j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb) acc = acc + as(j)*x(ja(j),1:nb)
enddo enddo
y(i,1:nb) = alpha*acc(1:nb) y(i,1:nb) = alpha*acc + y(i,1:nb)
enddo enddo
endif 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 c
else if (uni) then else if (uni) then
c c

115
base/serial/csr/dcsrmv4.f
Unescape Escape View File

@ -176,7 +176,7 @@ C .. Scalar Arguments ..
INTEGER M, N,LWORK,IERROR,ldx,ldy INTEGER M, N,LWORK,IERROR,ldx,ldy
CHARACTER DIAG, TRANS CHARACTER DIAG, TRANS
C .. Array Arguments .. C .. Array Arguments ..
DOUBLE PRECISION AS(*), WORK(*), X(LDX,*), Y(LDY,*) DOUBLE PRECISION AS(*), WORK(*), X(LDX,NB), Y(LDY,NB)
INTEGER IA(*), JA(*) INTEGER IA(*), JA(*)
C .. Local Scalars .. C .. Local Scalars ..
DOUBLE PRECISION ACC(nb) DOUBLE PRECISION ACC(nb)
@ -316,24 +316,117 @@ c
C C
C .......General Not Unit, No Traspose C .......General Not Unit, No Traspose
C C
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
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
if (beta.ne.zero) then endif
do 240 i = 1, m
acc(1:nb) = zero else if (beta==one) then
do 220 j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb) if (alpha==one) then
220 continue do i = 1, m
y(i,1:nb) = alpha*acc(1:nb) + beta*y(i,1:nb) acc = y(i,1:nb)
240 continue 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 else
do i = 1, m do i = 1, m
acc = zero acc = zero
do j = ia(i), ia(i+1) - 1 do j = ia(i), ia(i+1) - 1
acc(1:nb) = acc(1:nb) + as(j)*x(ja(j),1:nb) 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 enddo
y(i,1:nb) = alpha*acc(1:nb) 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 enddo
endif endif
end if
c c
else if (uni) then else if (uni) then
c c

Write Preview
Loading…
Cancel
Save