From b8cba236637e5ff0110e59be81f2e702b06dfa82 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 30 Sep 2018 14:48:26 +0100 Subject: [PATCH] Fix bounds computation in set_vect. Bug report by Alexandre Silva Lopes CG: allocate wrk with scratch=.true. --- base/modules/serial/psb_c_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_d_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_i_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_l_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_s_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_z_base_vect_mod.f90 | 4 ++-- krylov/psb_ccg.F90 | 2 +- krylov/psb_dcg.F90 | 2 +- krylov/psb_scg.F90 | 2 +- krylov/psb_zcg.F90 | 2 +- 10 files changed, 16 insertions(+), 16 deletions(-) diff --git a/base/modules/serial/psb_c_base_vect_mod.f90 b/base/modules/serial/psb_c_base_vect_mod.f90 index 44adceeb..5ec82814 100644 --- a/base/modules/serial/psb_c_base_vect_mod.f90 +++ b/base/modules/serial/psb_c_base_vect_mod.f90 @@ -794,9 +794,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_d_base_vect_mod.f90 b/base/modules/serial/psb_d_base_vect_mod.f90 index 460b7c78..7645f178 100644 --- a/base/modules/serial/psb_d_base_vect_mod.f90 +++ b/base/modules/serial/psb_d_base_vect_mod.f90 @@ -794,9 +794,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_i_base_vect_mod.f90 b/base/modules/serial/psb_i_base_vect_mod.f90 index 8d6f2cc5..a6da896b 100644 --- a/base/modules/serial/psb_i_base_vect_mod.f90 +++ b/base/modules/serial/psb_i_base_vect_mod.f90 @@ -762,9 +762,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_l_base_vect_mod.f90 b/base/modules/serial/psb_l_base_vect_mod.f90 index 84450a17..c379242f 100644 --- a/base/modules/serial/psb_l_base_vect_mod.f90 +++ b/base/modules/serial/psb_l_base_vect_mod.f90 @@ -763,9 +763,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_s_base_vect_mod.f90 b/base/modules/serial/psb_s_base_vect_mod.f90 index e3002b17..5496ad18 100644 --- a/base/modules/serial/psb_s_base_vect_mod.f90 +++ b/base/modules/serial/psb_s_base_vect_mod.f90 @@ -794,9 +794,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_z_base_vect_mod.f90 b/base/modules/serial/psb_z_base_vect_mod.f90 index c0c41cc9..59660dde 100644 --- a/base/modules/serial/psb_z_base_vect_mod.f90 +++ b/base/modules/serial/psb_z_base_vect_mod.f90 @@ -794,9 +794,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/krylov/psb_ccg.F90 b/krylov/psb_ccg.F90 index 7a448c87..b9865861 100644 --- a/krylov/psb_ccg.F90 +++ b/krylov/psb_ccg.F90 @@ -173,7 +173,7 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,& naux=4*n_col allocate(aux(naux), stat=info) if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_) - if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.) if (info /= psb_success_) then info=psb_err_from_subroutine_non_ call psb_errpush(info,name) diff --git a/krylov/psb_dcg.F90 b/krylov/psb_dcg.F90 index 5ca0b470..dcccbd39 100644 --- a/krylov/psb_dcg.F90 +++ b/krylov/psb_dcg.F90 @@ -173,7 +173,7 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& naux=4*n_col allocate(aux(naux), stat=info) if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_) - if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.) if (info /= psb_success_) then info=psb_err_from_subroutine_non_ call psb_errpush(info,name) diff --git a/krylov/psb_scg.F90 b/krylov/psb_scg.F90 index bc15ce8e..c85520c0 100644 --- a/krylov/psb_scg.F90 +++ b/krylov/psb_scg.F90 @@ -173,7 +173,7 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,& naux=4*n_col allocate(aux(naux), stat=info) if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_) - if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.) if (info /= psb_success_) then info=psb_err_from_subroutine_non_ call psb_errpush(info,name) diff --git a/krylov/psb_zcg.F90 b/krylov/psb_zcg.F90 index bdc926d0..a5616e85 100644 --- a/krylov/psb_zcg.F90 +++ b/krylov/psb_zcg.F90 @@ -173,7 +173,7 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,& naux=4*n_col allocate(aux(naux), stat=info) if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_) - if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.) if (info /= psb_success_) then info=psb_err_from_subroutine_non_ call psb_errpush(info,name)