|
|
@ -63,7 +63,6 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
|
|
|
integer(psb_ipk_) :: np, me, i, err_act
|
|
|
|
integer(psb_ipk_) :: np, me, i, err_act
|
|
|
|
character :: trans_, init_
|
|
|
|
character :: trans_, init_
|
|
|
|
real(psb_dpk_) :: res, resdenum
|
|
|
|
real(psb_dpk_) :: res, resdenum
|
|
|
|
real(psb_dpk_) :: cz, cr
|
|
|
|
|
|
|
|
character(len=20) :: name='d_poly_smoother_apply_v'
|
|
|
|
character(len=20) :: name='d_poly_smoother_apply_v'
|
|
|
|
|
|
|
|
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
@ -131,6 +130,8 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
|
|
|
|
|
|
|
|
|
|
|
select case(sm%variant)
|
|
|
|
select case(sm%variant)
|
|
|
|
case(amg_poly_lottes_)
|
|
|
|
case(amg_poly_lottes_)
|
|
|
|
|
|
|
|
block
|
|
|
|
|
|
|
|
real(psb_dpk_) :: cz, cr
|
|
|
|
! b == x
|
|
|
|
! b == x
|
|
|
|
! x == tx
|
|
|
|
! x == tx
|
|
|
|
!
|
|
|
|
!
|
|
|
@ -153,9 +154,12 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
|
|
|
!!$ write(0,*) 'Polynomial smoother ',i,res
|
|
|
|
!!$ write(0,*) 'Polynomial smoother ',i,res
|
|
|
|
! x_k = x_{k-1} + z_k
|
|
|
|
! x_k = x_{k-1} + z_k
|
|
|
|
end do
|
|
|
|
end do
|
|
|
|
|
|
|
|
end block
|
|
|
|
|
|
|
|
|
|
|
|
case(amg_poly_lottes_beta_)
|
|
|
|
case(amg_poly_lottes_beta_)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
block
|
|
|
|
|
|
|
|
real(psb_dpk_) :: cz, cr
|
|
|
|
! b == x
|
|
|
|
! b == x
|
|
|
|
! x == tx
|
|
|
|
! x == tx
|
|
|
|
!
|
|
|
|
!
|
|
|
@ -178,6 +182,39 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
|
|
|
!!$ write(0,*) 'Polynomial smoother ',i,res
|
|
|
|
!!$ write(0,*) 'Polynomial smoother ',i,res
|
|
|
|
! x_k = x_{k-1} + z_k
|
|
|
|
! x_k = x_{k-1} + z_k
|
|
|
|
end do
|
|
|
|
end do
|
|
|
|
|
|
|
|
end block
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
case(amg_poly_new_)
|
|
|
|
|
|
|
|
block
|
|
|
|
|
|
|
|
real(psb_dpk_) :: sigma, theta, delta, rho_old, rho
|
|
|
|
|
|
|
|
! b == x
|
|
|
|
|
|
|
|
! x == tx
|
|
|
|
|
|
|
|
!
|
|
|
|
|
|
|
|
theta = (done+sm%cf_a)/2
|
|
|
|
|
|
|
|
delta = (done-sm%cf_a)/2
|
|
|
|
|
|
|
|
sigma = theta/delta
|
|
|
|
|
|
|
|
rho_old = done/sigma
|
|
|
|
|
|
|
|
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
|
|
|
|
|
|
|
|
call psb_geaxpby((done/sm%rho_ba),ty,dzero,r,desc_data,info)
|
|
|
|
|
|
|
|
call psb_geaxpby((done/theta),r,dzero,tz,desc_data,info)
|
|
|
|
|
|
|
|
! tz == d
|
|
|
|
|
|
|
|
do i=1, sm%pdegree
|
|
|
|
|
|
|
|
! x_{k+1} = x_k + d_k
|
|
|
|
|
|
|
|
call psb_geaxpby(done,tz,done,tx,desc_data,info)
|
|
|
|
|
|
|
|
!
|
|
|
|
|
|
|
|
! r_{k-1} = r_k - (1/rho(BA)) B A d_k
|
|
|
|
|
|
|
|
call psb_spmm(done,sm%pa,tz,dzero,ty,desc_data,info,work=aux,trans=trans_)
|
|
|
|
|
|
|
|
call sm%sv%apply(-done,ty,done,r,desc_data,trans_,aux,wv(5:),info,init='Z')
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
|
|
|
! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1}
|
|
|
|
|
|
|
|
rho = done/(2*sigma - rho_old)
|
|
|
|
|
|
|
|
call psb_geaxpby((2*rho/delta),r,(rho*rho_old),tz,desc_data,info)
|
|
|
|
|
|
|
|
!!$ res = psb_genrm2(r,desc_data,info)
|
|
|
|
|
|
|
|
!!$ write(0,*) 'Polynomial smoother ',i,res
|
|
|
|
|
|
|
|
! x_k = x_{k-1} + z_k
|
|
|
|
|
|
|
|
end do
|
|
|
|
|
|
|
|
end block
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
case default
|
|
|
|
case default
|
|
|
|