From 0a6b51095a5874375f8ae0b4c01ec8b2618ad82e Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 24 Jun 2016 16:48:42 +0000 Subject: [PATCH] mld2p4: 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. --- mlprec/impl/mld_cmlprec_aply.f90 | 38 ++++++++++++++++---------------- mlprec/impl/mld_dmlprec_aply.f90 | 38 ++++++++++++++++---------------- mlprec/impl/mld_smlprec_aply.f90 | 38 ++++++++++++++++---------------- mlprec/impl/mld_zmlprec_aply.f90 | 38 ++++++++++++++++---------------- 4 files changed, 76 insertions(+), 76 deletions(-) diff --git a/mlprec/impl/mld_cmlprec_aply.f90 b/mlprec/impl/mld_cmlprec_aply.f90 index 672ab7d1..618026e3 100644 --- a/mlprec/impl/mld_cmlprec_aply.f90 +++ b/mlprec/impl/mld_cmlprec_aply.f90 @@ -676,8 +676,6 @@ contains logical :: pre, post character(len=20) :: name - - name = 'inner_inner_mult' info = psb_success_ call psb_erractionsave(err_act) @@ -795,20 +793,22 @@ contains goto 9999 end if - ! - ! Compute the residual - ! if (post) then - call psb_geaxpby(cone,mlprec_wrk(level)%vx2l,& - & czero,mlprec_wrk(level)%vtx,& - & p%precv(level)%base_desc,info) - call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& - & cone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& - & work=work,trans=trans) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during residue') - goto 9999 + if (.not.pre) then + ! + ! If we have only post, we need to compute the residual here. + ! + call psb_geaxpby(cone,mlprec_wrk(level)%vx2l,& + & czero,mlprec_wrk(level)%vty,& + & p%precv(level)%base_desc,info) + call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& + & cone,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,& + & 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 ! ! Apply the second smoother @@ -816,15 +816,15 @@ contains if (trans == 'N') then sweeps = p%precv(level)%parms%sweeps_post 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,& - & sweeps,work,info,init='Z') + & sweeps,work,info,init='Y') else sweeps = p%precv(level)%parms%sweeps_pre 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,& - & sweeps,work,info,init='Z') + & sweeps,work,info,init='Y') end if if (info /= psb_success_) then diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index 83e382ce..a189d74a 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -676,8 +676,6 @@ contains logical :: pre, post character(len=20) :: name - - name = 'inner_inner_mult' info = psb_success_ call psb_erractionsave(err_act) @@ -795,20 +793,22 @@ contains goto 9999 end if - ! - ! Compute the residual - ! if (post) then - call psb_geaxpby(done,mlprec_wrk(level)%vx2l,& - & dzero,mlprec_wrk(level)%vtx,& - & p%precv(level)%base_desc,info) - call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& - & done,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& - & work=work,trans=trans) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during residue') - goto 9999 + if (.not.pre) then + ! + ! If we have only post, we need to compute the residual here. + ! + call psb_geaxpby(done,mlprec_wrk(level)%vx2l,& + & dzero,mlprec_wrk(level)%vty,& + & p%precv(level)%base_desc,info) + call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& + & done,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,& + & 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 ! ! Apply the second smoother @@ -816,15 +816,15 @@ contains if (trans == 'N') then sweeps = p%precv(level)%parms%sweeps_post 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,& - & sweeps,work,info,init='Z') + & sweeps,work,info,init='Y') else sweeps = p%precv(level)%parms%sweeps_pre 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,& - & sweeps,work,info,init='Z') + & sweeps,work,info,init='Y') end if if (info /= psb_success_) then diff --git a/mlprec/impl/mld_smlprec_aply.f90 b/mlprec/impl/mld_smlprec_aply.f90 index 8a5f2e72..43ebaf34 100644 --- a/mlprec/impl/mld_smlprec_aply.f90 +++ b/mlprec/impl/mld_smlprec_aply.f90 @@ -676,8 +676,6 @@ contains logical :: pre, post character(len=20) :: name - - name = 'inner_inner_mult' info = psb_success_ call psb_erractionsave(err_act) @@ -795,20 +793,22 @@ contains goto 9999 end if - ! - ! Compute the residual - ! if (post) then - call psb_geaxpby(sone,mlprec_wrk(level)%vx2l,& - & szero,mlprec_wrk(level)%vtx,& - & p%precv(level)%base_desc,info) - call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& - & sone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& - & work=work,trans=trans) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during residue') - goto 9999 + if (.not.pre) then + ! + ! If we have only post, we need to compute the residual here. + ! + call psb_geaxpby(sone,mlprec_wrk(level)%vx2l,& + & szero,mlprec_wrk(level)%vty,& + & p%precv(level)%base_desc,info) + call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& + & sone,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,& + & 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 ! ! Apply the second smoother @@ -816,15 +816,15 @@ contains if (trans == 'N') then sweeps = p%precv(level)%parms%sweeps_post 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,& - & sweeps,work,info,init='Z') + & sweeps,work,info,init='Y') else sweeps = p%precv(level)%parms%sweeps_pre 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,& - & sweeps,work,info,init='Z') + & sweeps,work,info,init='Y') end if if (info /= psb_success_) then diff --git a/mlprec/impl/mld_zmlprec_aply.f90 b/mlprec/impl/mld_zmlprec_aply.f90 index 68c0a845..e5832b8e 100644 --- a/mlprec/impl/mld_zmlprec_aply.f90 +++ b/mlprec/impl/mld_zmlprec_aply.f90 @@ -676,8 +676,6 @@ contains logical :: pre, post character(len=20) :: name - - name = 'inner_inner_mult' info = psb_success_ call psb_erractionsave(err_act) @@ -795,20 +793,22 @@ contains goto 9999 end if - ! - ! Compute the residual - ! if (post) then - call psb_geaxpby(zone,mlprec_wrk(level)%vx2l,& - & zzero,mlprec_wrk(level)%vtx,& - & p%precv(level)%base_desc,info) - call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& - & zone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& - & work=work,trans=trans) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during residue') - goto 9999 + if (.not.pre) then + ! + ! If we have only post, we need to compute the residual here. + ! + call psb_geaxpby(zone,mlprec_wrk(level)%vx2l,& + & zzero,mlprec_wrk(level)%vty,& + & p%precv(level)%base_desc,info) + call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& + & zone,mlprec_wrk(level)%vty,p%precv(level)%base_desc,info,& + & 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 ! ! Apply the second smoother @@ -816,15 +816,15 @@ contains if (trans == 'N') then sweeps = p%precv(level)%parms%sweeps_post 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,& - & sweeps,work,info,init='Z') + & sweeps,work,info,init='Y') else sweeps = p%precv(level)%parms%sweeps_pre 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,& - & sweeps,work,info,init='Z') + & sweeps,work,info,init='Y') end if if (info /= psb_success_) then