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

psblas3:

Browse Source 
base/serial/psb_crwextd.f90
 base/serial/psb_drwextd.f90
 base/serial/psb_srwextd.f90
 base/serial/psb_zrwextd.f90

Fixed out-of-bounds error.
This commit is contained in:
Salvatore Filippone
2011-02-25 12:49:27 +00:00
parent bf06e61067
commit fde4f72c54
4 changed files with 14 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/psb_crwextd.f90
+3 -9
View File
@@ -144,19 +144,16 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
do i=1, min(nr-ma,mb)
a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i)
ja = a%irp(ma+i)
jb = b%irp(i)
do
if (jb >= b%irp(i+1)) exit
do jb = b%irp(i), b%irp(i+1)-1
a%val(ja) = b%val(jb)
a%ja(ja) = b%ja(jb)
ja = ja + 1
jb = jb + 1
end do
end do
do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i)
end do
class default
class default
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select
@@ -209,14 +206,11 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
type is (psb_c_csr_sparse_mat)
do i=1, min(nr-ma,mb)
do
jb = b%irp(i)
if (jb >= b%irp(i+1)) exit
do jb = b%irp(i), b%irp(i+1)-1
nza = nza + 1
a%val(nza) = b%val(jb)
a%ia(nza) = ma + i
a%ja(nza) = b%ja(jb)
jb = jb + 1
end do
end do
call a%set_nzeros(nza)
base/serial/psb_drwextd.f90
+5 -11
View File
@@ -144,19 +144,16 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
do i=1, min(nr-ma,mb)
a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i)
ja = a%irp(ma+i)
jb = b%irp(i)
do
if (jb >= b%irp(i+1)) exit
do jb = b%irp(i), b%irp(i+1)-1
a%val(ja) = b%val(jb)
a%ja(ja) = b%ja(jb)
ja = ja + 1
jb = jb + 1
end do
end do
do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i)
end do
class default
class default
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select
@@ -177,8 +174,8 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
nza = a%get_nzeros()
if (present(b)) then
mb = b%get_nrows()
nb = b%get_ncols()
mb = b%get_nrows()
nb = b%get_ncols()
nzb = b%get_nzeros()
call a%reallocate(nza+nzb)
@@ -209,14 +206,11 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
type is (psb_d_csr_sparse_mat)
do i=1, min(nr-ma,mb)
do
jb = b%irp(i)
if (jb >= b%irp(i+1)) exit
do jb = b%irp(i), b%irp(i+1)-1
nza = nza + 1
a%val(nza) = b%val(jb)
a%ia(nza) = ma + i
a%ja(nza) = b%ja(jb)
jb = jb + 1
end do
end do
call a%set_nzeros(nza)
base/serial/psb_srwextd.f90
+3 -9
View File
@@ -144,19 +144,16 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
do i=1, min(nr-ma,mb)
a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i)
ja = a%irp(ma+i)
jb = b%irp(i)
do
if (jb >= b%irp(i+1)) exit
do jb = b%irp(i), b%irp(i+1)-1
a%val(ja) = b%val(jb)
a%ja(ja) = b%ja(jb)
ja = ja + 1
jb = jb + 1
end do
end do
do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i)
end do
class default
class default
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select
@@ -209,14 +206,11 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
type is (psb_s_csr_sparse_mat)
do i=1, min(nr-ma,mb)
do
jb = b%irp(i)
if (jb >= b%irp(i+1)) exit
do jb = b%irp(i), b%irp(i+1)-1
nza = nza + 1
a%val(nza) = b%val(jb)
a%ia(nza) = ma + i
a%ja(nza) = b%ja(jb)
jb = jb + 1
end do
end do
call a%set_nzeros(nza)
base/serial/psb_zrwextd.f90
+3 -9
View File
@@ -144,19 +144,16 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
do i=1, min(nr-ma,mb)
a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i)
ja = a%irp(ma+i)
jb = b%irp(i)
do
if (jb >= b%irp(i+1)) exit
do jb = b%irp(i), b%irp(i+1)-1
a%val(ja) = b%val(jb)
a%ja(ja) = b%ja(jb)
ja = ja + 1
jb = jb + 1
end do
end do
do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i)
end do
class default
class default
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select
@@ -209,14 +206,11 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
type is (psb_z_csr_sparse_mat)
do i=1, min(nr-ma,mb)
do
jb = b%irp(i)
if (jb >= b%irp(i+1)) exit
do jb = b%irp(i), b%irp(i+1)-1
nza = nza + 1
a%val(nza) = b%val(jb)
a%ia(nza) = ma + i
a%ja(nza) = b%ja(jb)
jb = jb + 1
end do
end do
call a%set_nzeros(nza)