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

psblas3:

Browse Source 
base/serial/impl/psb_c_coo_impl.f90
 base/serial/impl/psb_c_csc_impl.f90
 base/serial/impl/psb_c_csr_impl.f90
 base/serial/impl/psb_s_csr_impl.f90
 base/serial/impl/psb_z_coo_impl.f90
 base/serial/impl/psb_z_csc_impl.f90
 base/serial/impl/psb_z_csr_impl.f90

Fixed trivial mismatches in ZERO/ONE constants.
psblas3-type-indexed
Salvatore Filippone 14 years ago
parent 9971c24d2f
commit f07faa91c4
7 changed files with 201 additions and 201 deletions
Show Stats Download Patch File Download Diff File

6
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -1600,7 +1600,7 @@ function psb_c_coo_csnmi(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = dzero res = szero
nnz = a%get_nzeros() nnz = a%get_nzeros()
i = 1 i = 1
j = i j = i
@ -1608,7 +1608,7 @@ function psb_c_coo_csnmi(a) result(res)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz)) do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1 j = j+1
enddo enddo
acc = dzero acc = szero
do k=i, j-1 do k=i, j-1
acc = acc + abs(a%val(k)) acc = acc + abs(a%val(k))
end do end do
@ -1637,7 +1637,7 @@ function psb_c_coo_csnm1(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = -done res = szero
nnz = a%get_nzeros() nnz = a%get_nzeros()
n = a%get_ncols() n = a%get_ncols()
allocate(vt(n),stat=info) allocate(vt(n),stat=info)

4
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -1423,14 +1423,14 @@ function psb_c_csc_csnmi(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = czero res = szero
nr = a%get_nrows() nr = a%get_nrows()
nc = a%get_ncols() nc = a%get_ncols()
allocate(acc(nr),stat=info) allocate(acc(nr),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
return return
end if end if
acc(:) = dzero acc(:) = szero
do i=1, nc do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
acc(a%ia(j)) = acc(a%ia(j)) + abs(a%val(j)) acc(a%ia(j)) = acc(a%ia(j)) + abs(a%val(j))

194
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -99,10 +99,10 @@ contains
integer :: i,j,k, ir, jc integer :: i,j,k, ir, jc
complex(psb_spk_) :: acc complex(psb_spk_) :: acc
if (alpha == dzero) then if (alpha == czero) then
if (beta == dzero) then if (beta == czero) then
do i = 1, m do i = 1, m
y(i) = dzero y(i) = czero
enddo enddo
else else
do i = 1, m do i = 1, m
@ -115,21 +115,21 @@ contains
if ((.not.tra).and.(.not.ctra)) then if ((.not.tra).and.(.not.ctra)) then
if (beta == dzero) then if (beta == czero) then
if (alpha == done) then if (alpha == cone) then
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
y(i) = acc y(i) = acc
end do end do
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -139,7 +139,7 @@ contains
else else
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -149,21 +149,21 @@ contains
end if end if
else if (beta == done) then else if (beta == cone) then
if (alpha == done) then if (alpha == cone) then
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
y(i) = y(i) + acc y(i) = y(i) + acc
end do end do
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -173,7 +173,7 @@ contains
else else
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -182,21 +182,21 @@ contains
end if end if
else if (beta == -done) then else if (beta == -cone) then
if (alpha == done) then if (alpha == cone) then
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
y(i) = -y(i) + acc y(i) = -y(i) + acc
end do end do
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -206,7 +206,7 @@ contains
else else
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -217,19 +217,19 @@ contains
else else
if (alpha == done) then if (alpha == cone) then
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
y(i) = beta*y(i) + acc y(i) = beta*y(i) + acc
end do end do
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -239,7 +239,7 @@ contains
else else
do i=1,m do i=1,m
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -252,13 +252,13 @@ contains
else if (tra) then else if (tra) then
if (beta == dzero) then if (beta == czero) then
do i=1, m do i=1, m
y(i) = dzero y(i) = czero
end do end do
else if (beta == done) then else if (beta == cone) then
! Do nothing ! Do nothing
else if (beta == -done) then else if (beta == -cone) then
do i=1, m do i=1, m
y(i) = -y(i) y(i) = -y(i)
end do end do
@ -268,7 +268,7 @@ contains
end do end do
end if end if
if (alpha == done) then if (alpha == cone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -277,7 +277,7 @@ contains
end do end do
enddo enddo
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -299,13 +299,13 @@ contains
else if (ctra) then else if (ctra) then
if (beta == dzero) then if (beta == czero) then
do i=1, m do i=1, m
y(i) = dzero y(i) = czero
end do end do
else if (beta == done) then else if (beta == cone) then
! Do nothing ! Do nothing
else if (beta == -done) then else if (beta == -cone) then
do i=1, m do i=1, m
y(i) = -y(i) y(i) = -y(i)
end do end do
@ -315,7 +315,7 @@ contains
end do end do
end if end if
if (alpha == done) then if (alpha == cone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -324,7 +324,7 @@ contains
end do end do
enddo enddo
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -451,10 +451,10 @@ contains
integer :: i,j,k, ir, jc integer :: i,j,k, ir, jc
if (alpha == dzero) then if (alpha == czero) then
if (beta == dzero) then if (beta == czero) then
do i = 1, m do i = 1, m
y(i,1:nc) = dzero y(i,1:nc) = czero
enddo enddo
else else
do i = 1, m do i = 1, m
@ -465,21 +465,21 @@ contains
end if end if
if ((.not.tra).and.(.not.ctra)) then if ((.not.tra).and.(.not.ctra)) then
if (beta == dzero) then if (beta == czero) then
if (alpha == done) then if (alpha == cone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
y(i,1:nc) = acc(1:nc) y(i,1:nc) = acc(1:nc)
end do end do
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -489,7 +489,7 @@ contains
else else
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -499,21 +499,21 @@ contains
end if end if
else if (beta == done) then else if (beta == cone) then
if (alpha == done) then if (alpha == cone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
y(i,1:nc) = y(i,1:nc) + acc(1:nc) y(i,1:nc) = y(i,1:nc) + acc(1:nc)
end do end do
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -523,7 +523,7 @@ contains
else else
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -532,21 +532,21 @@ contains
end if end if
else if (beta == -done) then else if (beta == -cone) then
if (alpha == done) then if (alpha == cone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
y(i,1:nc) = -y(i,1:nc) + acc(1:nc) y(i,1:nc) = -y(i,1:nc) + acc(1:nc)
end do end do
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -556,7 +556,7 @@ contains
else else
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -567,19 +567,19 @@ contains
else else
if (alpha == done) then if (alpha == cone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
y(i,1:nc) = beta*y(i,1:nc) + acc(1:nc) y(i,1:nc) = beta*y(i,1:nc) + acc(1:nc)
end do end do
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -589,7 +589,7 @@ contains
else else
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -602,13 +602,13 @@ contains
else if (tra) then else if (tra) then
if (beta == dzero) then if (beta == czero) then
do i=1, m do i=1, m
y(i,1:nc) = dzero y(i,1:nc) = czero
end do end do
else if (beta == done) then else if (beta == cone) then
! Do nothing ! Do nothing
else if (beta == -done) then else if (beta == -cone) then
do i=1, m do i=1, m
y(i,1:nc) = -y(i,1:nc) y(i,1:nc) = -y(i,1:nc)
end do end do
@ -618,7 +618,7 @@ contains
end do end do
end if end if
if (alpha == done) then if (alpha == cone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -627,7 +627,7 @@ contains
end do end do
enddo enddo
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -649,13 +649,13 @@ contains
else if (ctra) then else if (ctra) then
if (beta == dzero) then if (beta == czero) then
do i=1, m do i=1, m
y(i,1:nc) = dzero y(i,1:nc) = czero
end do end do
else if (beta == done) then else if (beta == cone) then
! Do nothing ! Do nothing
else if (beta == -done) then else if (beta == -cone) then
do i=1, m do i=1, m
y(i,1:nc) = -y(i,1:nc) y(i,1:nc) = -y(i,1:nc)
end do end do
@ -665,7 +665,7 @@ contains
end do end do
end if end if
if (alpha == done) then if (alpha == cone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -674,7 +674,7 @@ contains
end do end do
enddo enddo
else if (alpha == -done) then else if (alpha == -cone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -762,10 +762,10 @@ subroutine psb_c_csr_cssv(alpha,a,x,beta,y,info,trans)
goto 9999 goto 9999
end if end if
if (alpha == dzero) then if (alpha == czero) then
if (beta == dzero) then if (beta == czero) then
do i = 1, m do i = 1, m
y(i) = dzero y(i) = czero
enddo enddo
else else
do i = 1, m do i = 1, m
@ -775,13 +775,13 @@ subroutine psb_c_csr_cssv(alpha,a,x,beta,y,info,trans)
return return
end if end if
if (beta == dzero) then if (beta == czero) then
call inner_csrsv(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),& call inner_csrsv(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),&
& a%irp,a%ja,a%val,x,y) & a%irp,a%ja,a%val,x,y)
if (alpha == done) then if (alpha == cone) then
! do nothing ! do nothing
else if (alpha == -done) then else if (alpha == -cone) then
do i = 1, m do i = 1, m
y(i) = -y(i) y(i) = -y(i)
end do end do
@ -833,7 +833,7 @@ contains
if (lower) then if (lower) then
if (unit) then if (unit) then
do i=1, n do i=1, n
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j)*y(ja(j)) acc = acc + val(j)*y(ja(j))
end do end do
@ -841,7 +841,7 @@ contains
end do end do
else if (.not.unit) then else if (.not.unit) then
do i=1, n do i=1, n
acc = dzero acc = czero
do j=irp(i), irp(i+1)-2 do j=irp(i), irp(i+1)-2
acc = acc + val(j)*y(ja(j)) acc = acc + val(j)*y(ja(j))
end do end do
@ -852,7 +852,7 @@ contains
if (unit) then if (unit) then
do i=n, 1, -1 do i=n, 1, -1
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j)*y(ja(j)) acc = acc + val(j)*y(ja(j))
end do end do
@ -860,7 +860,7 @@ contains
end do end do
else if (.not.unit) then else if (.not.unit) then
do i=n, 1, -1 do i=n, 1, -1
acc = dzero acc = czero
do j=irp(i)+1, irp(i+1)-1 do j=irp(i)+1, irp(i+1)-1
acc = acc + val(j)*y(ja(j)) acc = acc + val(j)*y(ja(j))
end do end do
@ -1020,10 +1020,10 @@ subroutine psb_c_csr_cssm(alpha,a,x,beta,y,info,trans)
end if end if
if (alpha == dzero) then if (alpha == czero) then
if (beta == dzero) then if (beta == czero) then
do i = 1, m do i = 1, m
y(i,:) = dzero y(i,:) = czero
enddo enddo
else else
do i = 1, m do i = 1, m
@ -1033,7 +1033,7 @@ subroutine psb_c_csr_cssm(alpha,a,x,beta,y,info,trans)
return return
end if end if
if (beta == dzero) then if (beta == czero) then
call inner_csrsm(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),nc,& call inner_csrsm(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),nc,&
& a%irp,a%ja,a%val,x,size(x,1),y,size(y,1),info) & a%irp,a%ja,a%val,x,size(x,1),y,size(y,1),info)
do i = 1, m do i = 1, m
@ -1099,7 +1099,7 @@ contains
if (lower) then if (lower) then
if (unit) then if (unit) then
do i=1, nr do i=1, nr
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j)*y(ja(j),1:nc) acc = acc + val(j)*y(ja(j),1:nc)
end do end do
@ -1107,7 +1107,7 @@ contains
end do end do
else if (.not.unit) then else if (.not.unit) then
do i=1, nr do i=1, nr
acc = dzero acc = czero
do j=irp(i), irp(i+1)-2 do j=irp(i), irp(i+1)-2
acc = acc + val(j)*y(ja(j),1:nc) acc = acc + val(j)*y(ja(j),1:nc)
end do end do
@ -1118,7 +1118,7 @@ contains
if (unit) then if (unit) then
do i=nr, 1, -1 do i=nr, 1, -1
acc = dzero acc = czero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j)*y(ja(j),1:nc) acc = acc + val(j)*y(ja(j),1:nc)
end do end do
@ -1126,7 +1126,7 @@ contains
end do end do
else if (.not.unit) then else if (.not.unit) then
do i=nr, 1, -1 do i=nr, 1, -1
acc = dzero acc = czero
do j=irp(i)+1, irp(i+1)-1 do j=irp(i)+1, irp(i+1)-1
acc = acc + val(j)*y(ja(j),1:nc) acc = acc + val(j)*y(ja(j),1:nc)
end do end do
@ -1271,10 +1271,10 @@ function psb_c_csr_csnmi(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = dzero res = szero
do i = 1, a%get_nrows() do i = 1, a%get_nrows()
acc = dzero acc = szero
do j=a%irp(i),a%irp(i+1)-1 do j=a%irp(i),a%irp(i+1)-1
acc = acc + abs(a%val(j)) acc = acc + abs(a%val(j))
end do end do
@ -1301,7 +1301,7 @@ function psb_c_csr_csnm1(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = -sone res = szero
nnz = a%get_nzeros() nnz = a%get_nzeros()
m = a%get_nrows() m = a%get_nrows()
n = a%get_ncols() n = a%get_ncols()

2
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -1110,7 +1110,7 @@ function psb_s_csr_csnm1(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = -sone res = szero
nnz = a%get_nzeros() nnz = a%get_nzeros()
m = a%get_nrows() m = a%get_nrows()
n = a%get_ncols() n = a%get_ncols()

2
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -1637,7 +1637,7 @@ function psb_z_coo_csnm1(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = -done res = dzero
nnz = a%get_nzeros() nnz = a%get_nzeros()
n = a%get_ncols() n = a%get_ncols()
allocate(vt(n),stat=info) allocate(vt(n),stat=info)

2
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -1424,7 +1424,7 @@ function psb_z_csc_csnmi(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = zzero res = dzero
nr = a%get_nrows() nr = a%get_nrows()
nc = a%get_ncols() nc = a%get_ncols()
allocate(acc(nr),stat=info) allocate(acc(nr),stat=info)

192
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -100,10 +100,10 @@ contains
integer :: i,j,k, ir, jc integer :: i,j,k, ir, jc
complex(psb_dpk_) :: acc complex(psb_dpk_) :: acc
if (alpha == dzero) then if (alpha == zzero) then
if (beta == dzero) then if (beta == zzero) then
do i = 1, m do i = 1, m
y(i) = dzero y(i) = zzero
enddo enddo
else else
do i = 1, m do i = 1, m
@ -116,21 +116,21 @@ contains
if ((.not.tra).and.(.not.ctra)) then if ((.not.tra).and.(.not.ctra)) then
if (beta == dzero) then if (beta == zzero) then
if (alpha == done) then if (alpha == zone) then
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
y(i) = acc y(i) = acc
end do end do
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -140,7 +140,7 @@ contains
else else
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -150,21 +150,21 @@ contains
end if end if
else if (beta == done) then else if (beta == zone) then
if (alpha == done) then if (alpha == zone) then
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
y(i) = y(i) + acc y(i) = y(i) + acc
end do end do
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -174,7 +174,7 @@ contains
else else
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -183,21 +183,21 @@ contains
end if end if
else if (beta == -done) then else if (beta == -zone) then
if (alpha == done) then if (alpha == zone) then
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
y(i) = -y(i) + acc y(i) = -y(i) + acc
end do end do
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -207,7 +207,7 @@ contains
else else
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -218,19 +218,19 @@ contains
else else
if (alpha == done) then if (alpha == zone) then
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
y(i) = beta*y(i) + acc y(i) = beta*y(i) + acc
end do end do
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -240,7 +240,7 @@ contains
else else
do i=1,m do i=1,m
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j)) acc = acc + val(j) * x(ja(j))
enddo enddo
@ -253,13 +253,13 @@ contains
else if (tra) then else if (tra) then
if (beta == dzero) then if (beta == zzero) then
do i=1, m do i=1, m
y(i) = dzero y(i) = zzero
end do end do
else if (beta == done) then else if (beta == zone) then
! Do nothing ! Do nothing
else if (beta == -done) then else if (beta == -zone) then
do i=1, m do i=1, m
y(i) = -y(i) y(i) = -y(i)
end do end do
@ -269,7 +269,7 @@ contains
end do end do
end if end if
if (alpha == done) then if (alpha == zone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -278,7 +278,7 @@ contains
end do end do
enddo enddo
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -300,13 +300,13 @@ contains
else if (ctra) then else if (ctra) then
if (beta == dzero) then if (beta == zzero) then
do i=1, m do i=1, m
y(i) = dzero y(i) = zzero
end do end do
else if (beta == done) then else if (beta == zone) then
! Do nothing ! Do nothing
else if (beta == -done) then else if (beta == -zone) then
do i=1, m do i=1, m
y(i) = -y(i) y(i) = -y(i)
end do end do
@ -316,7 +316,7 @@ contains
end do end do
end if end if
if (alpha == done) then if (alpha == zone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -325,7 +325,7 @@ contains
end do end do
enddo enddo
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -452,10 +452,10 @@ contains
integer :: i,j,k, ir, jc integer :: i,j,k, ir, jc
if (alpha == dzero) then if (alpha == zzero) then
if (beta == dzero) then if (beta == zzero) then
do i = 1, m do i = 1, m
y(i,1:nc) = dzero y(i,1:nc) = zzero
enddo enddo
else else
do i = 1, m do i = 1, m
@ -466,21 +466,21 @@ contains
end if end if
if ((.not.tra).and.(.not.ctra)) then if ((.not.tra).and.(.not.ctra)) then
if (beta == dzero) then if (beta == zzero) then
if (alpha == done) then if (alpha == zone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
y(i,1:nc) = acc(1:nc) y(i,1:nc) = acc(1:nc)
end do end do
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -490,7 +490,7 @@ contains
else else
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -500,21 +500,21 @@ contains
end if end if
else if (beta == done) then else if (beta == zone) then
if (alpha == done) then if (alpha == zone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
y(i,1:nc) = y(i,1:nc) + acc(1:nc) y(i,1:nc) = y(i,1:nc) + acc(1:nc)
end do end do
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -524,7 +524,7 @@ contains
else else
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -533,21 +533,21 @@ contains
end if end if
else if (beta == -done) then else if (beta == -zone) then
if (alpha == done) then if (alpha == zone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
y(i,1:nc) = -y(i,1:nc) + acc(1:nc) y(i,1:nc) = -y(i,1:nc) + acc(1:nc)
end do end do
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -557,7 +557,7 @@ contains
else else
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -568,19 +568,19 @@ contains
else else
if (alpha == done) then if (alpha == zone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
y(i,1:nc) = beta*y(i,1:nc) + acc(1:nc) y(i,1:nc) = beta*y(i,1:nc) + acc(1:nc)
end do end do
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -590,7 +590,7 @@ contains
else else
do i=1,m do i=1,m
acc(1:nc) = dzero acc(1:nc) = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc)
enddo enddo
@ -603,13 +603,13 @@ contains
else if (tra) then else if (tra) then
if (beta == dzero) then if (beta == zzero) then
do i=1, m do i=1, m
y(i,1:nc) = dzero y(i,1:nc) = zzero
end do end do
else if (beta == done) then else if (beta == zone) then
! Do nothing ! Do nothing
else if (beta == -done) then else if (beta == -zone) then
do i=1, m do i=1, m
y(i,1:nc) = -y(i,1:nc) y(i,1:nc) = -y(i,1:nc)
end do end do
@ -619,7 +619,7 @@ contains
end do end do
end if end if
if (alpha == done) then if (alpha == zone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -628,7 +628,7 @@ contains
end do end do
enddo enddo
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -650,13 +650,13 @@ contains
else if (ctra) then else if (ctra) then
if (beta == dzero) then if (beta == zzero) then
do i=1, m do i=1, m
y(i,1:nc) = dzero y(i,1:nc) = zzero
end do end do
else if (beta == done) then else if (beta == zone) then
! Do nothing ! Do nothing
else if (beta == -done) then else if (beta == -zone) then
do i=1, m do i=1, m
y(i,1:nc) = -y(i,1:nc) y(i,1:nc) = -y(i,1:nc)
end do end do
@ -666,7 +666,7 @@ contains
end do end do
end if end if
if (alpha == done) then if (alpha == zone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -675,7 +675,7 @@ contains
end do end do
enddo enddo
else if (alpha == -done) then else if (alpha == -zone) then
do i=1,n do i=1,n
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
@ -763,10 +763,10 @@ subroutine psb_z_csr_cssv(alpha,a,x,beta,y,info,trans)
goto 9999 goto 9999
end if end if
if (alpha == dzero) then if (alpha == zzero) then
if (beta == dzero) then if (beta == zzero) then
do i = 1, m do i = 1, m
y(i) = dzero y(i) = zzero
enddo enddo
else else
do i = 1, m do i = 1, m
@ -776,13 +776,13 @@ subroutine psb_z_csr_cssv(alpha,a,x,beta,y,info,trans)
return return
end if end if
if (beta == dzero) then if (beta == zzero) then
call inner_csrsv(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),& call inner_csrsv(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),&
& a%irp,a%ja,a%val,x,y) & a%irp,a%ja,a%val,x,y)
if (alpha == done) then if (alpha == zone) then
! do nothing ! do nothing
else if (alpha == -done) then else if (alpha == -zone) then
do i = 1, m do i = 1, m
y(i) = -y(i) y(i) = -y(i)
end do end do
@ -834,7 +834,7 @@ contains
if (lower) then if (lower) then
if (unit) then if (unit) then
do i=1, n do i=1, n
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j)*y(ja(j)) acc = acc + val(j)*y(ja(j))
end do end do
@ -842,7 +842,7 @@ contains
end do end do
else if (.not.unit) then else if (.not.unit) then
do i=1, n do i=1, n
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-2 do j=irp(i), irp(i+1)-2
acc = acc + val(j)*y(ja(j)) acc = acc + val(j)*y(ja(j))
end do end do
@ -853,7 +853,7 @@ contains
if (unit) then if (unit) then
do i=n, 1, -1 do i=n, 1, -1
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j)*y(ja(j)) acc = acc + val(j)*y(ja(j))
end do end do
@ -861,7 +861,7 @@ contains
end do end do
else if (.not.unit) then else if (.not.unit) then
do i=n, 1, -1 do i=n, 1, -1
acc = dzero acc = zzero
do j=irp(i)+1, irp(i+1)-1 do j=irp(i)+1, irp(i+1)-1
acc = acc + val(j)*y(ja(j)) acc = acc + val(j)*y(ja(j))
end do end do
@ -1021,10 +1021,10 @@ subroutine psb_z_csr_cssm(alpha,a,x,beta,y,info,trans)
end if end if
if (alpha == dzero) then if (alpha == zzero) then
if (beta == dzero) then if (beta == zzero) then
do i = 1, m do i = 1, m
y(i,:) = dzero y(i,:) = zzero
enddo enddo
else else
do i = 1, m do i = 1, m
@ -1034,7 +1034,7 @@ subroutine psb_z_csr_cssm(alpha,a,x,beta,y,info,trans)
return return
end if end if
if (beta == dzero) then if (beta == zzero) then
call inner_csrsm(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),nc,& call inner_csrsm(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),nc,&
& a%irp,a%ja,a%val,x,size(x,1),y,size(y,1),info) & a%irp,a%ja,a%val,x,size(x,1),y,size(y,1),info)
do i = 1, m do i = 1, m
@ -1100,7 +1100,7 @@ contains
if (lower) then if (lower) then
if (unit) then if (unit) then
do i=1, nr do i=1, nr
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j)*y(ja(j),1:nc) acc = acc + val(j)*y(ja(j),1:nc)
end do end do
@ -1108,7 +1108,7 @@ contains
end do end do
else if (.not.unit) then else if (.not.unit) then
do i=1, nr do i=1, nr
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-2 do j=irp(i), irp(i+1)-2
acc = acc + val(j)*y(ja(j),1:nc) acc = acc + val(j)*y(ja(j),1:nc)
end do end do
@ -1119,7 +1119,7 @@ contains
if (unit) then if (unit) then
do i=nr, 1, -1 do i=nr, 1, -1
acc = dzero acc = zzero
do j=irp(i), irp(i+1)-1 do j=irp(i), irp(i+1)-1
acc = acc + val(j)*y(ja(j),1:nc) acc = acc + val(j)*y(ja(j),1:nc)
end do end do
@ -1127,7 +1127,7 @@ contains
end do end do
else if (.not.unit) then else if (.not.unit) then
do i=nr, 1, -1 do i=nr, 1, -1
acc = dzero acc = zzero
do j=irp(i)+1, irp(i+1)-1 do j=irp(i)+1, irp(i+1)-1
acc = acc + val(j)*y(ja(j),1:nc) acc = acc + val(j)*y(ja(j),1:nc)
end do end do
@ -1302,7 +1302,7 @@ function psb_z_csr_csnm1(a) result(res)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
res = -sone res = dzero
nnz = a%get_nzeros() nnz = a%get_nzeros()
m = a%get_nrows() m = a%get_nrows()
n = a%get_ncols() n = a%get_ncols()
@ -2528,7 +2528,7 @@ subroutine psb_z_csr_reinit(a,clear)
! do nothing ! do nothing
return return
else if (a%is_asb()) then else if (a%is_asb()) then
if (clear_) a%val(:) = dzero if (clear_) a%val(:) = zzero
call a%set_upd() call a%set_upd()
else else
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_

Write Preview
Loading…
Cancel
Save