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.
stopcriterion
Salvatore Filippone 13 years ago
parent 9c4259c3d4
commit aab68f2bf3

@ -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)

@ -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)) &

@ -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)

@ -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)) &

@ -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)

@ -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)) &

@ -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)

@ -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)) &

Loading…
Cancel
Save