fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

Improved error handling in _bld

Browse Source
This commit is contained in:
sfilippone
2026-04-02 13:53:40 +02:00
parent 087dc37868
commit 04d7122380
8 changed files with 53 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
amgprec/impl/amg_c_hierarchy_bld.F90
+9 -5
View File
@@ -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)
amgprec/impl/amg_c_smoothers_bld.f90
+2 -1
View File
@@ -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
amgprec/impl/amg_d_hierarchy_bld.F90
+10 -5
View File
@@ -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)
amgprec/impl/amg_d_smoothers_bld.f90
+2 -1
View File
@@ -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
amgprec/impl/amg_s_hierarchy_bld.F90
+9 -5
View File
@@ -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)
amgprec/impl/amg_s_smoothers_bld.f90
+2 -1
View File
@@ -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
amgprec/impl/amg_z_hierarchy_bld.F90
+9 -5
View File
@@ -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)
amgprec/impl/amg_z_smoothers_bld.f90
+2 -1
View File
@@ -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