From fde4f72c54be7b5cac71374fd6d4d4a4859e4f00 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 25 Feb 2011 12:49:27 +0000 Subject: [PATCH] psblas3: 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. --- base/serial/psb_crwextd.f90 | 12 +++--------- base/serial/psb_drwextd.f90 | 16 +++++----------- base/serial/psb_srwextd.f90 | 12 +++--------- base/serial/psb_zrwextd.f90 | 12 +++--------- 4 files changed, 14 insertions(+), 38 deletions(-) diff --git a/base/serial/psb_crwextd.f90 b/base/serial/psb_crwextd.f90 index 0a1a51af..c2bef075 100644 --- a/base/serial/psb_crwextd.f90 +++ b/base/serial/psb_crwextd.f90 @@ -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) diff --git a/base/serial/psb_drwextd.f90 b/base/serial/psb_drwextd.f90 index 0c557f5e..3c59a534 100644 --- a/base/serial/psb_drwextd.f90 +++ b/base/serial/psb_drwextd.f90 @@ -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) diff --git a/base/serial/psb_srwextd.f90 b/base/serial/psb_srwextd.f90 index f9c7b702..222adfb3 100644 --- a/base/serial/psb_srwextd.f90 +++ b/base/serial/psb_srwextd.f90 @@ -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) diff --git a/base/serial/psb_zrwextd.f90 b/base/serial/psb_zrwextd.f90 index 1039f8e3..cd3e6edd 100644 --- a/base/serial/psb_zrwextd.f90 +++ b/base/serial/psb_zrwextd.f90 @@ -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)