From 3440db4404f2020a58233dd50fdffa8f7bcc0b74 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 2 May 2011 15:29:22 +0000 Subject: [PATCH] psblas3: base/modules/psb_error_mod.F90 base/serial/impl/psb_c_coo_impl.f90 base/serial/impl/psb_d_coo_impl.f90 base/serial/impl/psb_s_coo_impl.f90 base/serial/impl/psb_z_coo_impl.f90 Slight mod in error code. Fix silly bug for COO in the case NZ=1 --- base/modules/psb_error_mod.F90 | 3 ++- base/serial/impl/psb_c_coo_impl.f90 | 13 +++++++------ base/serial/impl/psb_d_coo_impl.f90 | 13 +++++++------ base/serial/impl/psb_s_coo_impl.f90 | 13 +++++++------ base/serial/impl/psb_z_coo_impl.f90 | 13 +++++++------ 5 files changed, 30 insertions(+), 25 deletions(-) diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index c3b77f47..1d5cc18f 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -314,7 +314,8 @@ contains write(psb_err_unit,'("input argument n. ",i0," has an invalid value")')i_e_d(1) write(psb_err_unit,'("current value is ",a)')a_e_d(2:2) case(psb_err_iarg_not_gtia_ii_) - write(psb_err_unit,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') & + write(psb_err_unit,& + & '("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') & & i_e_d(1), i_e_d(3) write(psb_err_unit,'("current values are ",i0," < ",i0)')& & i_e_d(2),i_e_d(5) diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 02a72f71..6b9a50af 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -2971,12 +2971,13 @@ subroutine psb_c_fix_coo(a,info,idir) endif nza = a%get_nzeros() - if (nza < 2) return - - dupl_ = a%get_dupl() - - call psb_c_fix_coo_inner(nza,dupl_,a%ia,a%ja,a%val,i,info,idir_) - if (info /= psb_success_) goto 9999 + if (nza >= 2) then + dupl_ = a%get_dupl() + call psb_c_fix_coo_inner(nza,dupl_,a%ia,a%ja,a%val,i,info,idir_) + if (info /= psb_success_) goto 9999 + else + i = nza + end if call a%set_sorted() call a%set_nzeros(i) call a%set_asb() diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 8d22c396..3ae77b36 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -3017,12 +3017,13 @@ subroutine psb_d_fix_coo(a,info,idir) endif nza = a%get_nzeros() - if (nza < 2) return - - dupl_ = a%get_dupl() - - call psb_d_fix_coo_inner(nza,dupl_,a%ia,a%ja,a%val,i,info,idir_) - if (info /= psb_success_) goto 9999 + if (nza >= 2) then + dupl_ = a%get_dupl() + call psb_d_fix_coo_inner(nza,dupl_,a%ia,a%ja,a%val,i,info,idir_) + if (info /= psb_success_) goto 9999 + else + i = nza + end if call a%set_sorted() call a%set_nzeros(i) call a%set_asb() diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 5908fa75..42e9bfdc 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -2770,12 +2770,13 @@ subroutine psb_s_fix_coo(a,info,idir) endif nza = a%get_nzeros() - if (nza < 2) return - - dupl_ = a%get_dupl() - - call psb_s_fix_coo_inner(nza,dupl_,a%ia,a%ja,a%val,i,info,idir_) - if (info /= psb_success_) goto 9999 + if (nza >= 2) then + dupl_ = a%get_dupl() + call psb_s_fix_coo_inner(nza,dupl_,a%ia,a%ja,a%val,i,info,idir_) + if (info /= psb_success_) goto 9999 + else + i = nza + end if call a%set_sorted() call a%set_nzeros(i) call a%set_asb() diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index 1a9ae21e..b156427c 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -2970,12 +2970,13 @@ subroutine psb_z_fix_coo(a,info,idir) endif nza = a%get_nzeros() - if (nza < 2) return - - dupl_ = a%get_dupl() - - call psb_z_fix_coo_inner(nza,dupl_,a%ia,a%ja,a%val,i,info,idir_) - if (info /= psb_success_) goto 9999 + if (nza >= 2) then + dupl_ = a%get_dupl() + call psb_z_fix_coo_inner(nza,dupl_,a%ia,a%ja,a%val,i,info,idir_) + if (info /= psb_success_) goto 9999 + else + i = nza + end if call a%set_sorted() call a%set_nzeros(i) call a%set_asb()