From 4ce70dde600e26e55965e8b9aa99d65b69dfba38 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 3 Sep 2013 17:20:32 +0000 Subject: [PATCH] mld2p4-299 mlprec/impl/mld_cmlprec_aply.f90 mlprec/impl/mld_dmlprec_aply.f90 mlprec/impl/mld_smlprec_aply.f90 mlprec/impl/mld_zmlprec_aply.f90 More detailed error handling inside MLPRECAPLY. --- mlprec/impl/mld_cmlprec_aply.f90 | 255 ++++++++++++++++++++++++++----- mlprec/impl/mld_dmlprec_aply.f90 | 255 ++++++++++++++++++++++++++----- mlprec/impl/mld_smlprec_aply.f90 | 255 ++++++++++++++++++++++++++----- mlprec/impl/mld_zmlprec_aply.f90 | 255 ++++++++++++++++++++++++++----- 4 files changed, 876 insertions(+), 144 deletions(-) diff --git a/mlprec/impl/mld_cmlprec_aply.f90 b/mlprec/impl/mld_cmlprec_aply.f90 index 8d9efc9d..9d4a8bce 100644 --- a/mlprec/impl/mld_cmlprec_aply.f90 +++ b/mlprec/impl/mld_cmlprec_aply.f90 @@ -488,7 +488,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) @@ -565,13 +569,22 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%x2l,cone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps @@ -579,7 +592,12 @@ contains & mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -615,8 +633,12 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! @@ -624,7 +646,12 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -687,7 +714,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) @@ -764,19 +795,35 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%x2l,cone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case default @@ -827,6 +874,11 @@ contains & mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -836,6 +888,11 @@ contains if (info == psb_success_) call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%ty,& & 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 call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -864,6 +921,11 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%tx,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 ! ! Apply the base preconditioner ! @@ -878,10 +940,10 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if - + endif case default @@ -1109,19 +1171,32 @@ contains & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - - if (info /= psb_success_) goto 9999 if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & cone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1156,35 +1231,60 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & czero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & cone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%vx2l,cone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -1219,8 +1319,12 @@ contains & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1229,14 +1333,28 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,cone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & cone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -1279,8 +1397,12 @@ contains & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1289,14 +1411,29 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,cone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & cone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1322,33 +1459,58 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & czero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & cone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%vx2l,cone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if end if case default @@ -1391,6 +1553,12 @@ contains & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -1404,9 +1572,19 @@ contains if (info == psb_success_) 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 call inner_ml_aply(level+1,p,mlprec_wrk,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 @@ -1414,19 +1592,24 @@ contains call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & cone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if - + ! ! Compute the residual ! 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 + end if ! ! Apply the base preconditioner ! @@ -1441,7 +1624,7 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index 2af6eb64..25d9fa94 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -488,7 +488,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) @@ -565,13 +569,22 @@ contains call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps @@ -579,7 +592,12 @@ contains & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -615,8 +633,12 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! @@ -624,7 +646,12 @@ contains call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -687,7 +714,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) @@ -764,19 +795,35 @@ contains call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case default @@ -827,6 +874,11 @@ contains & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -836,6 +888,11 @@ contains if (info == psb_success_) call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%ty,& & 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 call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -864,6 +921,11 @@ contains call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%tx,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 ! ! Apply the base preconditioner ! @@ -878,10 +940,10 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if - + endif case default @@ -1109,19 +1171,32 @@ contains & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - - if (info /= psb_success_) goto 9999 if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & done,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1156,35 +1231,60 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & dzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & done,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%vx2l,done,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -1219,8 +1319,12 @@ contains & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1229,14 +1333,28 @@ contains call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & done,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -1279,8 +1397,12 @@ contains & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1289,14 +1411,29 @@ contains call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & done,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1322,33 +1459,58 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & dzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & done,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%vx2l,done,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if end if case default @@ -1391,6 +1553,12 @@ contains & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -1404,9 +1572,19 @@ contains if (info == psb_success_) 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 call inner_ml_aply(level+1,p,mlprec_wrk,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 @@ -1414,19 +1592,24 @@ contains call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & done,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if - + ! ! Compute the residual ! 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 + end if ! ! Apply the base preconditioner ! @@ -1441,7 +1624,7 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if diff --git a/mlprec/impl/mld_smlprec_aply.f90 b/mlprec/impl/mld_smlprec_aply.f90 index 4351316d..1be38732 100644 --- a/mlprec/impl/mld_smlprec_aply.f90 +++ b/mlprec/impl/mld_smlprec_aply.f90 @@ -488,7 +488,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) @@ -565,13 +569,22 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%x2l,sone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps @@ -579,7 +592,12 @@ contains & mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -615,8 +633,12 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! @@ -624,7 +646,12 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -687,7 +714,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) @@ -764,19 +795,35 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%x2l,sone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case default @@ -827,6 +874,11 @@ contains & mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -836,6 +888,11 @@ contains if (info == psb_success_) call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%ty,& & 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 call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -864,6 +921,11 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%tx,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 ! ! Apply the base preconditioner ! @@ -878,10 +940,10 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if - + endif case default @@ -1109,19 +1171,32 @@ contains & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - - if (info /= psb_success_) goto 9999 if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & sone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1156,35 +1231,60 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & szero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & sone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%vx2l,sone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -1219,8 +1319,12 @@ contains & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1229,14 +1333,28 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,sone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & sone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -1279,8 +1397,12 @@ contains & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1289,14 +1411,29 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,sone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & sone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1322,33 +1459,58 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & szero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & sone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%vx2l,sone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if end if case default @@ -1391,6 +1553,12 @@ contains & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -1404,9 +1572,19 @@ contains if (info == psb_success_) 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 call inner_ml_aply(level+1,p,mlprec_wrk,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 @@ -1414,19 +1592,24 @@ contains call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & sone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if - + ! ! Compute the residual ! 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 + end if ! ! Apply the base preconditioner ! @@ -1441,7 +1624,7 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if diff --git a/mlprec/impl/mld_zmlprec_aply.f90 b/mlprec/impl/mld_zmlprec_aply.f90 index a674656d..1930e8e1 100644 --- a/mlprec/impl/mld_zmlprec_aply.f90 +++ b/mlprec/impl/mld_zmlprec_aply.f90 @@ -488,7 +488,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) @@ -565,13 +569,22 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%x2l,zone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps @@ -579,7 +592,12 @@ contains & mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -615,8 +633,12 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! @@ -624,7 +646,12 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -687,7 +714,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) @@ -764,19 +795,35 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%x2l,zone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case default @@ -827,6 +874,11 @@ contains & mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -836,6 +888,11 @@ contains if (info == psb_success_) call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%ty,& & 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 call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -864,6 +921,11 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%tx,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 ! ! Apply the base preconditioner ! @@ -878,10 +940,10 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if - + endif case default @@ -1109,19 +1171,32 @@ contains & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - - if (info /= psb_success_) goto 9999 if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1156,35 +1231,60 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & zone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%vx2l,zone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -1219,8 +1319,12 @@ contains & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1229,14 +1333,28 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,zone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -1279,8 +1397,12 @@ contains & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1289,14 +1411,29 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,zone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1322,33 +1459,58 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + 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 psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & zone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%vx2l,zone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if end if case default @@ -1391,6 +1553,12 @@ contains & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -1404,9 +1572,19 @@ contains if (info == psb_success_) 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 call inner_ml_aply(level+1,p,mlprec_wrk,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 @@ -1414,19 +1592,24 @@ contains call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if - + ! ! Compute the residual ! 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 + end if ! ! Apply the base preconditioner ! @@ -1441,7 +1624,7 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if