fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas-3.0-maint:

Browse Source 
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.
psblas-3.0-maint
Salvatore Filippone 14 years ago
parent c0d6b28e2c
commit c3587eed3f
9 changed files with 25 additions and 29 deletions
Show Stats Download Patch File Download Diff File

8
base/modules/psb_indx_map_mod.f90
Unescape Escape View File

@ -668,7 +668,7 @@ contains
integer(psb_ipk_), intent(inout) :: idx integer(psb_ipk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask logical, intent(in), optional :: mask
integer, intent(in), optional :: lidx integer(psb_ipk_), intent(in), optional :: lidx
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='base_g2l_ins' character(len=20) :: name='base_g2l_ins'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -695,7 +695,7 @@ contains
integer(psb_ipk_), intent(out) :: idxout integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask logical, intent(in), optional :: mask
integer, intent(in), optional :: lidx integer(psb_ipk_), intent(in), optional :: lidx
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='base_g2l_ins' character(len=20) :: name='base_g2l_ins'
@ -723,7 +723,7 @@ contains
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:) logical, intent(in), optional :: mask(:)
integer, intent(in), optional :: lidx(:) integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='base_g2l_ins' character(len=20) :: name='base_g2l_ins'
@ -751,7 +751,7 @@ contains
integer(psb_ipk_), intent(out) :: idxout(:) integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:) logical, intent(in), optional :: mask(:)
integer, intent(in), optional :: lidx(:) integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='base_g2l_ins' character(len=20) :: name='base_g2l_ins'

8
krylov/psb_crgmres.f90
Unescape Escape View File

@ -506,7 +506,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
character(len=*), parameter :: methdname='RGMRES' character(len=*), parameter :: methdname='RGMRES'
info = psb_success_ info = psb_success_
name = 'psb_sgmres' name = 'psb_cgmres'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() 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) scal=cone/h(i+1,i)
call psb_geaxpby(scal,w,czero,v(i+1),desc_a,info) call psb_geaxpby(scal,w,czero,v(i+1),desc_a,info)
do k=2,i 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 enddo
@ -725,9 +725,9 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
rti1 = h(i+1,i) rti1 = h(i+1,i)
call crotg(rti,rti1,tmp,s(i)) call crotg(rti,rti1,tmp,s(i))
c(i) = cmplx(tmp,szero) 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 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 if (istop_ == 1) then
! !

10
krylov/psb_drgmres.f90
Unescape Escape View File

@ -506,7 +506,7 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,&
character(len=*), parameter :: methdname='RGMRES' character(len=*), parameter :: methdname='RGMRES'
info = psb_success_ info = psb_success_
name = 'psb_sgmres' name = 'psb_dgmres'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() 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) scal=done/h(i+1,i)
call psb_geaxpby(scal,w,dzero,v(i+1),desc_a,info) call psb_geaxpby(scal,w,dzero,v(i+1),desc_a,info)
do k=2,i 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 enddo
rti = h(i,i) rti = h(i,i)
rti1 = h(i+1,i) rti1 = h(i+1,i)
call drotg(rti,rti1,tmp,s(i)) call drotg(rti,rti1,tmp,s(i))
c(i) = cmplx(tmp,szero) c(i) = cmplx(tmp,dzero)
call drot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i)) 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 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 if (istop_ == 1) then
! !

6
krylov/psb_srgmres.f90
Unescape Escape View File

@ -717,7 +717,7 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,&
scal=sone/h(i+1,i) scal=sone/h(i+1,i)
call psb_geaxpby(scal,w,szero,v(i+1),desc_a,info) call psb_geaxpby(scal,w,szero,v(i+1),desc_a,info)
do k=2,i 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 enddo
@ -725,9 +725,9 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,&
rti1 = h(i+1,i) rti1 = h(i+1,i)
call srotg(rti,rti1,tmp,s(i)) call srotg(rti,rti1,tmp,s(i))
c(i) = cmplx(tmp,szero) 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 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 if (istop_ == 1) then
! !

10
krylov/psb_zrgmres.f90
Unescape Escape View File

@ -506,7 +506,7 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,&
character(len=*), parameter :: methdname='RGMRES' character(len=*), parameter :: methdname='RGMRES'
info = psb_success_ info = psb_success_
name = 'psb_sgmres' name = 'psb_zgmres'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() 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) scal=zone/h(i+1,i)
call psb_geaxpby(scal,w,zzero,v(i+1),desc_a,info) call psb_geaxpby(scal,w,zzero,v(i+1),desc_a,info)
do k=2,i 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 enddo
rti = h(i,i) rti = h(i,i)
rti1 = h(i+1,i) rti1 = h(i+1,i)
call zrotg(rti,rti1,tmp,s(i)) call zrotg(rti,rti1,tmp,s(i))
c(i) = cmplx(tmp,szero) c(i) = cmplx(tmp,dzero)
call zrot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i)) 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 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 if (istop_ == 1) then
! !

3
prec/impl/psb_c_bjacprec_impl.f90
Unescape Escape View File

@ -147,7 +147,6 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
else else
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
endif endif
if (info == psb_success_) allocate(wv%v,mold=x%v)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') 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_) 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,& & beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)

3
prec/impl/psb_d_bjacprec_impl.f90
Unescape Escape View File

@ -147,7 +147,6 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
else else
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
endif endif
if (info == psb_success_) allocate(wv%v,mold=x%v)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') 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_) 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,& & beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)

3
prec/impl/psb_s_bjacprec_impl.f90
Unescape Escape View File

@ -147,7 +147,6 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
else else
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
endif endif
if (info == psb_success_) allocate(wv%v,mold=x%v)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') 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_) 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,& & beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)

3
prec/impl/psb_z_bjacprec_impl.f90
Unescape Escape View File

@ -147,7 +147,6 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
else else
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
endif endif
if (info == psb_success_) allocate(wv%v,mold=x%v)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') 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_) 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,& & beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)

Write Preview
Loading…
Cancel
Save