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_csc_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_s_csc_impl.f90
 base/serial/impl/psb_z_csc_impl.f90

Fixed CSSM: was using a%icp etc by host association instead of dummy
argument.
psblas3-type-indexed
Salvatore Filippone 14 years ago
parent f8df315f48
commit 76fdd859f7
4 changed files with 116 additions and 116 deletions
Show Stats Download Patch File Download Diff File

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

@ -1258,18 +1258,18 @@ contains
if (unit) then
do i=1, nr
acc = czero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=1, nr
acc = czero
do j=a%icp(i), a%icp(i+1)-2
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-2
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i+1)-1)
y(i,1:nc) = (x(i,1:nc) - acc)/val(icp(i+1)-1)
end do
end if
else if (.not.lower) then
@ -1277,18 +1277,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = czero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=nr, 1, -1
acc = czero
do j=a%icp(i)+1, a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i)+1, icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i))
y(i,1:nc) = (x(i,1:nc) - acc)/val(icp(i))
end do
end if
@ -1300,18 +1300,18 @@ contains
if (unit) then
do i=1, nr
acc = czero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + conjg(a%val(j))*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + conjg(val(j))*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=1, nr
acc = czero
do j=a%icp(i), a%icp(i+1)-2
acc = acc + conjg(a%val(j))*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-2
acc = acc + conjg(val(j))*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/conjg(a%val(a%icp(i+1)-1))
y(i,1:nc) = (x(i,1:nc) - acc)/conjg(val(icp(i+1)-1))
end do
end if
else if (.not.lower) then
@ -1319,18 +1319,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = czero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + conjg(a%val(j))*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + conjg(val(j))*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=nr, 1, -1
acc = czero
do j=a%icp(i)+1, a%icp(i+1)-1
acc = acc + conjg(a%val(j))*y(a%ia(j),1:nc)
do j=icp(i)+1, icp(i+1)-1
acc = acc + conjg(val(j))*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/conjg(a%val(a%icp(i)))
y(i,1:nc) = (x(i,1:nc) - acc)/conjg(val(icp(i)))
end do
end if
@ -1346,18 +1346,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
else if (.not.unit) then
do i=nr, 1, -1
y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i+1)-1)
y(i,1:nc) = y(i,1:nc)/val(icp(i+1)-1)
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-2
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-2
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
end if
@ -1366,18 +1366,18 @@ contains
if (unit) then
do i=1, nr
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
else if (.not.unit) then
do i=1, nr
y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i))
y(i,1:nc) = y(i,1:nc)/val(icp(i))
acc = y(i,1:nc)
do j=a%icp(i)+1, a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i)+1, icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
end if

48
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -934,18 +934,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = dzero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=nr, 1, -1
acc = dzero
do j=a%icp(i)+1, a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i)+1, icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i))
y(i,1:nc) = (x(i,1:nc) - acc)/val(icp(i))
end do
end if
@ -954,18 +954,18 @@ contains
if (unit) then
do i=1, nr
acc = dzero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=1, nr
acc = dzero
do j=a%icp(i), a%icp(i+1)-2
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-2
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i+1)-1)
y(i,1:nc) = (x(i,1:nc) - acc)/val(icp(i+1)-1)
end do
end if
@ -982,18 +982,18 @@ contains
if (unit) then
do i=1, nr
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
else if (.not.unit) then
do i=1, nr
y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i))
y(i,1:nc) = y(i,1:nc)/val(icp(i))
acc = y(i,1:nc)
do j=a%icp(i)+1, a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i)+1, icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
end if
@ -1003,18 +1003,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
else if (.not.unit) then
do i=nr, 1, -1
y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i+1)-1)
y(i,1:nc) = y(i,1:nc)/val(icp(i+1)-1)
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-2
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-2
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
end if

48
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -935,18 +935,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = dzero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=nr, 1, -1
acc = dzero
do j=a%icp(i)+1, a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i)+1, icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i))
y(i,1:nc) = (x(i,1:nc) - acc)/val(icp(i))
end do
end if
@ -955,18 +955,18 @@ contains
if (unit) then
do i=1, nr
acc = dzero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=1, nr
acc = dzero
do j=a%icp(i), a%icp(i+1)-2
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-2
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i+1)-1)
y(i,1:nc) = (x(i,1:nc) - acc)/val(icp(i+1)-1)
end do
end if
@ -983,18 +983,18 @@ contains
if (unit) then
do i=1, nr
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
else if (.not.unit) then
do i=1, nr
y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i))
y(i,1:nc) = y(i,1:nc)/val(icp(i))
acc = y(i,1:nc)
do j=a%icp(i)+1, a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i)+1, icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
end if
@ -1004,18 +1004,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
else if (.not.unit) then
do i=nr, 1, -1
y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i+1)-1)
y(i,1:nc) = y(i,1:nc)/val(icp(i+1)-1)
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-2
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-2
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
end if

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

@ -1259,18 +1259,18 @@ contains
if (unit) then
do i=1, nr
acc = zzero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=1, nr
acc = zzero
do j=a%icp(i), a%icp(i+1)-2
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-2
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i+1)-1)
y(i,1:nc) = (x(i,1:nc) - acc)/val(icp(i+1)-1)
end do
end if
else if (.not.lower) then
@ -1278,18 +1278,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = zzero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=nr, 1, -1
acc = zzero
do j=a%icp(i)+1, a%icp(i+1)-1
acc = acc + a%val(j)*y(a%ia(j),1:nc)
do j=icp(i)+1, icp(i+1)-1
acc = acc + val(j)*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i))
y(i,1:nc) = (x(i,1:nc) - acc)/val(icp(i))
end do
end if
@ -1301,18 +1301,18 @@ contains
if (unit) then
do i=1, nr
acc = zzero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + conjg(a%val(j))*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + conjg(val(j))*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=1, nr
acc = zzero
do j=a%icp(i), a%icp(i+1)-2
acc = acc + conjg(a%val(j))*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-2
acc = acc + conjg(val(j))*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/conjg(a%val(a%icp(i+1)-1))
y(i,1:nc) = (x(i,1:nc) - acc)/conjg(val(icp(i+1)-1))
end do
end if
else if (.not.lower) then
@ -1320,18 +1320,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = zzero
do j=a%icp(i), a%icp(i+1)-1
acc = acc + conjg(a%val(j))*y(a%ia(j),1:nc)
do j=icp(i), icp(i+1)-1
acc = acc + conjg(val(j))*y(ia(j),1:nc)
end do
y(i,1:nc) = x(i,1:nc) - acc
end do
else if (.not.unit) then
do i=nr, 1, -1
acc = zzero
do j=a%icp(i)+1, a%icp(i+1)-1
acc = acc + conjg(a%val(j))*y(a%ia(j),1:nc)
do j=icp(i)+1, icp(i+1)-1
acc = acc + conjg(val(j))*y(ia(j),1:nc)
end do
y(i,1:nc) = (x(i,1:nc) - acc)/conjg(a%val(a%icp(i)))
y(i,1:nc) = (x(i,1:nc) - acc)/conjg(val(icp(i)))
end do
end if
@ -1347,18 +1347,18 @@ contains
if (unit) then
do i=nr, 1, -1
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
else if (.not.unit) then
do i=nr, 1, -1
y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i+1)-1)
y(i,1:nc) = y(i,1:nc)/val(icp(i+1)-1)
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-2
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-2
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
end if
@ -1367,18 +1367,18 @@ contains
if (unit) then
do i=1, nr
acc = y(i,1:nc)
do j=a%icp(i), a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i), icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
else if (.not.unit) then
do i=1, nr
y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i))
y(i,1:nc) = y(i,1:nc)/val(icp(i))
acc = y(i,1:nc)
do j=a%icp(i)+1, a%icp(i+1)-1
jc = a%ia(j)
y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc
do j=icp(i)+1, icp(i+1)-1
jc = ia(j)
y(jc,1:nc) = y(jc,1:nc) - val(j)*acc
end do
end do
end if

Write Preview
Loading…
Cancel
Save