Fix silly bug in rw_extd cleanup code when NR > MA+MB.

new-parstruct
Salvatore Filippone
parent ba72faee7d
commit 019b8d1307

@ -39,7 +39,8 @@
!
!
subroutine psb_crwextd(nr,a,info,b,rowscale)
use psb_base_mod, psb_protect_name => psb_crwextd
use psb_mat_mod
use psb_serial_mod, psb_protect_name => psb_crwextd
implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -89,17 +90,14 @@ subroutine psb_crwextd(nr,a,info,b,rowscale)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_crwextd
subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
use psb_base_mod, psb_protect_name => psb_cbase_rwextd
use psb_mat_mod
use psb_serial_mod, psb_protect_name => psb_cbase_rwextd
implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -151,7 +149,7 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
end do
end do
do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i)
a%irp(ma+j+1) = a%irp(ma+j)
end do
class default
@ -161,8 +159,8 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
else
do i=ma+2,nr+1
a%irp(i) = a%irp(i-1)
do j=ma+2,nr+1
a%irp(j) = a%irp(j-1)
end do
end if
@ -236,12 +234,8 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_cbase_rwextd

@ -39,7 +39,8 @@
!
!
subroutine psb_drwextd(nr,a,info,b,rowscale)
use psb_base_mod, psb_protect_name => psb_drwextd
use psb_mat_mod
use psb_serial_mod, psb_protect_name => psb_drwextd
implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -89,17 +90,14 @@ subroutine psb_drwextd(nr,a,info,b,rowscale)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_drwextd
subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
use psb_base_mod, psb_protect_name => psb_dbase_rwextd
use psb_mat_mod
use psb_serial_mod, psb_protect_name => psb_dbase_rwextd
implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -151,7 +149,7 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
end do
end do
do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i)
a%irp(ma+j+1) = a%irp(ma+j)
end do
class default
@ -161,8 +159,8 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
else
do i=ma+2,nr+1
a%irp(i) = a%irp(i-1)
do j=ma+2,nr+1
a%irp(j) = a%irp(j-1)
end do
end if
@ -174,8 +172,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)
@ -236,12 +234,8 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_dbase_rwextd

@ -39,7 +39,8 @@
!
!
subroutine psb_srwextd(nr,a,info,b,rowscale)
use psb_base_mod, psb_protect_name => psb_srwextd
use psb_mat_mod
use psb_serial_mod, psb_protect_name => psb_srwextd
implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -89,17 +90,14 @@ subroutine psb_srwextd(nr,a,info,b,rowscale)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_srwextd
subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
use psb_base_mod, psb_protect_name => psb_sbase_rwextd
use psb_mat_mod
use psb_serial_mod, psb_protect_name => psb_sbase_rwextd
implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -151,7 +149,7 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
end do
end do
do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i)
a%irp(ma+j+1) = a%irp(ma+j)
end do
class default
@ -161,8 +159,8 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
else
do i=ma+2,nr+1
a%irp(i) = a%irp(i-1)
do j=ma+2,nr+1
a%irp(j) = a%irp(j-1)
end do
end if
@ -236,12 +234,8 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_sbase_rwextd

@ -39,7 +39,8 @@
!
!
subroutine psb_zrwextd(nr,a,info,b,rowscale)
use psb_base_mod, psb_protect_name => psb_zrwextd
use psb_mat_mod
use psb_serial_mod, psb_protect_name => psb_zrwextd
implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -89,17 +90,14 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_zrwextd
subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
use psb_base_mod, psb_protect_name => psb_zbase_rwextd
use psb_mat_mod
use psb_serial_mod, psb_protect_name => psb_zbase_rwextd
implicit none
! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
@ -151,7 +149,7 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
end do
end do
do j=i,nr-ma
a%irp(ma+i+1) = a%irp(ma+i)
a%irp(ma+j+1) = a%irp(ma+j)
end do
class default
@ -161,8 +159,8 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
else
do i=ma+2,nr+1
a%irp(i) = a%irp(i-1)
do j=ma+2,nr+1
a%irp(j) = a%irp(j-1)
end do
end if
@ -236,12 +234,8 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_zbase_rwextd

Loading…
Cancel
Save