diff --git a/base/modules/psb_base_mat_mod.f90 b/base/modules/psb_base_mat_mod.f90 index 96d325d8..4d2a9dde 100644 --- a/base/modules/psb_base_mat_mod.f90 +++ b/base/modules/psb_base_mat_mod.f90 @@ -132,42 +132,42 @@ module psb_base_mat_mod ! ! ! == = ================================= - procedure, pass(a) :: get_nrows => psb_base_get_nrows - procedure, pass(a) :: get_ncols => psb_base_get_ncols - procedure, pass(a) :: get_nzeros => psb_base_get_nzeros - procedure, pass(a) :: get_nz_row => psb_base_get_nz_row - procedure, pass(a) :: get_size => psb_base_get_size - procedure, pass(a) :: get_state => psb_base_get_state - procedure, pass(a) :: get_dupl => psb_base_get_dupl - procedure, nopass :: get_fmt => psb_base_get_fmt - procedure, pass(a) :: is_null => psb_base_is_null - procedure, pass(a) :: is_bld => psb_base_is_bld - procedure, pass(a) :: is_upd => psb_base_is_upd - procedure, pass(a) :: is_asb => psb_base_is_asb - procedure, pass(a) :: is_sorted => psb_base_is_sorted - procedure, pass(a) :: is_upper => psb_base_is_upper - procedure, pass(a) :: is_lower => psb_base_is_lower + procedure, pass(a) :: get_nrows => psb_base_get_nrows + procedure, pass(a) :: get_ncols => psb_base_get_ncols + procedure, pass(a) :: get_nzeros => psb_base_get_nzeros + procedure, pass(a) :: get_nz_row => psb_base_get_nz_row + procedure, pass(a) :: get_size => psb_base_get_size + procedure, pass(a) :: get_state => psb_base_get_state + procedure, pass(a) :: get_dupl => psb_base_get_dupl + procedure, nopass :: get_fmt => psb_base_get_fmt + procedure, pass(a) :: is_null => psb_base_is_null + procedure, pass(a) :: is_bld => psb_base_is_bld + procedure, pass(a) :: is_upd => psb_base_is_upd + procedure, pass(a) :: is_asb => psb_base_is_asb + procedure, pass(a) :: is_sorted => psb_base_is_sorted + procedure, pass(a) :: is_upper => psb_base_is_upper + procedure, pass(a) :: is_lower => psb_base_is_lower procedure, pass(a) :: is_triangle => psb_base_is_triangle - procedure, pass(a) :: is_unit => psb_base_is_unit + procedure, pass(a) :: is_unit => psb_base_is_unit ! == = ================================= ! ! Setters ! ! == = ================================= - procedure, pass(a) :: set_nrows => psb_base_set_nrows - procedure, pass(a) :: set_ncols => psb_base_set_ncols - procedure, pass(a) :: set_dupl => psb_base_set_dupl - procedure, pass(a) :: set_state => psb_base_set_state - procedure, pass(a) :: set_null => psb_base_set_null - procedure, pass(a) :: set_bld => psb_base_set_bld - procedure, pass(a) :: set_upd => psb_base_set_upd - procedure, pass(a) :: set_asb => psb_base_set_asb - procedure, pass(a) :: set_sorted => psb_base_set_sorted - procedure, pass(a) :: set_upper => psb_base_set_upper - procedure, pass(a) :: set_lower => psb_base_set_lower + procedure, pass(a) :: set_nrows => psb_base_set_nrows + procedure, pass(a) :: set_ncols => psb_base_set_ncols + procedure, pass(a) :: set_dupl => psb_base_set_dupl + procedure, pass(a) :: set_state => psb_base_set_state + procedure, pass(a) :: set_null => psb_base_set_null + procedure, pass(a) :: set_bld => psb_base_set_bld + procedure, pass(a) :: set_upd => psb_base_set_upd + procedure, pass(a) :: set_asb => psb_base_set_asb + procedure, pass(a) :: set_sorted => psb_base_set_sorted + procedure, pass(a) :: set_upper => psb_base_set_upper + procedure, pass(a) :: set_lower => psb_base_set_lower procedure, pass(a) :: set_triangle => psb_base_set_triangle - procedure, pass(a) :: set_unit => psb_base_set_unit + procedure, pass(a) :: set_unit => psb_base_set_unit ! == = ================================= @@ -175,13 +175,13 @@ module psb_base_mat_mod ! Data management ! ! == = ================================= - procedure, pass(a) :: get_neigh => psb_base_get_neigh - procedure, pass(a) :: free => psb_base_free - procedure, pass(a) :: trim => psb_base_trim - procedure, pass(a) :: reinit => psb_base_reinit + procedure, pass(a) :: get_neigh => psb_base_get_neigh + procedure, pass(a) :: free => psb_base_free + procedure, pass(a) :: trim => psb_base_trim + procedure, pass(a) :: reinit => psb_base_reinit procedure, pass(a) :: allocate_mnnz => psb_base_allocate_mnnz procedure, pass(a) :: reallocate_nz => psb_base_reallocate_nz - generic, public :: allocate => allocate_mnnz + generic, public :: allocate => allocate_mnnz generic, public :: reallocate => reallocate_nz procedure, pass(a) :: csgetptn => psb_base_csgetptn generic, public :: csget => csgetptn diff --git a/prec/impl/psb_cprecinit.f90 b/prec/impl/psb_cprecinit.f90 index 80027000..1fcc2aec 100644 --- a/prec/impl/psb_cprecinit.f90 +++ b/prec/impl/psb_cprecinit.f90 @@ -45,7 +45,7 @@ subroutine psb_cprecinit(p,ptype,info) info = psb_success_ if (allocated(p%prec) ) then - call p%prec%precfree(info) + call p%prec%free(info) if (info == psb_success_) deallocate(p%prec,stat=info) if (info /= psb_success_) return end if diff --git a/prec/impl/psb_dprecinit.f90 b/prec/impl/psb_dprecinit.f90 index de51e035..b66e538f 100644 --- a/prec/impl/psb_dprecinit.f90 +++ b/prec/impl/psb_dprecinit.f90 @@ -44,7 +44,7 @@ subroutine psb_dprecinit(p,ptype,info) info = psb_success_ if (allocated(p%prec) ) then - call p%prec%precfree(info) + call p%prec%free(info) if (info == psb_success_) deallocate(p%prec,stat=info) if (info /= psb_success_) return end if diff --git a/prec/impl/psb_sprecinit.f90 b/prec/impl/psb_sprecinit.f90 index 77cb7225..9ed08fbb 100644 --- a/prec/impl/psb_sprecinit.f90 +++ b/prec/impl/psb_sprecinit.f90 @@ -44,7 +44,7 @@ subroutine psb_sprecinit(p,ptype,info) info = psb_success_ if (allocated(p%prec) ) then - call p%prec%precfree(info) + call p%prec%free(info) if (info == psb_success_) deallocate(p%prec,stat=info) if (info /= psb_success_) return end if diff --git a/prec/impl/psb_zprecinit.f90 b/prec/impl/psb_zprecinit.f90 index 4733bc1f..df913917 100644 --- a/prec/impl/psb_zprecinit.f90 +++ b/prec/impl/psb_zprecinit.f90 @@ -45,7 +45,7 @@ subroutine psb_zprecinit(p,ptype,info) info = psb_success_ if (allocated(p%prec) ) then - call p%prec%precfree(info) + call p%prec%free(info) if (info == psb_success_) deallocate(p%prec,stat=info) if (info /= psb_success_) return end if diff --git a/prec/psb_c_base_prec_mod.f90 b/prec/psb_c_base_prec_mod.f90 index 6409fb4a..853c3669 100644 --- a/prec/psb_c_base_prec_mod.f90 +++ b/prec/psb_c_base_prec_mod.f90 @@ -61,7 +61,7 @@ module psb_c_base_prec_mod procedure(psb_c_base_precbld), pass(prec), deferred :: precbld procedure(psb_c_base_sizeof), pass(prec), deferred :: sizeof procedure(psb_c_base_precinit), pass(prec), deferred :: precinit - procedure(psb_c_base_precfree), pass(prec), deferred :: precfree + procedure(psb_c_base_precfree), pass(prec), deferred :: free procedure(psb_c_base_precdescr), pass(prec), deferred :: precdescr procedure(psb_c_base_precdump), pass(prec), deferred :: dump procedure(psb_c_base_precclone), pass(prec), deferred :: clone diff --git a/prec/psb_c_bjacprec.f90 b/prec/psb_c_bjacprec.f90 index a1612aa6..f6183405 100644 --- a/prec/psb_c_bjacprec.f90 +++ b/prec/psb_c_bjacprec.f90 @@ -45,10 +45,10 @@ module psb_c_bjacprec procedure, pass(prec) :: precseti => psb_c_bjac_precseti !!$ procedure, pass(prec) :: precsetr => psb_c_bjac_precsetr !!$ procedure, pass(prec) :: precsetc => psb_c_bjac_precsetc - procedure, pass(prec) :: precfree => psb_c_bjac_precfree procedure, pass(prec) :: precdescr => psb_c_bjac_precdescr procedure, pass(prec) :: dump => psb_c_bjac_dump procedure, pass(prec) :: clone => psb_c_bjac_clone + procedure, pass(prec) :: free => psb_c_bjac_precfree procedure, pass(prec) :: sizeof => psb_c_bjac_sizeof procedure, pass(prec) :: get_nzeros => psb_c_bjac_get_nzeros end type psb_c_bjac_prec_type diff --git a/prec/psb_c_diagprec.f90 b/prec/psb_c_diagprec.f90 index 9e7d061f..8d7525dc 100644 --- a/prec/psb_c_diagprec.f90 +++ b/prec/psb_c_diagprec.f90 @@ -41,11 +41,11 @@ module psb_c_diagprec procedure, pass(prec) :: c_apply => psb_c_diag_apply procedure, pass(prec) :: precbld => psb_c_diag_precbld procedure, pass(prec) :: precinit => psb_c_diag_precinit - procedure, pass(prec) :: precfree => psb_c_diag_precfree procedure, pass(prec) :: precdescr => psb_c_diag_precdescr procedure, pass(prec) :: sizeof => psb_c_diag_sizeof procedure, pass(prec) :: dump => psb_c_diag_dump procedure, pass(prec) :: clone => psb_c_diag_clone + procedure, pass(prec) :: free => psb_c_diag_precfree procedure, pass(prec) :: get_nzeros => psb_c_diag_get_nzeros end type psb_c_diag_prec_type diff --git a/prec/psb_c_nullprec.f90 b/prec/psb_c_nullprec.f90 index 2a657b28..ca39708d 100644 --- a/prec/psb_c_nullprec.f90 +++ b/prec/psb_c_nullprec.f90 @@ -39,11 +39,11 @@ module psb_c_nullprec procedure, pass(prec) :: c_apply => psb_c_null_apply procedure, pass(prec) :: precbld => psb_c_null_precbld procedure, pass(prec) :: precinit => psb_c_null_precinit - procedure, pass(prec) :: precfree => psb_c_null_precfree procedure, pass(prec) :: precdescr => psb_c_null_precdescr procedure, pass(prec) :: sizeof => psb_c_null_sizeof procedure, pass(prec) :: dump => psb_c_null_dump procedure, pass(prec) :: clone => psb_c_null_clone + procedure, pass(prec) :: free => psb_c_null_precfree end type psb_c_null_prec_type private :: psb_c_null_precbld, psb_c_null_sizeof,& diff --git a/prec/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index 6a02abb0..e1b42f0d 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -49,6 +49,7 @@ module psb_c_prec_type & psb_c_apply1_vect, psb_c_apply2_vect procedure, pass(prec) :: sizeof => psb_cprec_sizeof procedure, pass(prec) :: clone => psb_c_prec_clone + procedure, pass(prec) :: free => psb_c_prec_free end type psb_cprec_type interface psb_precfree @@ -171,11 +172,37 @@ contains call psb_erractionsave(err_act) me=-1 + call p%free(info) - if (allocated(p%prec)) then - call p%prec%precfree(info) + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_c_precfree + + subroutine psb_c_prec_free(prec,info) + class(psb_cprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: me, err_act,i + character(len=20) :: name + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name = 'psb_precfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(prec%prec)) then + call prec%prec%free(info) if (info /= psb_success_) goto 9999 - deallocate(p%prec,stat=info) + deallocate(prec%prec,stat=info) if (info /= psb_success_) goto 9999 end if call psb_erractionrestore(err_act) @@ -188,7 +215,7 @@ contains return end if return - end subroutine psb_c_precfree + end subroutine psb_c_prec_free function psb_cprec_sizeof(prec) result(val) class(psb_cprec_type), intent(in) :: prec diff --git a/prec/psb_d_base_prec_mod.f90 b/prec/psb_d_base_prec_mod.f90 index 90090e5f..eae724fe 100644 --- a/prec/psb_d_base_prec_mod.f90 +++ b/prec/psb_d_base_prec_mod.f90 @@ -61,7 +61,7 @@ module psb_d_base_prec_mod procedure(psb_d_base_precbld), pass(prec), deferred :: precbld procedure(psb_d_base_sizeof), pass(prec), deferred :: sizeof procedure(psb_d_base_precinit), pass(prec), deferred :: precinit - procedure(psb_d_base_precfree), pass(prec), deferred :: precfree + procedure(psb_d_base_precfree), pass(prec), deferred :: free procedure(psb_d_base_precdescr), pass(prec), deferred :: precdescr procedure(psb_d_base_precdump), pass(prec), deferred :: dump procedure(psb_d_base_precclone), pass(prec), deferred :: clone diff --git a/prec/psb_d_bjacprec.f90 b/prec/psb_d_bjacprec.f90 index 71f6dee6..8ca1b445 100644 --- a/prec/psb_d_bjacprec.f90 +++ b/prec/psb_d_bjacprec.f90 @@ -45,10 +45,10 @@ module psb_d_bjacprec procedure, pass(prec) :: precseti => psb_d_bjac_precseti !!$ procedure, pass(prec) :: precsetr => psb_d_bjac_precsetr !!$ procedure, pass(prec) :: precsetc => psb_d_bjac_precsetc - procedure, pass(prec) :: precfree => psb_d_bjac_precfree procedure, pass(prec) :: precdescr => psb_d_bjac_precdescr procedure, pass(prec) :: dump => psb_d_bjac_dump procedure, pass(prec) :: clone => psb_d_bjac_clone + procedure, pass(prec) :: free => psb_d_bjac_precfree procedure, pass(prec) :: sizeof => psb_d_bjac_sizeof procedure, pass(prec) :: get_nzeros => psb_d_bjac_get_nzeros end type psb_d_bjac_prec_type diff --git a/prec/psb_d_diagprec.f90 b/prec/psb_d_diagprec.f90 index d164a6c6..1fd2ac3e 100644 --- a/prec/psb_d_diagprec.f90 +++ b/prec/psb_d_diagprec.f90 @@ -41,11 +41,11 @@ module psb_d_diagprec procedure, pass(prec) :: d_apply => psb_d_diag_apply procedure, pass(prec) :: precbld => psb_d_diag_precbld procedure, pass(prec) :: precinit => psb_d_diag_precinit - procedure, pass(prec) :: precfree => psb_d_diag_precfree procedure, pass(prec) :: precdescr => psb_d_diag_precdescr procedure, pass(prec) :: sizeof => psb_d_diag_sizeof procedure, pass(prec) :: dump => psb_d_diag_dump procedure, pass(prec) :: clone => psb_d_diag_clone + procedure, pass(prec) :: free => psb_d_diag_precfree procedure, pass(prec) :: get_nzeros => psb_d_diag_get_nzeros end type psb_d_diag_prec_type diff --git a/prec/psb_d_nullprec.f90 b/prec/psb_d_nullprec.f90 index de8eaf23..0a87cf5e 100644 --- a/prec/psb_d_nullprec.f90 +++ b/prec/psb_d_nullprec.f90 @@ -39,11 +39,11 @@ module psb_d_nullprec procedure, pass(prec) :: d_apply => psb_d_null_apply procedure, pass(prec) :: precbld => psb_d_null_precbld procedure, pass(prec) :: precinit => psb_d_null_precinit - procedure, pass(prec) :: precfree => psb_d_null_precfree procedure, pass(prec) :: precdescr => psb_d_null_precdescr procedure, pass(prec) :: sizeof => psb_d_null_sizeof procedure, pass(prec) :: dump => psb_d_null_dump procedure, pass(prec) :: clone => psb_d_null_clone + procedure, pass(prec) :: free => psb_d_null_precfree end type psb_d_null_prec_type private :: psb_d_null_precbld, psb_d_null_sizeof,& diff --git a/prec/psb_d_prec_type.f90 b/prec/psb_d_prec_type.f90 index d8c8f271..8eb12158 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -49,6 +49,7 @@ module psb_d_prec_type & psb_d_apply1_vect, psb_d_apply2_vect procedure, pass(prec) :: sizeof => psb_dprec_sizeof procedure, pass(prec) :: clone => psb_d_prec_clone + procedure, pass(prec) :: free => psb_d_prec_free end type psb_dprec_type interface psb_precfree @@ -171,11 +172,37 @@ contains call psb_erractionsave(err_act) me=-1 + call p%free(info) - if (allocated(p%prec)) then - call p%prec%precfree(info) + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_d_precfree + + subroutine psb_d_prec_free(prec,info) + class(psb_dprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: me, err_act,i + character(len=20) :: name + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name = 'psb_precfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(prec%prec)) then + call prec%prec%free(info) if (info /= psb_success_) goto 9999 - deallocate(p%prec,stat=info) + deallocate(prec%prec,stat=info) if (info /= psb_success_) goto 9999 end if call psb_erractionrestore(err_act) @@ -188,7 +215,7 @@ contains return end if return - end subroutine psb_d_precfree + end subroutine psb_d_prec_free function psb_dprec_sizeof(prec) result(val) class(psb_dprec_type), intent(in) :: prec diff --git a/prec/psb_s_base_prec_mod.f90 b/prec/psb_s_base_prec_mod.f90 index ab8b83c3..f40a17b5 100644 --- a/prec/psb_s_base_prec_mod.f90 +++ b/prec/psb_s_base_prec_mod.f90 @@ -61,7 +61,7 @@ module psb_s_base_prec_mod procedure(psb_s_base_precbld), pass(prec), deferred :: precbld procedure(psb_s_base_sizeof), pass(prec), deferred :: sizeof procedure(psb_s_base_precinit), pass(prec), deferred :: precinit - procedure(psb_s_base_precfree), pass(prec), deferred :: precfree + procedure(psb_s_base_precfree), pass(prec), deferred :: free procedure(psb_s_base_precdescr), pass(prec), deferred :: precdescr procedure(psb_s_base_precdump), pass(prec), deferred :: dump procedure(psb_s_base_precclone), pass(prec), deferred :: clone diff --git a/prec/psb_s_bjacprec.f90 b/prec/psb_s_bjacprec.f90 index 7c8e5905..8e6b831a 100644 --- a/prec/psb_s_bjacprec.f90 +++ b/prec/psb_s_bjacprec.f90 @@ -45,10 +45,10 @@ module psb_s_bjacprec procedure, pass(prec) :: precseti => psb_s_bjac_precseti !!$ procedure, pass(prec) :: precsetr => psb_s_bjac_precsetr !!$ procedure, pass(prec) :: precsetc => psb_s_bjac_precsetc - procedure, pass(prec) :: precfree => psb_s_bjac_precfree procedure, pass(prec) :: precdescr => psb_s_bjac_precdescr procedure, pass(prec) :: dump => psb_s_bjac_dump procedure, pass(prec) :: clone => psb_s_bjac_clone + procedure, pass(prec) :: free => psb_s_bjac_precfree procedure, pass(prec) :: sizeof => psb_s_bjac_sizeof procedure, pass(prec) :: get_nzeros => psb_s_bjac_get_nzeros end type psb_s_bjac_prec_type diff --git a/prec/psb_s_diagprec.f90 b/prec/psb_s_diagprec.f90 index d966ab64..49452988 100644 --- a/prec/psb_s_diagprec.f90 +++ b/prec/psb_s_diagprec.f90 @@ -41,11 +41,11 @@ module psb_s_diagprec procedure, pass(prec) :: s_apply => psb_s_diag_apply procedure, pass(prec) :: precbld => psb_s_diag_precbld procedure, pass(prec) :: precinit => psb_s_diag_precinit - procedure, pass(prec) :: precfree => psb_s_diag_precfree procedure, pass(prec) :: precdescr => psb_s_diag_precdescr procedure, pass(prec) :: sizeof => psb_s_diag_sizeof procedure, pass(prec) :: dump => psb_s_diag_dump procedure, pass(prec) :: clone => psb_s_diag_clone + procedure, pass(prec) :: free => psb_s_diag_precfree procedure, pass(prec) :: get_nzeros => psb_s_diag_get_nzeros end type psb_s_diag_prec_type diff --git a/prec/psb_s_nullprec.f90 b/prec/psb_s_nullprec.f90 index fe62bf24..f15a58fa 100644 --- a/prec/psb_s_nullprec.f90 +++ b/prec/psb_s_nullprec.f90 @@ -39,11 +39,11 @@ module psb_s_nullprec procedure, pass(prec) :: s_apply => psb_s_null_apply procedure, pass(prec) :: precbld => psb_s_null_precbld procedure, pass(prec) :: precinit => psb_s_null_precinit - procedure, pass(prec) :: precfree => psb_s_null_precfree procedure, pass(prec) :: precdescr => psb_s_null_precdescr procedure, pass(prec) :: sizeof => psb_s_null_sizeof procedure, pass(prec) :: dump => psb_s_null_dump procedure, pass(prec) :: clone => psb_s_null_clone + procedure, pass(prec) :: free => psb_s_null_precfree end type psb_s_null_prec_type private :: psb_s_null_precbld, psb_s_null_sizeof,& diff --git a/prec/psb_s_prec_type.f90 b/prec/psb_s_prec_type.f90 index 57e32d49..bcbdc1af 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -49,6 +49,7 @@ module psb_s_prec_type & psb_s_apply1_vect, psb_s_apply2_vect procedure, pass(prec) :: sizeof => psb_sprec_sizeof procedure, pass(prec) :: clone => psb_s_prec_clone + procedure, pass(prec) :: free => psb_s_prec_free end type psb_sprec_type interface psb_precfree @@ -171,11 +172,37 @@ contains call psb_erractionsave(err_act) me=-1 + call p%free(info) - if (allocated(p%prec)) then - call p%prec%precfree(info) + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_s_precfree + + subroutine psb_s_prec_free(prec,info) + class(psb_sprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: me, err_act,i + character(len=20) :: name + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name = 'psb_precfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(prec%prec)) then + call prec%prec%free(info) if (info /= psb_success_) goto 9999 - deallocate(p%prec,stat=info) + deallocate(prec%prec,stat=info) if (info /= psb_success_) goto 9999 end if call psb_erractionrestore(err_act) @@ -188,7 +215,7 @@ contains return end if return - end subroutine psb_s_precfree + end subroutine psb_s_prec_free function psb_sprec_sizeof(prec) result(val) class(psb_sprec_type), intent(in) :: prec diff --git a/prec/psb_z_base_prec_mod.f90 b/prec/psb_z_base_prec_mod.f90 index df3c712e..77604691 100644 --- a/prec/psb_z_base_prec_mod.f90 +++ b/prec/psb_z_base_prec_mod.f90 @@ -61,7 +61,7 @@ module psb_z_base_prec_mod procedure(psb_z_base_precbld), pass(prec), deferred :: precbld procedure(psb_z_base_sizeof), pass(prec), deferred :: sizeof procedure(psb_z_base_precinit), pass(prec), deferred :: precinit - procedure(psb_z_base_precfree), pass(prec), deferred :: precfree + procedure(psb_z_base_precfree), pass(prec), deferred :: free procedure(psb_z_base_precdescr), pass(prec), deferred :: precdescr procedure(psb_z_base_precdump), pass(prec), deferred :: dump procedure(psb_z_base_precclone), pass(prec), deferred :: clone diff --git a/prec/psb_z_bjacprec.f90 b/prec/psb_z_bjacprec.f90 index af9cfadf..c7a984f8 100644 --- a/prec/psb_z_bjacprec.f90 +++ b/prec/psb_z_bjacprec.f90 @@ -45,10 +45,10 @@ module psb_z_bjacprec procedure, pass(prec) :: precseti => psb_z_bjac_precseti !!$ procedure, pass(prec) :: precsetr => psb_z_bjac_precsetr !!$ procedure, pass(prec) :: precsetc => psb_z_bjac_precsetc - procedure, pass(prec) :: precfree => psb_z_bjac_precfree procedure, pass(prec) :: precdescr => psb_z_bjac_precdescr procedure, pass(prec) :: dump => psb_z_bjac_dump procedure, pass(prec) :: clone => psb_z_bjac_clone + procedure, pass(prec) :: free => psb_z_bjac_precfree procedure, pass(prec) :: sizeof => psb_z_bjac_sizeof procedure, pass(prec) :: get_nzeros => psb_z_bjac_get_nzeros end type psb_z_bjac_prec_type diff --git a/prec/psb_z_diagprec.f90 b/prec/psb_z_diagprec.f90 index 7b16ec09..409447ac 100644 --- a/prec/psb_z_diagprec.f90 +++ b/prec/psb_z_diagprec.f90 @@ -41,11 +41,11 @@ module psb_z_diagprec procedure, pass(prec) :: z_apply => psb_z_diag_apply procedure, pass(prec) :: precbld => psb_z_diag_precbld procedure, pass(prec) :: precinit => psb_z_diag_precinit - procedure, pass(prec) :: precfree => psb_z_diag_precfree procedure, pass(prec) :: precdescr => psb_z_diag_precdescr procedure, pass(prec) :: sizeof => psb_z_diag_sizeof procedure, pass(prec) :: dump => psb_z_diag_dump procedure, pass(prec) :: clone => psb_z_diag_clone + procedure, pass(prec) :: free => psb_z_diag_precfree procedure, pass(prec) :: get_nzeros => psb_z_diag_get_nzeros end type psb_z_diag_prec_type diff --git a/prec/psb_z_nullprec.f90 b/prec/psb_z_nullprec.f90 index 8036d721..21ffff86 100644 --- a/prec/psb_z_nullprec.f90 +++ b/prec/psb_z_nullprec.f90 @@ -39,11 +39,11 @@ module psb_z_nullprec procedure, pass(prec) :: z_apply => psb_z_null_apply procedure, pass(prec) :: precbld => psb_z_null_precbld procedure, pass(prec) :: precinit => psb_z_null_precinit - procedure, pass(prec) :: precfree => psb_z_null_precfree procedure, pass(prec) :: precdescr => psb_z_null_precdescr procedure, pass(prec) :: sizeof => psb_z_null_sizeof procedure, pass(prec) :: dump => psb_z_null_dump procedure, pass(prec) :: clone => psb_z_null_clone + procedure, pass(prec) :: free => psb_z_null_precfree end type psb_z_null_prec_type private :: psb_z_null_precbld, psb_z_null_sizeof,& diff --git a/prec/psb_z_prec_type.f90 b/prec/psb_z_prec_type.f90 index 430170e6..0f5297f7 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -49,6 +49,7 @@ module psb_z_prec_type & psb_z_apply1_vect, psb_z_apply2_vect procedure, pass(prec) :: sizeof => psb_zprec_sizeof procedure, pass(prec) :: clone => psb_z_prec_clone + procedure, pass(prec) :: free => psb_z_prec_free end type psb_zprec_type interface psb_precfree @@ -171,11 +172,37 @@ contains call psb_erractionsave(err_act) me=-1 + call p%free(info) - if (allocated(p%prec)) then - call p%prec%precfree(info) + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_z_precfree + + subroutine psb_z_prec_free(prec,info) + class(psb_zprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: me, err_act,i + character(len=20) :: name + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name = 'psb_precfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(prec%prec)) then + call prec%prec%free(info) if (info /= psb_success_) goto 9999 - deallocate(p%prec,stat=info) + deallocate(prec%prec,stat=info) if (info /= psb_success_) goto 9999 end if call psb_erractionrestore(err_act) @@ -188,7 +215,7 @@ contains return end if return - end subroutine psb_z_precfree + end subroutine psb_z_prec_free function psb_zprec_sizeof(prec) result(val) class(psb_zprec_type), intent(in) :: prec