From 53998a1da9974d712f43e3ddccafc7049ed65ffc Mon Sep 17 00:00:00 2001 From: sfilippone Date: Mon, 28 Aug 2023 13:25:53 +0200 Subject: [PATCH 1/2] Fixed out of bound accesses. --- amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 | 1 + amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 | 1 + amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 | 1 + amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 | 1 + 4 files changed, 4 insertions(+) diff --git a/amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 b/amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 index 4041ebe5..53892ebc 100644 --- a/amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 @@ -248,6 +248,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in j = icol(k) ! If any of the neighbours is already assigned, ! we will not reset. + if (j>nr) cycle step1 if (ilaggr(j) > 0) cycle step1 if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then ip = ip + 1 diff --git a/amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 b/amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 index de95abce..fba80c10 100644 --- a/amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 @@ -248,6 +248,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in j = icol(k) ! If any of the neighbours is already assigned, ! we will not reset. + if (j>nr) cycle step1 if (ilaggr(j) > 0) cycle step1 if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then ip = ip + 1 diff --git a/amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 b/amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 index 0a809624..857c6ff3 100644 --- a/amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 @@ -248,6 +248,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in j = icol(k) ! If any of the neighbours is already assigned, ! we will not reset. + if (j>nr) cycle step1 if (ilaggr(j) > 0) cycle step1 if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then ip = ip + 1 diff --git a/amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 b/amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 index 2c467426..50fe70a2 100644 --- a/amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 @@ -248,6 +248,7 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in j = icol(k) ! If any of the neighbours is already assigned, ! we will not reset. + if (j>nr) cycle step1 if (ilaggr(j) > 0) cycle step1 if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then ip = ip + 1 From 24c85c7114ea62034288c4833cc05713c4bfe67f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 31 Aug 2023 08:35:27 -0400 Subject: [PATCH 2/2] Merged hierarchy_ and smoothers_ free methods from dev --- amgprec/amg_c_onelev_mod.f90 | 15 +++- amgprec/amg_c_prec_type.f90 | 72 +++++++++++++++++++ amgprec/amg_d_onelev_mod.f90 | 15 +++- amgprec/amg_d_prec_type.f90 | 72 +++++++++++++++++++ amgprec/amg_s_onelev_mod.f90 | 15 +++- amgprec/amg_s_prec_type.f90 | 72 +++++++++++++++++++ amgprec/amg_z_onelev_mod.f90 | 15 +++- amgprec/amg_z_prec_type.f90 | 72 +++++++++++++++++++ amgprec/impl/level/Makefile | 4 ++ .../amg_c_base_onelev_free_smoothers.f90 | 60 ++++++++++++++++ .../amg_d_base_onelev_free_smoothers.f90 | 60 ++++++++++++++++ .../amg_s_base_onelev_free_smoothers.f90 | 60 ++++++++++++++++ .../amg_z_base_onelev_free_smoothers.f90 | 60 ++++++++++++++++ 13 files changed, 588 insertions(+), 4 deletions(-) create mode 100644 amgprec/impl/level/amg_c_base_onelev_free_smoothers.f90 create mode 100644 amgprec/impl/level/amg_d_base_onelev_free_smoothers.f90 create mode 100644 amgprec/impl/level/amg_s_base_onelev_free_smoothers.f90 create mode 100644 amgprec/impl/level/amg_z_base_onelev_free_smoothers.f90 diff --git a/amgprec/amg_c_onelev_mod.f90 b/amgprec/amg_c_onelev_mod.f90 index 7cb87bf4..2cef1397 100644 --- a/amgprec/amg_c_onelev_mod.f90 +++ b/amgprec/amg_c_onelev_mod.f90 @@ -189,6 +189,7 @@ module amg_c_onelev_mod procedure, pass(lv) :: descr => amg_c_base_onelev_descr procedure, pass(lv) :: default => c_base_onelev_default procedure, pass(lv) :: free => amg_c_base_onelev_free + procedure, pass(lv) :: free_smoothers => amg_c_base_onelev_free_smoothers procedure, pass(lv) :: nullify => c_base_onelev_nullify procedure, pass(lv) :: check => amg_c_base_onelev_check procedure, pass(lv) :: dump => amg_c_base_onelev_dump @@ -285,7 +286,7 @@ module amg_c_onelev_mod end subroutine amg_c_base_onelev_cnv end interface -interface + interface subroutine amg_c_base_onelev_free(lv,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_clinmap_type, psb_spk_, amg_c_onelev_type, & @@ -297,6 +298,18 @@ interface end subroutine amg_c_base_onelev_free end interface + interface + subroutine amg_c_base_onelev_free_smoothers(lv,info) + import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & + & psb_clinmap_type, psb_spk_, amg_c_onelev_type, & + & psb_ipk_, psb_epk_, psb_desc_type + implicit none + + class(amg_c_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_base_onelev_free_smoothers + end interface + interface subroutine amg_c_base_onelev_check(lv,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/amgprec/amg_c_prec_type.f90 b/amgprec/amg_c_prec_type.f90 index cb9e3f31..9fd5afc5 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -135,7 +135,9 @@ module amg_c_prec_type procedure, pass(prec) :: build => amg_cprecbld procedure, pass(prec) :: hierarchy_build => amg_c_hierarchy_bld procedure, pass(prec) :: hierarchy_rebuild => amg_c_hierarchy_rebld + procedure, pass(prec) :: hierarchy_free => amg_c_hierarchy_free procedure, pass(prec) :: smoothers_build => amg_c_smoothers_bld + procedure, pass(prec) :: smoothers_free => amg_c_smoothers_free procedure, pass(prec) :: descr => amg_cfile_prec_descr end type amg_cprec_type @@ -345,6 +347,14 @@ module amg_c_prec_type end subroutine amg_c_smoothers_bld end interface amg_smoothers_bld + interface amg_smoothers_free + module procedure amg_c_smoothers_free + end interface amg_smoothers_free + + interface amg_hierarchy_free + module procedure amg_c_hierarchy_free + end interface amg_hierarchy_free + contains ! ! Function returning a pointer to the smoother @@ -618,6 +628,68 @@ contains end subroutine amg_c_prec_free + subroutine amg_c_smoothers_free(prec,info) + + implicit none + + ! Arguments + class(amg_cprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + info=psb_success_ + name = 'amg_c_smoothers_free' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if + + if (allocated(prec%precv)) then + do i=1,size(prec%precv) + call prec%precv(i)%free_smoothers(info) + end do + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine amg_c_smoothers_free + + subroutine amg_c_hierarchy_free(prec,info) + + implicit none + + ! Arguments + class(amg_cprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + info=psb_success_ + name = 'amg_c_hierarchy_free' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if + + me=-1 + write(0,*) 'Missing implementation ' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine amg_c_hierarchy_free ! diff --git a/amgprec/amg_d_onelev_mod.f90 b/amgprec/amg_d_onelev_mod.f90 index 1bf30847..60ed9448 100644 --- a/amgprec/amg_d_onelev_mod.f90 +++ b/amgprec/amg_d_onelev_mod.f90 @@ -190,6 +190,7 @@ module amg_d_onelev_mod procedure, pass(lv) :: descr => amg_d_base_onelev_descr procedure, pass(lv) :: default => d_base_onelev_default procedure, pass(lv) :: free => amg_d_base_onelev_free + procedure, pass(lv) :: free_smoothers => amg_d_base_onelev_free_smoothers procedure, pass(lv) :: nullify => d_base_onelev_nullify procedure, pass(lv) :: check => amg_d_base_onelev_check procedure, pass(lv) :: dump => amg_d_base_onelev_dump @@ -286,7 +287,7 @@ module amg_d_onelev_mod end subroutine amg_d_base_onelev_cnv end interface -interface + interface subroutine amg_d_base_onelev_free(lv,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, & @@ -298,6 +299,18 @@ interface end subroutine amg_d_base_onelev_free end interface + interface + subroutine amg_d_base_onelev_free_smoothers(lv,info) + import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & + & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, & + & psb_ipk_, psb_epk_, psb_desc_type + implicit none + + class(amg_d_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_base_onelev_free_smoothers + end interface + interface subroutine amg_d_base_onelev_check(lv,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index 0774d0ad..9fbc2b5d 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -135,7 +135,9 @@ module amg_d_prec_type procedure, pass(prec) :: build => amg_dprecbld procedure, pass(prec) :: hierarchy_build => amg_d_hierarchy_bld procedure, pass(prec) :: hierarchy_rebuild => amg_d_hierarchy_rebld + procedure, pass(prec) :: hierarchy_free => amg_d_hierarchy_free procedure, pass(prec) :: smoothers_build => amg_d_smoothers_bld + procedure, pass(prec) :: smoothers_free => amg_d_smoothers_free procedure, pass(prec) :: descr => amg_dfile_prec_descr end type amg_dprec_type @@ -345,6 +347,14 @@ module amg_d_prec_type end subroutine amg_d_smoothers_bld end interface amg_smoothers_bld + interface amg_smoothers_free + module procedure amg_d_smoothers_free + end interface amg_smoothers_free + + interface amg_hierarchy_free + module procedure amg_d_hierarchy_free + end interface amg_hierarchy_free + contains ! ! Function returning a pointer to the smoother @@ -618,6 +628,68 @@ contains end subroutine amg_d_prec_free + subroutine amg_d_smoothers_free(prec,info) + + implicit none + + ! Arguments + class(amg_dprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + info=psb_success_ + name = 'amg_d_smoothers_free' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if + + if (allocated(prec%precv)) then + do i=1,size(prec%precv) + call prec%precv(i)%free_smoothers(info) + end do + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine amg_d_smoothers_free + + subroutine amg_d_hierarchy_free(prec,info) + + implicit none + + ! Arguments + class(amg_dprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + info=psb_success_ + name = 'amg_d_hierarchy_free' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if + + me=-1 + write(0,*) 'Missing implementation ' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine amg_d_hierarchy_free ! diff --git a/amgprec/amg_s_onelev_mod.f90 b/amgprec/amg_s_onelev_mod.f90 index bd02b83b..c826001d 100644 --- a/amgprec/amg_s_onelev_mod.f90 +++ b/amgprec/amg_s_onelev_mod.f90 @@ -190,6 +190,7 @@ module amg_s_onelev_mod procedure, pass(lv) :: descr => amg_s_base_onelev_descr procedure, pass(lv) :: default => s_base_onelev_default procedure, pass(lv) :: free => amg_s_base_onelev_free + procedure, pass(lv) :: free_smoothers => amg_s_base_onelev_free_smoothers procedure, pass(lv) :: nullify => s_base_onelev_nullify procedure, pass(lv) :: check => amg_s_base_onelev_check procedure, pass(lv) :: dump => amg_s_base_onelev_dump @@ -286,7 +287,7 @@ module amg_s_onelev_mod end subroutine amg_s_base_onelev_cnv end interface -interface + interface subroutine amg_s_base_onelev_free(lv,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_slinmap_type, psb_spk_, amg_s_onelev_type, & @@ -298,6 +299,18 @@ interface end subroutine amg_s_base_onelev_free end interface + interface + subroutine amg_s_base_onelev_free_smoothers(lv,info) + import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & + & psb_slinmap_type, psb_spk_, amg_s_onelev_type, & + & psb_ipk_, psb_epk_, psb_desc_type + implicit none + + class(amg_s_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_base_onelev_free_smoothers + end interface + interface subroutine amg_s_base_onelev_check(lv,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index 11a789b1..88a22078 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -135,7 +135,9 @@ module amg_s_prec_type procedure, pass(prec) :: build => amg_sprecbld procedure, pass(prec) :: hierarchy_build => amg_s_hierarchy_bld procedure, pass(prec) :: hierarchy_rebuild => amg_s_hierarchy_rebld + procedure, pass(prec) :: hierarchy_free => amg_s_hierarchy_free procedure, pass(prec) :: smoothers_build => amg_s_smoothers_bld + procedure, pass(prec) :: smoothers_free => amg_s_smoothers_free procedure, pass(prec) :: descr => amg_sfile_prec_descr end type amg_sprec_type @@ -345,6 +347,14 @@ module amg_s_prec_type end subroutine amg_s_smoothers_bld end interface amg_smoothers_bld + interface amg_smoothers_free + module procedure amg_s_smoothers_free + end interface amg_smoothers_free + + interface amg_hierarchy_free + module procedure amg_s_hierarchy_free + end interface amg_hierarchy_free + contains ! ! Function returning a pointer to the smoother @@ -618,6 +628,68 @@ contains end subroutine amg_s_prec_free + subroutine amg_s_smoothers_free(prec,info) + + implicit none + + ! Arguments + class(amg_sprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + info=psb_success_ + name = 'amg_s_smoothers_free' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if + + if (allocated(prec%precv)) then + do i=1,size(prec%precv) + call prec%precv(i)%free_smoothers(info) + end do + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine amg_s_smoothers_free + + subroutine amg_s_hierarchy_free(prec,info) + + implicit none + + ! Arguments + class(amg_sprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + info=psb_success_ + name = 'amg_s_hierarchy_free' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if + + me=-1 + write(0,*) 'Missing implementation ' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine amg_s_hierarchy_free ! diff --git a/amgprec/amg_z_onelev_mod.f90 b/amgprec/amg_z_onelev_mod.f90 index 648ede75..78259f4d 100644 --- a/amgprec/amg_z_onelev_mod.f90 +++ b/amgprec/amg_z_onelev_mod.f90 @@ -189,6 +189,7 @@ module amg_z_onelev_mod procedure, pass(lv) :: descr => amg_z_base_onelev_descr procedure, pass(lv) :: default => z_base_onelev_default procedure, pass(lv) :: free => amg_z_base_onelev_free + procedure, pass(lv) :: free_smoothers => amg_z_base_onelev_free_smoothers procedure, pass(lv) :: nullify => z_base_onelev_nullify procedure, pass(lv) :: check => amg_z_base_onelev_check procedure, pass(lv) :: dump => amg_z_base_onelev_dump @@ -285,7 +286,7 @@ module amg_z_onelev_mod end subroutine amg_z_base_onelev_cnv end interface -interface + interface subroutine amg_z_base_onelev_free(lv,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, & @@ -297,6 +298,18 @@ interface end subroutine amg_z_base_onelev_free end interface + interface + subroutine amg_z_base_onelev_free_smoothers(lv,info) + import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & + & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, & + & psb_ipk_, psb_epk_, psb_desc_type + implicit none + + class(amg_z_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_base_onelev_free_smoothers + end interface + interface subroutine amg_z_base_onelev_check(lv,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/amgprec/amg_z_prec_type.f90 b/amgprec/amg_z_prec_type.f90 index 33c9324a..7b9ad346 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -135,7 +135,9 @@ module amg_z_prec_type procedure, pass(prec) :: build => amg_zprecbld procedure, pass(prec) :: hierarchy_build => amg_z_hierarchy_bld procedure, pass(prec) :: hierarchy_rebuild => amg_z_hierarchy_rebld + procedure, pass(prec) :: hierarchy_free => amg_z_hierarchy_free procedure, pass(prec) :: smoothers_build => amg_z_smoothers_bld + procedure, pass(prec) :: smoothers_free => amg_z_smoothers_free procedure, pass(prec) :: descr => amg_zfile_prec_descr end type amg_zprec_type @@ -345,6 +347,14 @@ module amg_z_prec_type end subroutine amg_z_smoothers_bld end interface amg_smoothers_bld + interface amg_smoothers_free + module procedure amg_z_smoothers_free + end interface amg_smoothers_free + + interface amg_hierarchy_free + module procedure amg_z_hierarchy_free + end interface amg_hierarchy_free + contains ! ! Function returning a pointer to the smoother @@ -618,6 +628,68 @@ contains end subroutine amg_z_prec_free + subroutine amg_z_smoothers_free(prec,info) + + implicit none + + ! Arguments + class(amg_zprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + info=psb_success_ + name = 'amg_z_smoothers_free' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if + + if (allocated(prec%precv)) then + do i=1,size(prec%precv) + call prec%precv(i)%free_smoothers(info) + end do + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine amg_z_smoothers_free + + subroutine amg_z_hierarchy_free(prec,info) + + implicit none + + ! Arguments + class(amg_zprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + info=psb_success_ + name = 'amg_z_hierarchy_free' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if + + me=-1 + write(0,*) 'Missing implementation ' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine amg_z_hierarchy_free ! diff --git a/amgprec/impl/level/Makefile b/amgprec/impl/level/Makefile index 861769f3..4ea569bd 100644 --- a/amgprec/impl/level/Makefile +++ b/amgprec/impl/level/Makefile @@ -17,6 +17,7 @@ amg_c_base_onelev_csetr.o \ amg_c_base_onelev_descr.o \ amg_c_base_onelev_dump.o \ amg_c_base_onelev_free.o \ +amg_c_base_onelev_free_smoothers.o \ amg_c_base_onelev_mat_asb.o \ amg_c_base_onelev_setag.o \ amg_c_base_onelev_setsm.o \ @@ -32,6 +33,7 @@ amg_d_base_onelev_csetr.o \ amg_d_base_onelev_descr.o \ amg_d_base_onelev_dump.o \ amg_d_base_onelev_free.o \ +amg_d_base_onelev_free_smoothers.o \ amg_d_base_onelev_mat_asb.o \ amg_d_base_onelev_setag.o \ amg_d_base_onelev_setsm.o \ @@ -47,6 +49,7 @@ amg_s_base_onelev_csetr.o \ amg_s_base_onelev_descr.o \ amg_s_base_onelev_dump.o \ amg_s_base_onelev_free.o \ +amg_s_base_onelev_free_smoothers.o \ amg_s_base_onelev_mat_asb.o \ amg_s_base_onelev_setag.o \ amg_s_base_onelev_setsm.o \ @@ -62,6 +65,7 @@ amg_z_base_onelev_csetr.o \ amg_z_base_onelev_descr.o \ amg_z_base_onelev_dump.o \ amg_z_base_onelev_free.o \ +amg_z_base_onelev_free_smoothers.o \ amg_z_base_onelev_mat_asb.o \ amg_z_base_onelev_setag.o \ amg_z_base_onelev_setsm.o \ diff --git a/amgprec/impl/level/amg_c_base_onelev_free_smoothers.f90 b/amgprec/impl/level/amg_c_base_onelev_free_smoothers.f90 new file mode 100644 index 00000000..c2a608f1 --- /dev/null +++ b/amgprec/impl/level/amg_c_base_onelev_free_smoothers.f90 @@ -0,0 +1,60 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.7) +! +! (C) Copyright 2021 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine amg_c_base_onelev_free_smoothers(lv,info) + + use psb_base_mod + use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_free_smoothers + implicit none + + class(amg_c_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i + + info = psb_success_ + + ! We might just deallocate the top level array, except + ! that there may be inner objects containing C pointers, + ! e.g. UMFPACK, SLU or CUDA stuff. + ! We really need FINALs. + if (allocated(lv%sm)) & + & call lv%sm%free(info) + + if (allocated(lv%sm2a)) & + & call lv%sm2a%free(info) + +end subroutine amg_c_base_onelev_free_smoothers diff --git a/amgprec/impl/level/amg_d_base_onelev_free_smoothers.f90 b/amgprec/impl/level/amg_d_base_onelev_free_smoothers.f90 new file mode 100644 index 00000000..9431babe --- /dev/null +++ b/amgprec/impl/level/amg_d_base_onelev_free_smoothers.f90 @@ -0,0 +1,60 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.7) +! +! (C) Copyright 2021 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine amg_d_base_onelev_free_smoothers(lv,info) + + use psb_base_mod + use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_free_smoothers + implicit none + + class(amg_d_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i + + info = psb_success_ + + ! We might just deallocate the top level array, except + ! that there may be inner objects containing C pointers, + ! e.g. UMFPACK, SLU or CUDA stuff. + ! We really need FINALs. + if (allocated(lv%sm)) & + & call lv%sm%free(info) + + if (allocated(lv%sm2a)) & + & call lv%sm2a%free(info) + +end subroutine amg_d_base_onelev_free_smoothers diff --git a/amgprec/impl/level/amg_s_base_onelev_free_smoothers.f90 b/amgprec/impl/level/amg_s_base_onelev_free_smoothers.f90 new file mode 100644 index 00000000..9d03625f --- /dev/null +++ b/amgprec/impl/level/amg_s_base_onelev_free_smoothers.f90 @@ -0,0 +1,60 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.7) +! +! (C) Copyright 2021 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine amg_s_base_onelev_free_smoothers(lv,info) + + use psb_base_mod + use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_free_smoothers + implicit none + + class(amg_s_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i + + info = psb_success_ + + ! We might just deallocate the top level array, except + ! that there may be inner objects containing C pointers, + ! e.g. UMFPACK, SLU or CUDA stuff. + ! We really need FINALs. + if (allocated(lv%sm)) & + & call lv%sm%free(info) + + if (allocated(lv%sm2a)) & + & call lv%sm2a%free(info) + +end subroutine amg_s_base_onelev_free_smoothers diff --git a/amgprec/impl/level/amg_z_base_onelev_free_smoothers.f90 b/amgprec/impl/level/amg_z_base_onelev_free_smoothers.f90 new file mode 100644 index 00000000..79d63bfe --- /dev/null +++ b/amgprec/impl/level/amg_z_base_onelev_free_smoothers.f90 @@ -0,0 +1,60 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.7) +! +! (C) Copyright 2021 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine amg_z_base_onelev_free_smoothers(lv,info) + + use psb_base_mod + use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_free_smoothers + implicit none + + class(amg_z_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i + + info = psb_success_ + + ! We might just deallocate the top level array, except + ! that there may be inner objects containing C pointers, + ! e.g. UMFPACK, SLU or CUDA stuff. + ! We really need FINALs. + if (allocated(lv%sm)) & + & call lv%sm%free(info) + + if (allocated(lv%sm2a)) & + & call lv%sm2a%free(info) + +end subroutine amg_z_base_onelev_free_smoothers