From 019b8d13077093310c975d23bf260bc36f1ba17c Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 23 Jan 2019 16:56:40 +0000 Subject: [PATCH] Fix silly bug in rw_extd cleanup code when NR > MA+MB. --- base/serial/psb_crwextd.f90 | 28 +++++++++++----------------- base/serial/psb_drwextd.f90 | 32 +++++++++++++------------------- base/serial/psb_srwextd.f90 | 28 +++++++++++----------------- base/serial/psb_zrwextd.f90 | 28 +++++++++++----------------- 4 files changed, 46 insertions(+), 70 deletions(-) diff --git a/base/serial/psb_crwextd.f90 b/base/serial/psb_crwextd.f90 index e19af57a..d5d6e83d 100644 --- a/base/serial/psb_crwextd.f90 +++ b/base/serial/psb_crwextd.f90 @@ -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 diff --git a/base/serial/psb_drwextd.f90 b/base/serial/psb_drwextd.f90 index c2f39473..d447ee40 100644 --- a/base/serial/psb_drwextd.f90 +++ b/base/serial/psb_drwextd.f90 @@ -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 diff --git a/base/serial/psb_srwextd.f90 b/base/serial/psb_srwextd.f90 index 4e286d38..38e50cef 100644 --- a/base/serial/psb_srwextd.f90 +++ b/base/serial/psb_srwextd.f90 @@ -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 diff --git a/base/serial/psb_zrwextd.f90 b/base/serial/psb_zrwextd.f90 index a45beedc..301e962d 100644 --- a/base/serial/psb_zrwextd.f90 +++ b/base/serial/psb_zrwextd.f90 @@ -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