|
|
@ -676,8 +676,6 @@ contains
|
|
|
|
logical :: pre, post
|
|
|
|
logical :: pre, post
|
|
|
|
character(len=20) :: name
|
|
|
|
character(len=20) :: name
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
name = 'inner_inner_mult'
|
|
|
|
name = 'inner_inner_mult'
|
|
|
|
info = psb_success_
|
|
|
|
info = psb_success_
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
@ -795,36 +793,38 @@ contains
|
|
|
|
goto 9999
|
|
|
|
goto 9999
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (post) then
|
|
|
|
|
|
|
|
if (.not.pre) then
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! Compute the residual
|
|
|
|
! If we have only post, we need to compute the residual here.
|
|
|
|
!
|
|
|
|
!
|
|
|
|
if (post) then
|
|
|
|
|
|
|
|
call psb_geaxpby(cone,mlprec_wrk(level)%vx2l,&
|
|
|
|
call psb_geaxpby(cone,mlprec_wrk(level)%vx2l,&
|
|
|
|
& czero,mlprec_wrk(level)%vtx,&
|
|
|
|
& czero,mlprec_wrk(level)%vty,&
|
|
|
|
& p%precv(level)%base_desc,info)
|
|
|
|
& p%precv(level)%base_desc,info)
|
|
|
|
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
|
|
|
|
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
|
|
|
|
& cone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,&
|
|
|
|
& cone,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,&
|
|
|
|
& work=work,trans=trans)
|
|
|
|
& work=work,trans=trans)
|
|
|
|
if (info /= psb_success_) then
|
|
|
|
if (info /= psb_success_) then
|
|
|
|
call psb_errpush(psb_err_internal_error_,name,&
|
|
|
|
call psb_errpush(psb_err_internal_error_,name,&
|
|
|
|
& a_err='Error during residue')
|
|
|
|
& a_err='Error during residue')
|
|
|
|
goto 9999
|
|
|
|
goto 9999
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
end if
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! Apply the second smoother
|
|
|
|
! Apply the second smoother
|
|
|
|
!
|
|
|
|
!
|
|
|
|
if (trans == 'N') then
|
|
|
|
if (trans == 'N') then
|
|
|
|
sweeps = p%precv(level)%parms%sweeps_post
|
|
|
|
sweeps = p%precv(level)%parms%sweeps_post
|
|
|
|
if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
|
|
|
|
if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
|
|
|
|
& mlprec_wrk(level)%vtx,cone,mlprec_wrk(level)%vy2l,&
|
|
|
|
& mlprec_wrk(level)%vty,cone,mlprec_wrk(level)%vy2l,&
|
|
|
|
& p%precv(level)%base_desc, trans,&
|
|
|
|
& p%precv(level)%base_desc, trans,&
|
|
|
|
& sweeps,work,info,init='Z')
|
|
|
|
& sweeps,work,info,init='Y')
|
|
|
|
else
|
|
|
|
else
|
|
|
|
sweeps = p%precv(level)%parms%sweeps_pre
|
|
|
|
sweeps = p%precv(level)%parms%sweeps_pre
|
|
|
|
if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
|
|
|
|
if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
|
|
|
|
& mlprec_wrk(level)%vtx,cone,mlprec_wrk(level)%vy2l,&
|
|
|
|
& mlprec_wrk(level)%vty,cone,mlprec_wrk(level)%vy2l,&
|
|
|
|
& p%precv(level)%base_desc, trans,&
|
|
|
|
& p%precv(level)%base_desc, trans,&
|
|
|
|
& sweeps,work,info,init='Z')
|
|
|
|
& sweeps,work,info,init='Y')
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
if (info /= psb_success_) then
|
|
|
|
if (info /= psb_success_) then
|
|
|
|