From 2fde94dfe64c258ed425a343fae85b74fe8009db Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 2 Nov 2016 12:02:13 +0000 Subject: [PATCH] psblas3: base/modules/psb_const_mod.F90 base/modules/psb_error_mod.F90 base/serial/impl/psb_c_csc_impl.f90 base/serial/impl/psb_c_csr_impl.f90 base/serial/impl/psb_d_csc_impl.f90 base/serial/impl/psb_d_csr_impl.f90 base/serial/impl/psb_s_csc_impl.f90 base/serial/impl/psb_s_csr_impl.f90 base/serial/impl/psb_z_csc_impl.f90 base/serial/impl/psb_z_csr_impl.f90 base/serial/psb_csymbmm.f90 base/serial/psb_dsymbmm.f90 base/serial/psb_ssymbmm.f90 base/serial/psb_zsymbmm.f90 base/tools/psb_cdren.f90 base/tools/psb_icdasb.F90 New error code. --- base/modules/psb_const_mod.F90 | 2 +- base/modules/psb_error_mod.F90 | 12 +++++------- base/serial/impl/psb_c_csc_impl.f90 | 3 +++ base/serial/impl/psb_c_csr_impl.f90 | 4 ++++ base/serial/impl/psb_d_csc_impl.f90 | 3 +++ base/serial/impl/psb_d_csr_impl.f90 | 4 ++++ base/serial/impl/psb_s_csc_impl.f90 | 3 +++ base/serial/impl/psb_s_csr_impl.f90 | 4 ++++ base/serial/impl/psb_z_csc_impl.f90 | 3 +++ base/serial/impl/psb_z_csr_impl.f90 | 4 ++++ base/serial/psb_csymbmm.f90 | 3 +++ base/serial/psb_dsymbmm.f90 | 3 +++ base/serial/psb_ssymbmm.f90 | 3 +++ base/serial/psb_zsymbmm.f90 | 3 +++ base/tools/psb_cdren.f90 | 2 +- base/tools/psb_icdasb.F90 | 4 ++-- 16 files changed, 49 insertions(+), 11 deletions(-) diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index ffdccd62..b4625bdd 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -217,9 +217,9 @@ module psb_const_mod integer(psb_ipk_), parameter, public :: psb_err_arg_m_required_=582 integer(psb_ipk_), parameter, public :: psb_err_many_optional_arg_=583 integer(psb_ipk_), parameter, public :: psb_err_optional_arg_pair_=584 - integer(psb_ipk_), parameter, public :: psb_err_spmat_invalid_state_=600 integer(psb_ipk_), parameter, public :: psb_err_missing_override_method_=700 integer(psb_ipk_), parameter, public :: psb_err_invalid_dynamic_type_=701 + integer(psb_ipk_), parameter, public :: psb_err_invalid_matrix_sizes_=1119 integer(psb_ipk_), parameter, public :: psb_err_rectangular_mat_unsupported_=1120 integer(psb_ipk_), parameter, public :: psb_err_invalid_mat_state_=1121 integer(psb_ipk_), parameter, public :: psb_err_invalid_cd_state_=1122 diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index 5d249412..c6145099 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -756,13 +756,6 @@ contains achmsg(1) = tmpmsg write(achmsg(2),'("Argument M is required when argument PARTS is specified")') - case(psb_err_spmat_invalid_state_) - allocate(achmsg(2)) - achmsg(1) = tmpmsg - write(achmsg(2),& - & '("Sparse Matrix and descriptors are in an invalid state for this subroutine call: ",i0)')& - &i_e_d(1) - case(psb_err_missing_override_method_) allocate(achmsg(2)) achmsg(1) = tmpmsg @@ -800,6 +793,11 @@ contains achmsg(1) = tmpmsg write(achmsg(2),'("Invalid state for vector")') + case(psb_err_invalid_matrix_sizes_) + allocate(achmsg(2)) + achmsg(1) = tmpmsg + write(achmsg(2),'("Invalid combination of matrix sizes")') + case(1125:1999) allocate(achmsg(2)) achmsg(1) = tmpmsg diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index f7a41d28..3925ff18 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -2855,6 +2855,9 @@ subroutine psb_ccscspspmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SPSPMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif nza = a%get_nzeros() nzb = b%get_nzeros() diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 160b84f6..ea8bbdb5 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -3082,7 +3082,11 @@ subroutine psb_ccsrspspmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SPSPMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif + nza = a%get_nzeros() nzb = b%get_nzeros() nzc = 2*(nza+nzb) diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index 2080bb0b..936276fc 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -2855,6 +2855,9 @@ subroutine psb_dcscspspmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SPSPMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif nza = a%get_nzeros() nzb = b%get_nzeros() diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index e7177580..8c3901bb 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -3082,7 +3082,11 @@ subroutine psb_dcsrspspmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SPSPMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif + nza = a%get_nzeros() nzb = b%get_nzeros() nzc = 2*(nza+nzb) diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index b119eaa1..82fab0a8 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -2855,6 +2855,9 @@ subroutine psb_scscspspmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SPSPMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif nza = a%get_nzeros() nzb = b%get_nzeros() diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index c1c9ba08..bac5a6a8 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -3082,7 +3082,11 @@ subroutine psb_scsrspspmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SPSPMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif + nza = a%get_nzeros() nzb = b%get_nzeros() nzc = 2*(nza+nzb) diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 99a21b86..1da23b47 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -2855,6 +2855,9 @@ subroutine psb_zcscspspmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SPSPMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif nza = a%get_nzeros() nzb = b%get_nzeros() diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index 23ed5b9c..d57c96c0 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -3082,7 +3082,11 @@ subroutine psb_zcsrspspmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SPSPMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif + nza = a%get_nzeros() nzb = b%get_nzeros() nzc = 2*(nza+nzb) diff --git a/base/serial/psb_csymbmm.f90 b/base/serial/psb_csymbmm.f90 index f7e46139..860ad6f6 100644 --- a/base/serial/psb_csymbmm.f90 +++ b/base/serial/psb_csymbmm.f90 @@ -105,6 +105,9 @@ subroutine psb_cbase_symbmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif allocate(itemp(max(ma,na,mb,nb)),stat=info) if (info /= psb_success_) then diff --git a/base/serial/psb_dsymbmm.f90 b/base/serial/psb_dsymbmm.f90 index 6984443e..da574749 100644 --- a/base/serial/psb_dsymbmm.f90 +++ b/base/serial/psb_dsymbmm.f90 @@ -105,6 +105,9 @@ subroutine psb_dbase_symbmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif allocate(itemp(max(ma,na,mb,nb)),stat=info) if (info /= psb_success_) then diff --git a/base/serial/psb_ssymbmm.f90 b/base/serial/psb_ssymbmm.f90 index c5bea182..872dfa0f 100644 --- a/base/serial/psb_ssymbmm.f90 +++ b/base/serial/psb_ssymbmm.f90 @@ -105,6 +105,9 @@ subroutine psb_sbase_symbmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif allocate(itemp(max(ma,na,mb,nb)),stat=info) if (info /= psb_success_) then diff --git a/base/serial/psb_zsymbmm.f90 b/base/serial/psb_zsymbmm.f90 index f31c02c5..929e5f31 100644 --- a/base/serial/psb_zsymbmm.f90 +++ b/base/serial/psb_zsymbmm.f90 @@ -105,6 +105,9 @@ subroutine psb_zbase_symbmm(a,b,c,info) if ( mb /= na ) then write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb + info = psb_err_invalid_matrix_sizes_ + call psb_errpush(info,name) + goto 9999 endif allocate(itemp(max(ma,na,mb,nb)),stat=info) if (info /= psb_success_) then diff --git a/base/tools/psb_cdren.f90 b/base/tools/psb_cdren.f90 index 351cd6a6..f987eee0 100644 --- a/base/tools/psb_cdren.f90 +++ b/base/tools/psb_cdren.f90 @@ -83,7 +83,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info) endif if (.not.psb_is_asb_desc(desc_a)) then - info = psb_err_spmat_invalid_state_ + info = psb_err_invalid_cd_state_ int_err(1) = dectype call psb_errpush(info,name,int_err) goto 9999 diff --git a/base/tools/psb_icdasb.F90 b/base/tools/psb_icdasb.F90 index 7688aa37..e00a3d2e 100644 --- a/base/tools/psb_icdasb.F90 +++ b/base/tools/psb_icdasb.F90 @@ -91,7 +91,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) endif if (.not.desc%is_ok()) then - info = psb_err_spmat_invalid_state_ + info = psb_err_invalid_cd_state_ int_err(1) = dectype call psb_errpush(info,name) goto 9999 @@ -156,7 +156,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) end if else - info = psb_err_spmat_invalid_state_ + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 endif