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/psb_crwextd.f90
 base/serial/psb_drwextd.f90
 base/serial/psb_srwextd.f90
 base/serial/psb_zrwextd.f90

Fixed out-of-bounds error.
psblas3-type-indexed
Salvatore Filippone 14 years ago
parent bf06e61067
commit fde4f72c54
4 changed files with 14 additions and 38 deletions
Show Stats Download Patch File Download Diff File

12
base/serial/psb_crwextd.f90
Unescape Escape View File

@ -144,19 +144,16 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
do i=1, min(nr-ma,mb) do i=1, min(nr-ma,mb)
a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i)
ja = a%irp(ma+i) ja = a%irp(ma+i)
jb = b%irp(i) do jb = b%irp(i), b%irp(i+1)-1
do
if (jb >= b%irp(i+1)) exit
a%val(ja) = b%val(jb) a%val(ja) = b%val(jb)
a%ja(ja) = b%ja(jb) a%ja(ja) = b%ja(jb)
ja = ja + 1 ja = ja + 1
jb = jb + 1
end do end do
end do end do
do j=i,nr-ma do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i) a%irp(ma+i+1) = a%irp(ma+i)
end do end do
class default class default
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!' write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select end select
@ -209,14 +206,11 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
type is (psb_c_csr_sparse_mat) type is (psb_c_csr_sparse_mat)
do i=1, min(nr-ma,mb) do i=1, min(nr-ma,mb)
do do jb = b%irp(i), b%irp(i+1)-1
jb = b%irp(i)
if (jb >= b%irp(i+1)) exit
nza = nza + 1 nza = nza + 1
a%val(nza) = b%val(jb) a%val(nza) = b%val(jb)
a%ia(nza) = ma + i a%ia(nza) = ma + i
a%ja(nza) = b%ja(jb) a%ja(nza) = b%ja(jb)
jb = jb + 1
end do end do
end do end do
call a%set_nzeros(nza) call a%set_nzeros(nza)

16
base/serial/psb_drwextd.f90
Unescape Escape View File

@ -144,19 +144,16 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
do i=1, min(nr-ma,mb) do i=1, min(nr-ma,mb)
a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i)
ja = a%irp(ma+i) ja = a%irp(ma+i)
jb = b%irp(i) do jb = b%irp(i), b%irp(i+1)-1
do
if (jb >= b%irp(i+1)) exit
a%val(ja) = b%val(jb) a%val(ja) = b%val(jb)
a%ja(ja) = b%ja(jb) a%ja(ja) = b%ja(jb)
ja = ja + 1 ja = ja + 1
jb = jb + 1
end do end do
end do end do
do j=i,nr-ma do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i) a%irp(ma+i+1) = a%irp(ma+i)
end do end do
class default class default
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!' write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select end select
@ -177,8 +174,8 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
nza = a%get_nzeros() nza = a%get_nzeros()
if (present(b)) then if (present(b)) then
mb = b%get_nrows() mb = b%get_nrows()
nb = b%get_ncols() nb = b%get_ncols()
nzb = b%get_nzeros() nzb = b%get_nzeros()
call a%reallocate(nza+nzb) 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) type is (psb_d_csr_sparse_mat)
do i=1, min(nr-ma,mb) do i=1, min(nr-ma,mb)
do do jb = b%irp(i), b%irp(i+1)-1
jb = b%irp(i)
if (jb >= b%irp(i+1)) exit
nza = nza + 1 nza = nza + 1
a%val(nza) = b%val(jb) a%val(nza) = b%val(jb)
a%ia(nza) = ma + i a%ia(nza) = ma + i
a%ja(nza) = b%ja(jb) a%ja(nza) = b%ja(jb)
jb = jb + 1
end do end do
end do end do
call a%set_nzeros(nza) call a%set_nzeros(nza)

12
base/serial/psb_srwextd.f90
Unescape Escape View File

@ -144,19 +144,16 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
do i=1, min(nr-ma,mb) do i=1, min(nr-ma,mb)
a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i)
ja = a%irp(ma+i) ja = a%irp(ma+i)
jb = b%irp(i) do jb = b%irp(i), b%irp(i+1)-1
do
if (jb >= b%irp(i+1)) exit
a%val(ja) = b%val(jb) a%val(ja) = b%val(jb)
a%ja(ja) = b%ja(jb) a%ja(ja) = b%ja(jb)
ja = ja + 1 ja = ja + 1
jb = jb + 1
end do end do
end do end do
do j=i,nr-ma do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i) a%irp(ma+i+1) = a%irp(ma+i)
end do end do
class default class default
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!' write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select end select
@ -209,14 +206,11 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
type is (psb_s_csr_sparse_mat) type is (psb_s_csr_sparse_mat)
do i=1, min(nr-ma,mb) do i=1, min(nr-ma,mb)
do do jb = b%irp(i), b%irp(i+1)-1
jb = b%irp(i)
if (jb >= b%irp(i+1)) exit
nza = nza + 1 nza = nza + 1
a%val(nza) = b%val(jb) a%val(nza) = b%val(jb)
a%ia(nza) = ma + i a%ia(nza) = ma + i
a%ja(nza) = b%ja(jb) a%ja(nza) = b%ja(jb)
jb = jb + 1
end do end do
end do end do
call a%set_nzeros(nza) call a%set_nzeros(nza)

12
base/serial/psb_zrwextd.f90
Unescape Escape View File

@ -144,19 +144,16 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
do i=1, min(nr-ma,mb) do i=1, min(nr-ma,mb)
a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i)
ja = a%irp(ma+i) ja = a%irp(ma+i)
jb = b%irp(i) do jb = b%irp(i), b%irp(i+1)-1
do
if (jb >= b%irp(i+1)) exit
a%val(ja) = b%val(jb) a%val(ja) = b%val(jb)
a%ja(ja) = b%ja(jb) a%ja(ja) = b%ja(jb)
ja = ja + 1 ja = ja + 1
jb = jb + 1
end do end do
end do end do
do j=i,nr-ma do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i) a%irp(ma+i+1) = a%irp(ma+i)
end do end do
class default class default
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!' write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select end select
@ -209,14 +206,11 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
type is (psb_z_csr_sparse_mat) type is (psb_z_csr_sparse_mat)
do i=1, min(nr-ma,mb) do i=1, min(nr-ma,mb)
do do jb = b%irp(i), b%irp(i+1)-1
jb = b%irp(i)
if (jb >= b%irp(i+1)) exit
nza = nza + 1 nza = nza + 1
a%val(nza) = b%val(jb) a%val(nza) = b%val(jb)
a%ia(nza) = ma + i a%ia(nza) = ma + i
a%ja(nza) = b%ja(jb) a%ja(nza) = b%ja(jb)
jb = jb + 1
end do end do
end do end do
call a%set_nzeros(nza) call a%set_nzeros(nza)

Write Preview
Loading…
Cancel
Save