Fix mlprec_aply

remap-coarse
sfilippone 3 months ago
parent d833362f4b
commit 62f5501761

@ -508,7 +508,6 @@ contains
& base_desc, trans,& & base_desc, trans,&
& ione,work,wv,info,init='Z') & ione,work,wv,info,init='Z')
end do end do
else else
sweeps = p%precv(level)%parms%sweeps_pre sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(cone,& call p%precv(level)%sm%apply(cone,&
@ -522,41 +521,41 @@ contains
& a_err='Error during ADD smoother_apply') & a_err='Error during ADD smoother_apply')
goto 9999 goto 9999
end if 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 (level < nlev) then
if (info /= psb_success_) then ! Apply the restriction
call psb_errpush(psb_err_internal_error_,name,& call p%precv(level+1)%map_rstr(cone,vx2l,&
& a_err='Error in recursive call') & czero,p%precv(level+1)%wrk%vx2l,&
goto 9999 & info,work=work,&
end if & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then
! call psb_errpush(psb_err_internal_error_,name,&
! Apply the prolongator & a_err='Error during restriction')
! goto 9999
call p%precv(level+1)%map_prol(cone,& end if
& p%precv(level+1)%wrk%vy2l, cone,vy2l,&
& info,work=work,& call inner_ml_aply(level+1,p,trans,work,info)
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) 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 in recursive call')
& a_err='Error during prolongation') goto 9999
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 if
end associate
end associate
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -508,7 +508,6 @@ contains
& base_desc, trans,& & base_desc, trans,&
& ione,work,wv,info,init='Z') & ione,work,wv,info,init='Z')
end do end do
else else
sweeps = p%precv(level)%parms%sweeps_pre sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
@ -522,41 +521,41 @@ contains
& a_err='Error during ADD smoother_apply') & a_err='Error during ADD smoother_apply')
goto 9999 goto 9999
end if 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 (level < nlev) then
if (info /= psb_success_) then ! Apply the restriction
call psb_errpush(psb_err_internal_error_,name,& call p%precv(level+1)%map_rstr(done,vx2l,&
& a_err='Error in recursive call') & dzero,p%precv(level+1)%wrk%vx2l,&
goto 9999 & info,work=work,&
end if & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then
! call psb_errpush(psb_err_internal_error_,name,&
! Apply the prolongator & a_err='Error during restriction')
! goto 9999
call p%precv(level+1)%map_prol(done,& end if
& p%precv(level+1)%wrk%vy2l, done,vy2l,&
& info,work=work,& call inner_ml_aply(level+1,p,trans,work,info)
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) 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 in recursive call')
& a_err='Error during prolongation') goto 9999
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 if
end associate
end associate
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -508,7 +508,6 @@ contains
& base_desc, trans,& & base_desc, trans,&
& ione,work,wv,info,init='Z') & ione,work,wv,info,init='Z')
end do end do
else else
sweeps = p%precv(level)%parms%sweeps_pre sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(sone,& call p%precv(level)%sm%apply(sone,&
@ -522,41 +521,41 @@ contains
& a_err='Error during ADD smoother_apply') & a_err='Error during ADD smoother_apply')
goto 9999 goto 9999
end if 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 (level < nlev) then
if (info /= psb_success_) then ! Apply the restriction
call psb_errpush(psb_err_internal_error_,name,& call p%precv(level+1)%map_rstr(sone,vx2l,&
& a_err='Error in recursive call') & szero,p%precv(level+1)%wrk%vx2l,&
goto 9999 & info,work=work,&
end if & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then
! call psb_errpush(psb_err_internal_error_,name,&
! Apply the prolongator & a_err='Error during restriction')
! goto 9999
call p%precv(level+1)%map_prol(sone,& end if
& p%precv(level+1)%wrk%vy2l, sone,vy2l,&
& info,work=work,& call inner_ml_aply(level+1,p,trans,work,info)
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) 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 in recursive call')
& a_err='Error during prolongation') goto 9999
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 if
end associate
end associate
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -508,7 +508,6 @@ contains
& base_desc, trans,& & base_desc, trans,&
& ione,work,wv,info,init='Z') & ione,work,wv,info,init='Z')
end do end do
else else
sweeps = p%precv(level)%parms%sweeps_pre sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(zone,& call p%precv(level)%sm%apply(zone,&
@ -522,41 +521,41 @@ contains
& a_err='Error during ADD smoother_apply') & a_err='Error during ADD smoother_apply')
goto 9999 goto 9999
end if 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 (level < nlev) then
if (info /= psb_success_) then ! Apply the restriction
call psb_errpush(psb_err_internal_error_,name,& call p%precv(level+1)%map_rstr(zone,vx2l,&
& a_err='Error in recursive call') & zzero,p%precv(level+1)%wrk%vx2l,&
goto 9999 & info,work=work,&
end if & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then
! call psb_errpush(psb_err_internal_error_,name,&
! Apply the prolongator & a_err='Error during restriction')
! goto 9999
call p%precv(level+1)%map_prol(zone,& end if
& p%precv(level+1)%wrk%vy2l, zone,vy2l,&
& info,work=work,& call inner_ml_aply(level+1,p,trans,work,info)
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) 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 in recursive call')
& a_err='Error during prolongation') goto 9999
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 if
end associate
end associate
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

Loading…
Cancel
Save