From c3587eed3ffcb5dca496d5436e699a7183a2f498 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 26 Jun 2012 19:46:57 +0000 Subject: [PATCH] psblas-3.0-maint: base/modules/psb_indx_map_mod.f90 krylov/psb_crgmres.f90 krylov/psb_drgmres.f90 krylov/psb_srgmres.f90 krylov/psb_zrgmres.f90 prec/impl/psb_c_bjacprec_impl.f90 prec/impl/psb_d_bjacprec_impl.f90 prec/impl/psb_s_bjacprec_impl.f90 prec/impl/psb_z_bjacprec_impl.f90 Bug fixes for bjacprec and rgmres. --- base/modules/psb_indx_map_mod.f90 | 8 ++++---- krylov/psb_crgmres.f90 | 8 ++++---- krylov/psb_drgmres.f90 | 10 +++++----- krylov/psb_srgmres.f90 | 6 +++--- krylov/psb_zrgmres.f90 | 10 +++++----- prec/impl/psb_c_bjacprec_impl.f90 | 3 +-- prec/impl/psb_d_bjacprec_impl.f90 | 3 +-- prec/impl/psb_s_bjacprec_impl.f90 | 3 +-- prec/impl/psb_z_bjacprec_impl.f90 | 3 +-- 9 files changed, 25 insertions(+), 29 deletions(-) diff --git a/base/modules/psb_indx_map_mod.f90 b/base/modules/psb_indx_map_mod.f90 index 6ac55dedb..9f5a8773e 100644 --- a/base/modules/psb_indx_map_mod.f90 +++ b/base/modules/psb_indx_map_mod.f90 @@ -668,7 +668,7 @@ contains integer(psb_ipk_), intent(inout) :: idx integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: mask - integer, intent(in), optional :: lidx + integer(psb_ipk_), intent(in), optional :: lidx integer(psb_ipk_) :: err_act character(len=20) :: name='base_g2l_ins' logical, parameter :: debug=.false. @@ -695,7 +695,7 @@ contains integer(psb_ipk_), intent(out) :: idxout integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: mask - integer, intent(in), optional :: lidx + integer(psb_ipk_), intent(in), optional :: lidx integer(psb_ipk_) :: err_act character(len=20) :: name='base_g2l_ins' @@ -723,7 +723,7 @@ contains integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: mask(:) - integer, intent(in), optional :: lidx(:) + integer(psb_ipk_), intent(in), optional :: lidx(:) integer(psb_ipk_) :: err_act character(len=20) :: name='base_g2l_ins' @@ -751,7 +751,7 @@ contains integer(psb_ipk_), intent(out) :: idxout(:) integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: mask(:) - integer, intent(in), optional :: lidx(:) + integer(psb_ipk_), intent(in), optional :: lidx(:) integer(psb_ipk_) :: err_act character(len=20) :: name='base_g2l_ins' diff --git a/krylov/psb_crgmres.f90 b/krylov/psb_crgmres.f90 index 224f86aa3..f2d731640 100644 --- a/krylov/psb_crgmres.f90 +++ b/krylov/psb_crgmres.f90 @@ -506,7 +506,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& character(len=*), parameter :: methdname='RGMRES' info = psb_success_ - name = 'psb_sgmres' + name = 'psb_cgmres' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -717,7 +717,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& scal=cone/h(i+1,i) call psb_geaxpby(scal,w,czero,v(i+1),desc_a,info) do k=2,i - call crot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1)) + call crot(1,h(k-1,i),1,h(k,i),1,real(c(k-1),kind=psb_spk_),s(k-1)) enddo @@ -725,9 +725,9 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& rti1 = h(i+1,i) call crotg(rti,rti1,tmp,s(i)) c(i) = cmplx(tmp,szero) - call crot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i)) + call crot(1,h(i,i),1,h(i+1,i),1,real(c(i),kind=psb_spk_),s(i)) h(i+1,i) = czero - call crot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i)) + call crot(1,rs(i),1,rs(i+1),1,real(c(i),kind=psb_spk_),s(i)) if (istop_ == 1) then ! diff --git a/krylov/psb_drgmres.f90 b/krylov/psb_drgmres.f90 index dc040b814..8bf4701ab 100644 --- a/krylov/psb_drgmres.f90 +++ b/krylov/psb_drgmres.f90 @@ -506,7 +506,7 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& character(len=*), parameter :: methdname='RGMRES' info = psb_success_ - name = 'psb_sgmres' + name = 'psb_dgmres' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -717,17 +717,17 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& scal=done/h(i+1,i) call psb_geaxpby(scal,w,dzero,v(i+1),desc_a,info) do k=2,i - call drot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1)) + call drot(1,h(k-1,i),1,h(k,i),1,real(c(k-1),kind=psb_dpk_),s(k-1)) enddo rti = h(i,i) rti1 = h(i+1,i) call drotg(rti,rti1,tmp,s(i)) - c(i) = cmplx(tmp,szero) - call drot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i)) + c(i) = cmplx(tmp,dzero) + call drot(1,h(i,i),1,h(i+1,i),1,real(c(i),kind=psb_dpk_),s(i)) h(i+1,i) = dzero - call drot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i)) + call drot(1,rs(i),1,rs(i+1),1,real(c(i),kind=psb_dpk_),s(i)) if (istop_ == 1) then ! diff --git a/krylov/psb_srgmres.f90 b/krylov/psb_srgmres.f90 index 42d1dc391..3e671b783 100644 --- a/krylov/psb_srgmres.f90 +++ b/krylov/psb_srgmres.f90 @@ -717,7 +717,7 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& scal=sone/h(i+1,i) call psb_geaxpby(scal,w,szero,v(i+1),desc_a,info) do k=2,i - call srot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1)) + call srot(1,h(k-1,i),1,h(k,i),1,real(c(k-1),kind=psb_spk_),s(k-1)) enddo @@ -725,9 +725,9 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& rti1 = h(i+1,i) call srotg(rti,rti1,tmp,s(i)) c(i) = cmplx(tmp,szero) - call srot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i)) + call srot(1,h(i,i),1,h(i+1,i),1,real(c(i),kind=psb_spk_),s(i)) h(i+1,i) = szero - call srot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i)) + call srot(1,rs(i),1,rs(i+1),1,real(c(i),kind=psb_spk_),s(i)) if (istop_ == 1) then ! diff --git a/krylov/psb_zrgmres.f90 b/krylov/psb_zrgmres.f90 index 82ba7cbe1..5852cba94 100644 --- a/krylov/psb_zrgmres.f90 +++ b/krylov/psb_zrgmres.f90 @@ -506,7 +506,7 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& character(len=*), parameter :: methdname='RGMRES' info = psb_success_ - name = 'psb_sgmres' + name = 'psb_zgmres' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -717,17 +717,17 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& scal=zone/h(i+1,i) call psb_geaxpby(scal,w,zzero,v(i+1),desc_a,info) do k=2,i - call zrot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1)) + call zrot(1,h(k-1,i),1,h(k,i),1,real(c(k-1),kind=psb_dpk_),s(k-1)) enddo rti = h(i,i) rti1 = h(i+1,i) call zrotg(rti,rti1,tmp,s(i)) - c(i) = cmplx(tmp,szero) - call zrot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i)) + c(i) = cmplx(tmp,dzero) + call zrot(1,h(i,i),1,h(i+1,i),1,real(c(i),kind=psb_dpk_),s(i)) h(i+1,i) = zzero - call zrot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i)) + call zrot(1,rs(i),1,rs(i+1),1,real(c(i),kind=psb_dpk_),s(i)) if (istop_ == 1) then ! diff --git a/prec/impl/psb_c_bjacprec_impl.f90 b/prec/impl/psb_c_bjacprec_impl.f90 index 85566479f..6143157f1 100644 --- a/prec/impl/psb_c_bjacprec_impl.f90 +++ b/prec/impl/psb_c_bjacprec_impl.f90 @@ -147,7 +147,6 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) else allocate(ww(n_col),aux(4*n_col),stat=info) endif - if (info == psb_success_) allocate(wv%v,mold=x%v) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') @@ -182,7 +181,7 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call wv1%mlt(cone,prec%dv,wv,czero,info,conjgx=trans_) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv1,& & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) diff --git a/prec/impl/psb_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index f6bc44a2b..58bd4f22f 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -147,7 +147,6 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) else allocate(ww(n_col),aux(4*n_col),stat=info) endif - if (info == psb_success_) allocate(wv%v,mold=x%v) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') @@ -182,7 +181,7 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call wv1%mlt(done,prec%dv,wv,dzero,info,conjgx=trans_) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv1,& & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) diff --git a/prec/impl/psb_s_bjacprec_impl.f90 b/prec/impl/psb_s_bjacprec_impl.f90 index becefa6c7..4f9f635e2 100644 --- a/prec/impl/psb_s_bjacprec_impl.f90 +++ b/prec/impl/psb_s_bjacprec_impl.f90 @@ -147,7 +147,6 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) else allocate(ww(n_col),aux(4*n_col),stat=info) endif - if (info == psb_success_) allocate(wv%v,mold=x%v) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') @@ -182,7 +181,7 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call wv1%mlt(sone,prec%dv,wv,szero,info,conjgx=trans_) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv1,& & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) diff --git a/prec/impl/psb_z_bjacprec_impl.f90 b/prec/impl/psb_z_bjacprec_impl.f90 index 8942e0d74..1a42d1069 100644 --- a/prec/impl/psb_z_bjacprec_impl.f90 +++ b/prec/impl/psb_z_bjacprec_impl.f90 @@ -147,7 +147,6 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) else allocate(ww(n_col),aux(4*n_col),stat=info) endif - if (info == psb_success_) allocate(wv%v,mold=x%v) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') @@ -182,7 +181,7 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call wv1%mlt(zone,prec%dv,wv,zzero,info,conjgx=trans_) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv1,& & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux)