From 62f5501761b24ac40683d18aecf3ca0e80199a30 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Mon, 20 Apr 2026 11:28:06 +0200 Subject: [PATCH] Fix mlprec_aply --- amgprec/impl/amg_cmlprec_aply.f90 | 67 +++++++++++++++---------------- amgprec/impl/amg_dmlprec_aply.f90 | 67 +++++++++++++++---------------- amgprec/impl/amg_smlprec_aply.f90 | 67 +++++++++++++++---------------- amgprec/impl/amg_zmlprec_aply.f90 | 67 +++++++++++++++---------------- 4 files changed, 132 insertions(+), 136 deletions(-) diff --git a/amgprec/impl/amg_cmlprec_aply.f90 b/amgprec/impl/amg_cmlprec_aply.f90 index e13dfbe0..44862063 100644 --- a/amgprec/impl/amg_cmlprec_aply.f90 +++ b/amgprec/impl/amg_cmlprec_aply.f90 @@ -508,7 +508,6 @@ contains & base_desc, trans,& & ione,work,wv,info,init='Z') end do - else sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(cone,& @@ -522,41 +521,41 @@ contains & a_err='Error during ADD smoother_apply') goto 9999 end if - end if - - if (level < nlev) then - ! Apply the restriction - call p%precv(level+1)%map_rstr(cone,vx2l,& - & czero,p%precv(level+1)%wrk%vx2l,& - & info,work=work,& - & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') - goto 9999 - end if - call inner_ml_aply(level+1,p,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if - - ! - ! Apply the prolongator - ! - call p%precv(level+1)%map_prol(cone,& - & p%precv(level+1)%wrk%vy2l, cone,vy2l,& - & info,work=work,& - & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 + if (level < nlev) then + ! Apply the restriction + call p%precv(level+1)%map_rstr(cone,vx2l,& + & czero,p%precv(level+1)%wrk%vx2l,& + & info,work=work,& + & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during restriction') + goto 9999 + end if + + call inner_ml_aply(level+1,p,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + + ! + ! Apply the prolongator + ! + call p%precv(level+1)%map_prol(cone,& + & p%precv(level+1)%wrk%vy2l, cone,vy2l,& + & info,work=work,& + & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if - - end associate + end associate call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/amg_dmlprec_aply.f90 b/amgprec/impl/amg_dmlprec_aply.f90 index 2efc300f..a1a904de 100644 --- a/amgprec/impl/amg_dmlprec_aply.f90 +++ b/amgprec/impl/amg_dmlprec_aply.f90 @@ -508,7 +508,6 @@ contains & base_desc, trans,& & ione,work,wv,info,init='Z') end do - else sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(done,& @@ -522,41 +521,41 @@ contains & a_err='Error during ADD smoother_apply') goto 9999 end if - end if - - if (level < nlev) then - ! Apply the restriction - call p%precv(level+1)%map_rstr(done,vx2l,& - & dzero,p%precv(level+1)%wrk%vx2l,& - & info,work=work,& - & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') - goto 9999 - end if - call inner_ml_aply(level+1,p,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if - - ! - ! Apply the prolongator - ! - call p%precv(level+1)%map_prol(done,& - & p%precv(level+1)%wrk%vy2l, done,vy2l,& - & info,work=work,& - & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 + if (level < nlev) then + ! Apply the restriction + call p%precv(level+1)%map_rstr(done,vx2l,& + & dzero,p%precv(level+1)%wrk%vx2l,& + & info,work=work,& + & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during restriction') + goto 9999 + end if + + call inner_ml_aply(level+1,p,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + + ! + ! Apply the prolongator + ! + call p%precv(level+1)%map_prol(done,& + & p%precv(level+1)%wrk%vy2l, done,vy2l,& + & info,work=work,& + & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if - - end associate + end associate call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/amg_smlprec_aply.f90 b/amgprec/impl/amg_smlprec_aply.f90 index a12d3e43..ee4df8e0 100644 --- a/amgprec/impl/amg_smlprec_aply.f90 +++ b/amgprec/impl/amg_smlprec_aply.f90 @@ -508,7 +508,6 @@ contains & base_desc, trans,& & ione,work,wv,info,init='Z') end do - else sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(sone,& @@ -522,41 +521,41 @@ contains & a_err='Error during ADD smoother_apply') goto 9999 end if - end if - - if (level < nlev) then - ! Apply the restriction - call p%precv(level+1)%map_rstr(sone,vx2l,& - & szero,p%precv(level+1)%wrk%vx2l,& - & info,work=work,& - & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') - goto 9999 - end if - call inner_ml_aply(level+1,p,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if - - ! - ! Apply the prolongator - ! - call p%precv(level+1)%map_prol(sone,& - & p%precv(level+1)%wrk%vy2l, sone,vy2l,& - & info,work=work,& - & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 + if (level < nlev) then + ! Apply the restriction + call p%precv(level+1)%map_rstr(sone,vx2l,& + & szero,p%precv(level+1)%wrk%vx2l,& + & info,work=work,& + & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during restriction') + goto 9999 + end if + + call inner_ml_aply(level+1,p,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + + ! + ! Apply the prolongator + ! + call p%precv(level+1)%map_prol(sone,& + & p%precv(level+1)%wrk%vy2l, sone,vy2l,& + & info,work=work,& + & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if - - end associate + end associate call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/amg_zmlprec_aply.f90 b/amgprec/impl/amg_zmlprec_aply.f90 index 806d1f3f..53422171 100644 --- a/amgprec/impl/amg_zmlprec_aply.f90 +++ b/amgprec/impl/amg_zmlprec_aply.f90 @@ -508,7 +508,6 @@ contains & base_desc, trans,& & ione,work,wv,info,init='Z') end do - else sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(zone,& @@ -522,41 +521,41 @@ contains & a_err='Error during ADD smoother_apply') goto 9999 end if - end if - - if (level < nlev) then - ! Apply the restriction - call p%precv(level+1)%map_rstr(zone,vx2l,& - & zzero,p%precv(level+1)%wrk%vx2l,& - & info,work=work,& - & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') - goto 9999 - end if - call inner_ml_aply(level+1,p,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if - - ! - ! Apply the prolongator - ! - call p%precv(level+1)%map_prol(zone,& - & p%precv(level+1)%wrk%vy2l, zone,vy2l,& - & info,work=work,& - & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 + if (level < nlev) then + ! Apply the restriction + call p%precv(level+1)%map_rstr(zone,vx2l,& + & zzero,p%precv(level+1)%wrk%vx2l,& + & info,work=work,& + & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during restriction') + goto 9999 + end if + + call inner_ml_aply(level+1,p,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + + ! + ! Apply the prolongator + ! + call p%precv(level+1)%map_prol(zone,& + & p%precv(level+1)%wrk%vy2l, zone,vy2l,& + & info,work=work,& + & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if - - end associate + end associate call psb_erractionrestore(err_act) return