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

mld2p4:

Browse Source 
mlprec/impl/mld_cmlprec_aply.f90
 mlprec/impl/mld_dmlprec_aply.f90
 mlprec/impl/mld_smlprec_aply.f90
 mlprec/impl/mld_zmlprec_aply.f90

Adjust PRE/POST application and formulation of smoothers.
stopcriterion
Salvatore Filippone 9 years ago
parent 460ae04c5f
commit 0a6b51095a
4 changed files with 76 additions and 76 deletions
Show Stats Download Patch File Download Diff File

38
mlprec/impl/mld_cmlprec_aply.f90
Unescape Escape View File

@ -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,20 +793,22 @@ contains
goto 9999 goto 9999
end if end if
!
! Compute the residual
!
if (post) then if (post) then
call psb_geaxpby(cone,mlprec_wrk(level)%vx2l,& if (.not.pre) then
& czero,mlprec_wrk(level)%vtx,& !
& p%precv(level)%base_desc,info) ! If we have only post, we need to compute the residual here.
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& !
& cone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& call psb_geaxpby(cone,mlprec_wrk(level)%vx2l,&
& work=work,trans=trans) & czero,mlprec_wrk(level)%vty,&
if (info /= psb_success_) then & p%precv(level)%base_desc,info)
call psb_errpush(psb_err_internal_error_,name,& call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& a_err='Error during residue') & cone,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,&
goto 9999 & work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
end if end if
! !
! Apply the second smoother ! Apply the second smoother
@ -816,15 +816,15 @@ contains
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

38
mlprec/impl/mld_dmlprec_aply.f90
Unescape Escape View File

@ -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,20 +793,22 @@ contains
goto 9999 goto 9999
end if end if
!
! Compute the residual
!
if (post) then if (post) then
call psb_geaxpby(done,mlprec_wrk(level)%vx2l,& if (.not.pre) then
& dzero,mlprec_wrk(level)%vtx,& !
& p%precv(level)%base_desc,info) ! If we have only post, we need to compute the residual here.
call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& !
& done,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& call psb_geaxpby(done,mlprec_wrk(level)%vx2l,&
& work=work,trans=trans) & dzero,mlprec_wrk(level)%vty,&
if (info /= psb_success_) then & p%precv(level)%base_desc,info)
call psb_errpush(psb_err_internal_error_,name,& call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& a_err='Error during residue') & done,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,&
goto 9999 & work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
end if end if
! !
! Apply the second smoother ! Apply the second smoother
@ -816,15 +816,15 @@ contains
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(done,& if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
& mlprec_wrk(level)%vtx,done,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vty,done,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(done,& if (info == psb_success_) call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%vtx,done,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vty,done,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

38
mlprec/impl/mld_smlprec_aply.f90
Unescape Escape View File

@ -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,20 +793,22 @@ contains
goto 9999 goto 9999
end if end if
!
! Compute the residual
!
if (post) then if (post) then
call psb_geaxpby(sone,mlprec_wrk(level)%vx2l,& if (.not.pre) then
& szero,mlprec_wrk(level)%vtx,& !
& p%precv(level)%base_desc,info) ! If we have only post, we need to compute the residual here.
call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& !
& sone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& call psb_geaxpby(sone,mlprec_wrk(level)%vx2l,&
& work=work,trans=trans) & szero,mlprec_wrk(level)%vty,&
if (info /= psb_success_) then & p%precv(level)%base_desc,info)
call psb_errpush(psb_err_internal_error_,name,& call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& a_err='Error during residue') & sone,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,&
goto 9999 & work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
end if end if
! !
! Apply the second smoother ! Apply the second smoother
@ -816,15 +816,15 @@ contains
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(sone,& if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
& mlprec_wrk(level)%vtx,sone,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vty,sone,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(sone,& if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%vtx,sone,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vty,sone,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

38
mlprec/impl/mld_zmlprec_aply.f90
Unescape Escape View File

@ -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,20 +793,22 @@ contains
goto 9999 goto 9999
end if end if
!
! Compute the residual
!
if (post) then if (post) then
call psb_geaxpby(zone,mlprec_wrk(level)%vx2l,& if (.not.pre) then
& zzero,mlprec_wrk(level)%vtx,& !
& p%precv(level)%base_desc,info) ! If we have only post, we need to compute the residual here.
call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& !
& zone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& call psb_geaxpby(zone,mlprec_wrk(level)%vx2l,&
& work=work,trans=trans) & zzero,mlprec_wrk(level)%vty,&
if (info /= psb_success_) then & p%precv(level)%base_desc,info)
call psb_errpush(psb_err_internal_error_,name,& call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& a_err='Error during residue') & zone,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,&
goto 9999 & work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
end if end if
! !
! Apply the second smoother ! Apply the second smoother
@ -816,15 +816,15 @@ contains
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(zone,& if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
& mlprec_wrk(level)%vtx,zone,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vty,zone,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(zone,& if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
& mlprec_wrk(level)%vtx,zone,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vty,zone,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

Write Preview
Loading…
Cancel
Save