From 986ddc631420c23039d443ddbacfc625378aa55b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 8 Apr 2013 15:09:27 +0000 Subject: [PATCH] mld2p4-2: mlprec/mld_c_prec_type.f90 mlprec/mld_d_prec_type.f90 mlprec/mld_s_prec_type.f90 mlprec/mld_z_prec_type.f90 Make free a method of PREC. --- mlprec/mld_c_prec_type.f90 | 41 +++++++++++++++++++++++++++++++------- mlprec/mld_d_prec_type.f90 | 41 +++++++++++++++++++++++++++++++------- mlprec/mld_s_prec_type.f90 | 41 +++++++++++++++++++++++++++++++------- mlprec/mld_z_prec_type.f90 | 41 +++++++++++++++++++++++++++++++------- 4 files changed, 136 insertions(+), 28 deletions(-) diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index 3da86d01..cf188349 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -91,6 +91,7 @@ module mld_c_prec_type procedure, pass(prec) :: psb_c_apply1v => mld_c_apply1v procedure, pass(prec) :: dump => mld_c_dump procedure, pass(prec) :: clone => mld_c_clone + procedure, pass(prec) :: free => mld_c_prec_free procedure, pass(prec) :: get_complexity => mld_c_get_compl procedure, pass(prec) :: cmp_complexity => mld_c_cmp_compl procedure, pass(prec) :: get_nzeros => mld_c_get_nzeros @@ -119,7 +120,7 @@ module mld_c_prec_type ! interface mld_precfree - module procedure mld_cprec_free + module procedure mld_cprecfree end interface @@ -504,7 +505,7 @@ contains ! info - integer, output. ! error code. ! - subroutine mld_cprec_free(p,info) + subroutine mld_cprecfree(p,info) implicit none @@ -523,11 +524,37 @@ contains me=-1 - if (allocated(p%precv)) then - do i=1,size(p%precv) - call p%precv(i)%free(info) + call p%free(info) + + + return + + end subroutine mld_cprecfree + + subroutine mld_c_prec_free(prec,info) + + implicit none + + ! Arguments + class(mld_cprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=psb_success_ + name = 'mld_cprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(prec%precv)) then + do i=1,size(prec%precv) + call prec%precv(i)%free(info) end do - deallocate(p%precv,stat=info) + deallocate(prec%precv,stat=info) end if call psb_erractionrestore(err_act) return @@ -540,7 +567,7 @@ contains end if return - end subroutine mld_cprec_free + end subroutine mld_c_prec_free diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 593e1768..56413155 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -91,6 +91,7 @@ module mld_d_prec_type procedure, pass(prec) :: psb_d_apply1v => mld_d_apply1v procedure, pass(prec) :: dump => mld_d_dump procedure, pass(prec) :: clone => mld_d_clone + procedure, pass(prec) :: free => mld_d_prec_free procedure, pass(prec) :: get_complexity => mld_d_get_compl procedure, pass(prec) :: cmp_complexity => mld_d_cmp_compl procedure, pass(prec) :: get_nzeros => mld_d_get_nzeros @@ -119,7 +120,7 @@ module mld_d_prec_type ! interface mld_precfree - module procedure mld_dprec_free + module procedure mld_dprecfree end interface @@ -504,7 +505,7 @@ contains ! info - integer, output. ! error code. ! - subroutine mld_dprec_free(p,info) + subroutine mld_dprecfree(p,info) implicit none @@ -523,11 +524,37 @@ contains me=-1 - if (allocated(p%precv)) then - do i=1,size(p%precv) - call p%precv(i)%free(info) + call p%free(info) + + + return + + end subroutine mld_dprecfree + + subroutine mld_d_prec_free(prec,info) + + implicit none + + ! Arguments + class(mld_dprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=psb_success_ + name = 'mld_dprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(prec%precv)) then + do i=1,size(prec%precv) + call prec%precv(i)%free(info) end do - deallocate(p%precv,stat=info) + deallocate(prec%precv,stat=info) end if call psb_erractionrestore(err_act) return @@ -540,7 +567,7 @@ contains end if return - end subroutine mld_dprec_free + end subroutine mld_d_prec_free diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 4cf9918b..b8b68fde 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -91,6 +91,7 @@ module mld_s_prec_type procedure, pass(prec) :: psb_s_apply1v => mld_s_apply1v procedure, pass(prec) :: dump => mld_s_dump procedure, pass(prec) :: clone => mld_s_clone + procedure, pass(prec) :: free => mld_s_prec_free procedure, pass(prec) :: get_complexity => mld_s_get_compl procedure, pass(prec) :: cmp_complexity => mld_s_cmp_compl procedure, pass(prec) :: get_nzeros => mld_s_get_nzeros @@ -119,7 +120,7 @@ module mld_s_prec_type ! interface mld_precfree - module procedure mld_sprec_free + module procedure mld_sprecfree end interface @@ -504,7 +505,7 @@ contains ! info - integer, output. ! error code. ! - subroutine mld_sprec_free(p,info) + subroutine mld_sprecfree(p,info) implicit none @@ -523,11 +524,37 @@ contains me=-1 - if (allocated(p%precv)) then - do i=1,size(p%precv) - call p%precv(i)%free(info) + call p%free(info) + + + return + + end subroutine mld_sprecfree + + subroutine mld_s_prec_free(prec,info) + + implicit none + + ! Arguments + class(mld_sprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=psb_success_ + name = 'mld_sprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(prec%precv)) then + do i=1,size(prec%precv) + call prec%precv(i)%free(info) end do - deallocate(p%precv,stat=info) + deallocate(prec%precv,stat=info) end if call psb_erractionrestore(err_act) return @@ -540,7 +567,7 @@ contains end if return - end subroutine mld_sprec_free + end subroutine mld_s_prec_free diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 8641dc93..2c565b3d 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -91,6 +91,7 @@ module mld_z_prec_type procedure, pass(prec) :: psb_z_apply1v => mld_z_apply1v procedure, pass(prec) :: dump => mld_z_dump procedure, pass(prec) :: clone => mld_z_clone + procedure, pass(prec) :: free => mld_z_prec_free procedure, pass(prec) :: get_complexity => mld_z_get_compl procedure, pass(prec) :: cmp_complexity => mld_z_cmp_compl procedure, pass(prec) :: get_nzeros => mld_z_get_nzeros @@ -119,7 +120,7 @@ module mld_z_prec_type ! interface mld_precfree - module procedure mld_zprec_free + module procedure mld_zprecfree end interface @@ -504,7 +505,7 @@ contains ! info - integer, output. ! error code. ! - subroutine mld_zprec_free(p,info) + subroutine mld_zprecfree(p,info) implicit none @@ -523,11 +524,37 @@ contains me=-1 - if (allocated(p%precv)) then - do i=1,size(p%precv) - call p%precv(i)%free(info) + call p%free(info) + + + return + + end subroutine mld_zprecfree + + subroutine mld_z_prec_free(prec,info) + + implicit none + + ! Arguments + class(mld_zprec_type), intent(inout) :: prec + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: me,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=psb_success_ + name = 'mld_zprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(prec%precv)) then + do i=1,size(prec%precv) + call prec%precv(i)%free(info) end do - deallocate(p%precv,stat=info) + deallocate(prec%precv,stat=info) end if call psb_erractionrestore(err_act) return @@ -540,7 +567,7 @@ contains end if return - end subroutine mld_zprec_free + end subroutine mld_z_prec_free