mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-18 11:52:11 +00:00
psblas3:
prec/impl/psb_cprecinit.f90 prec/impl/psb_dprecinit.f90 prec/impl/psb_sprecinit.f90 prec/impl/psb_zprecinit.f90 prec/psb_c_base_prec_mod.f90 prec/psb_c_bjacprec.f90 prec/psb_c_diagprec.f90 prec/psb_c_nullprec.f90 prec/psb_c_prec_type.f90 prec/psb_d_base_prec_mod.f90 prec/psb_d_bjacprec.f90 prec/psb_d_diagprec.f90 prec/psb_d_nullprec.f90 prec/psb_d_prec_type.f90 prec/psb_s_base_prec_mod.f90 prec/psb_s_bjacprec.f90 prec/psb_s_diagprec.f90 prec/psb_s_nullprec.f90 prec/psb_s_prec_type.f90 prec/psb_z_base_prec_mod.f90 prec/psb_z_bjacprec.f90 prec/psb_z_diagprec.f90 prec/psb_z_nullprec.f90 prec/psb_z_prec_type.f90 Make free a method of PREC.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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,&
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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,&
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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,&
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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,&
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user