Improved error handling in _bld

development
sfilippone 3 months ago
parent 087dc37868
commit 04d7122380

@ -94,7 +94,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
type(amg_c_onelev_type), allocatable :: tprecv(:) type(amg_c_onelev_type), allocatable :: tprecv(:)
logical :: cpymat_ logical :: cpymat_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
character(len=40) :: ch_err
integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1 integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1
logical, parameter :: do_timings=.false. logical, parameter :: do_timings=.false.
@ -334,8 +335,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,prec%ag_data,info) & ilaggr,nlaggr,op_prol,prec%ag_data,info)
if (do_timings) call psb_toc(idx_bldtp) if (do_timings) call psb_toc(idx_bldtp)
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Map build') & a_err=ch_err)
goto 9999 goto 9999
endif endif
@ -406,7 +408,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
& coarse_sm,coarse_sm2,info) & coarse_sm,coarse_sm2,info)
if (newsz < i) then if (newsz < i) then
! !
! We are going back and revisit a previous leve; ! We are going back and revisit a previous level;
! recover the aggregation. ! recover the aggregation.
! !
ilaggr = prec%precv(newsz)%linmap%iaggr ilaggr = prec%precv(newsz)%linmap%iaggr
@ -419,8 +421,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (do_timings) call psb_toc(idx_matasb) if (do_timings) call psb_toc(idx_matasb)
if (info /= 0) then if (info /= 0) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Mat asb') & a_err=ch_err)
goto 9999 goto 9999
endif endif
exit array_build_loop exit array_build_loop
@ -432,8 +435,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
if (do_timings) call psb_toc(idx_matasb) if (do_timings) call psb_toc(idx_matasb)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Map build') & a_err=ch_err)
goto 9999 goto 9999
endif endif
if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info) if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)

@ -101,7 +101,8 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
character(len=40) :: ch_err
info=psb_success_ info=psb_success_
err=0 err=0
@ -296,7 +297,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i) call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Error @ level',i write(ch_err,'(a,i7)') 'Error @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err=ch_err) & a_err=ch_err)
goto 9999 goto 9999

@ -94,7 +94,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
type(amg_d_onelev_type), allocatable :: tprecv(:) type(amg_d_onelev_type), allocatable :: tprecv(:)
logical :: cpymat_ logical :: cpymat_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
character(len=40) :: ch_err
integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1 integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1
logical, parameter :: do_timings=.false. logical, parameter :: do_timings=.false.
@ -334,8 +335,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,prec%ag_data,info) & ilaggr,nlaggr,op_prol,prec%ag_data,info)
if (do_timings) call psb_toc(idx_bldtp) if (do_timings) call psb_toc(idx_bldtp)
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Map build') & a_err=ch_err)
goto 9999 goto 9999
endif endif
@ -406,7 +408,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
& coarse_sm,coarse_sm2,info) & coarse_sm,coarse_sm2,info)
if (newsz < i) then if (newsz < i) then
! !
! We are going back and revisit a previous leve; ! We are going back and revisit a previous level;
! recover the aggregation. ! recover the aggregation.
! !
ilaggr = prec%precv(newsz)%linmap%iaggr ilaggr = prec%precv(newsz)%linmap%iaggr
@ -419,8 +421,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (do_timings) call psb_toc(idx_matasb) if (do_timings) call psb_toc(idx_matasb)
if (info /= 0) then if (info /= 0) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Mat asb') & a_err=ch_err)
goto 9999 goto 9999
endif endif
exit array_build_loop exit array_build_loop
@ -431,9 +434,11 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (do_timings) call psb_toc(idx_matasb) if (do_timings) call psb_toc(idx_matasb)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Map build') & a_err=ch_err)
goto 9999 goto 9999
endif endif
if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info) if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)

@ -101,7 +101,8 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
character(len=40) :: ch_err
info=psb_success_ info=psb_success_
err=0 err=0
@ -296,7 +297,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i) call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Error @ level',i write(ch_err,'(a,i7)') 'Error @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err=ch_err) & a_err=ch_err)
goto 9999 goto 9999

@ -94,7 +94,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
type(amg_s_onelev_type), allocatable :: tprecv(:) type(amg_s_onelev_type), allocatable :: tprecv(:)
logical :: cpymat_ logical :: cpymat_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
character(len=40) :: ch_err
integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1 integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1
logical, parameter :: do_timings=.false. logical, parameter :: do_timings=.false.
@ -334,8 +335,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,prec%ag_data,info) & ilaggr,nlaggr,op_prol,prec%ag_data,info)
if (do_timings) call psb_toc(idx_bldtp) if (do_timings) call psb_toc(idx_bldtp)
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Map build') & a_err=ch_err)
goto 9999 goto 9999
endif endif
@ -406,7 +408,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
& coarse_sm,coarse_sm2,info) & coarse_sm,coarse_sm2,info)
if (newsz < i) then if (newsz < i) then
! !
! We are going back and revisit a previous leve; ! We are going back and revisit a previous level;
! recover the aggregation. ! recover the aggregation.
! !
ilaggr = prec%precv(newsz)%linmap%iaggr ilaggr = prec%precv(newsz)%linmap%iaggr
@ -419,8 +421,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (do_timings) call psb_toc(idx_matasb) if (do_timings) call psb_toc(idx_matasb)
if (info /= 0) then if (info /= 0) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Mat asb') & a_err=ch_err)
goto 9999 goto 9999
endif endif
exit array_build_loop exit array_build_loop
@ -432,8 +435,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
if (do_timings) call psb_toc(idx_matasb) if (do_timings) call psb_toc(idx_matasb)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Map build') & a_err=ch_err)
goto 9999 goto 9999
endif endif
if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info) if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)

@ -101,7 +101,8 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
character(len=40) :: ch_err
info=psb_success_ info=psb_success_
err=0 err=0
@ -296,7 +297,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i) call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Error @ level',i write(ch_err,'(a,i7)') 'Error @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err=ch_err) & a_err=ch_err)
goto 9999 goto 9999

@ -94,7 +94,8 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat)
type(amg_z_onelev_type), allocatable :: tprecv(:) type(amg_z_onelev_type), allocatable :: tprecv(:)
logical :: cpymat_ logical :: cpymat_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
character(len=40) :: ch_err
integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1 integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1
logical, parameter :: do_timings=.false. logical, parameter :: do_timings=.false.
@ -334,8 +335,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,prec%ag_data,info) & ilaggr,nlaggr,op_prol,prec%ag_data,info)
if (do_timings) call psb_toc(idx_bldtp) if (do_timings) call psb_toc(idx_bldtp)
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Map build') & a_err=ch_err)
goto 9999 goto 9999
endif endif
@ -406,7 +408,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat)
& coarse_sm,coarse_sm2,info) & coarse_sm,coarse_sm2,info)
if (newsz < i) then if (newsz < i) then
! !
! We are going back and revisit a previous leve; ! We are going back and revisit a previous level;
! recover the aggregation. ! recover the aggregation.
! !
ilaggr = prec%precv(newsz)%linmap%iaggr ilaggr = prec%precv(newsz)%linmap%iaggr
@ -419,8 +421,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat)
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (do_timings) call psb_toc(idx_matasb) if (do_timings) call psb_toc(idx_matasb)
if (info /= 0) then if (info /= 0) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Mat asb') & a_err=ch_err)
goto 9999 goto 9999
endif endif
exit array_build_loop exit array_build_loop
@ -432,8 +435,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat)
if (do_timings) call psb_toc(idx_matasb) if (do_timings) call psb_toc(idx_matasb)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Map build') & a_err=ch_err)
goto 9999 goto 9999
endif endif
if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info) if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)

@ -101,7 +101,8 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
character(len=40) :: ch_err
info=psb_success_ info=psb_success_
err=0 err=0
@ -296,7 +297,7 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i) call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
if (info /= psb_success_) then if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Error @ level',i write(ch_err,'(a,i7)') 'Error @ level ',i
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err=ch_err) & a_err=ch_err)
goto 9999 goto 9999

Loading…
Cancel
Save