From aab68f2bf3d70ca35e85b18e1c0a2bf9eade9fef Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 30 Apr 2012 10:18:31 +0000 Subject: [PATCH] mld2p4-NewNL: mlprec/impl/mld_c_base_smoother_impl.f90 mlprec/impl/mld_c_onelev_impl.f90 mlprec/impl/mld_d_base_smoother_impl.f90 mlprec/impl/mld_d_onelev_impl.f90 mlprec/impl/mld_s_base_smoother_impl.f90 mlprec/impl/mld_s_onelev_impl.f90 mlprec/impl/mld_z_base_smoother_impl.f90 mlprec/impl/mld_z_onelev_impl.f90 Fix recursive deallocate calls. --- mlprec/impl/mld_c_base_smoother_impl.f90 | 2 +- mlprec/impl/mld_c_onelev_impl.f90 | 3 ++- mlprec/impl/mld_d_base_smoother_impl.f90 | 2 +- mlprec/impl/mld_d_onelev_impl.f90 | 3 ++- mlprec/impl/mld_s_base_smoother_impl.f90 | 2 +- mlprec/impl/mld_s_onelev_impl.f90 | 3 ++- mlprec/impl/mld_z_base_smoother_impl.f90 | 2 +- mlprec/impl/mld_z_onelev_impl.f90 | 3 ++- 8 files changed, 12 insertions(+), 8 deletions(-) diff --git a/mlprec/impl/mld_c_base_smoother_impl.f90 b/mlprec/impl/mld_c_base_smoother_impl.f90 index af9ecdb6..2e6c886e 100644 --- a/mlprec/impl/mld_c_base_smoother_impl.f90 +++ b/mlprec/impl/mld_c_base_smoother_impl.f90 @@ -355,8 +355,8 @@ subroutine mld_c_base_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) + if (info == psb_success_) deallocate(sm%sv,stat=info) end if - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/mlprec/impl/mld_c_onelev_impl.f90 b/mlprec/impl/mld_c_onelev_impl.f90 index d3be182f..e5faa843 100644 --- a/mlprec/impl/mld_c_onelev_impl.f90 +++ b/mlprec/impl/mld_c_onelev_impl.f90 @@ -150,7 +150,8 @@ subroutine mld_c_base_onelev_free(lv,info) ! that there may be inner objects containing C pointers, ! e.g. UMFPACK, SLU or CUDA stuff. ! We really need FINALs. - call lv%sm%free(info) + if (allocated(lv%sm)) & + & call lv%sm%free(info) call lv%ac%free() if (psb_is_ok_desc(lv%desc_ac)) & diff --git a/mlprec/impl/mld_d_base_smoother_impl.f90 b/mlprec/impl/mld_d_base_smoother_impl.f90 index ea293a6a..2e8dc53f 100644 --- a/mlprec/impl/mld_d_base_smoother_impl.f90 +++ b/mlprec/impl/mld_d_base_smoother_impl.f90 @@ -355,8 +355,8 @@ subroutine mld_d_base_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) + if (info == psb_success_) deallocate(sm%sv,stat=info) end if - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/mlprec/impl/mld_d_onelev_impl.f90 b/mlprec/impl/mld_d_onelev_impl.f90 index 976545f1..46d0ccab 100644 --- a/mlprec/impl/mld_d_onelev_impl.f90 +++ b/mlprec/impl/mld_d_onelev_impl.f90 @@ -150,7 +150,8 @@ subroutine mld_d_base_onelev_free(lv,info) ! that there may be inner objects containing C pointers, ! e.g. UMFPACK, SLU or CUDA stuff. ! We really need FINALs. - call lv%sm%free(info) + if (allocated(lv%sm)) & + & call lv%sm%free(info) call lv%ac%free() if (psb_is_ok_desc(lv%desc_ac)) & diff --git a/mlprec/impl/mld_s_base_smoother_impl.f90 b/mlprec/impl/mld_s_base_smoother_impl.f90 index fad7365c..0807a8e0 100644 --- a/mlprec/impl/mld_s_base_smoother_impl.f90 +++ b/mlprec/impl/mld_s_base_smoother_impl.f90 @@ -355,8 +355,8 @@ subroutine mld_s_base_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) + if (info == psb_success_) deallocate(sm%sv,stat=info) end if - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/mlprec/impl/mld_s_onelev_impl.f90 b/mlprec/impl/mld_s_onelev_impl.f90 index fb7538af..18cc7154 100644 --- a/mlprec/impl/mld_s_onelev_impl.f90 +++ b/mlprec/impl/mld_s_onelev_impl.f90 @@ -150,7 +150,8 @@ subroutine mld_s_base_onelev_free(lv,info) ! that there may be inner objects containing C pointers, ! e.g. UMFPACK, SLU or CUDA stuff. ! We really need FINALs. - call lv%sm%free(info) + if (allocated(lv%sm)) & + & call lv%sm%free(info) call lv%ac%free() if (psb_is_ok_desc(lv%desc_ac)) & diff --git a/mlprec/impl/mld_z_base_smoother_impl.f90 b/mlprec/impl/mld_z_base_smoother_impl.f90 index fc196730..5bba7df8 100644 --- a/mlprec/impl/mld_z_base_smoother_impl.f90 +++ b/mlprec/impl/mld_z_base_smoother_impl.f90 @@ -355,8 +355,8 @@ subroutine mld_z_base_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) + if (info == psb_success_) deallocate(sm%sv,stat=info) end if - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/mlprec/impl/mld_z_onelev_impl.f90 b/mlprec/impl/mld_z_onelev_impl.f90 index 5825871b..1bdc04de 100644 --- a/mlprec/impl/mld_z_onelev_impl.f90 +++ b/mlprec/impl/mld_z_onelev_impl.f90 @@ -150,7 +150,8 @@ subroutine mld_z_base_onelev_free(lv,info) ! that there may be inner objects containing C pointers, ! e.g. UMFPACK, SLU or CUDA stuff. ! We really need FINALs. - call lv%sm%free(info) + if (allocated(lv%sm)) & + & call lv%sm%free(info) call lv%ac%free() if (psb_is_ok_desc(lv%desc_ac)) &