From 1bbb8b424c5b85d8dd8d2aec0b6c8890a31ab15a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 3 Mar 2018 10:59:22 +0000 Subject: [PATCH] Get rid of duplicate reallocation code. --- base/modules/psb_realloc_mod.F90 | 182 +--------------------------- base/serial/impl/psb_c_coo_impl.f90 | 4 +- base/serial/impl/psb_d_coo_impl.f90 | 4 +- base/serial/impl/psb_s_coo_impl.f90 | 4 +- base/serial/impl/psb_z_coo_impl.f90 | 4 +- 5 files changed, 15 insertions(+), 183 deletions(-) diff --git a/base/modules/psb_realloc_mod.F90 b/base/modules/psb_realloc_mod.F90 index 7aa5c177..fba5fd0d 100644 --- a/base/modules/psb_realloc_mod.F90 +++ b/base/modules/psb_realloc_mod.F90 @@ -39,19 +39,11 @@ module psb_realloc_mod use psb_z_realloc_mod implicit none - + ! - ! psb_realloc will reallocate the input array to have exactly - ! the size specified, possibly shortening it. + ! Does it make sense to do maloc/frees in inner loops? + ! In normal CPU environments yes, on GPUS no. ! - Interface psb_realloc - module procedure psb_reallocate2i1d - module procedure psb_reallocate2i1s - module procedure psb_reallocate2i1z - module procedure psb_reallocate2i1c - end Interface psb_realloc - - logical, private :: do_maybe_free_buffer = .true. Contains @@ -67,172 +59,4 @@ Contains end subroutine psb_set_maybe_free_buffer - - Subroutine psb_reallocate2i1s(len,rrax,y,z,info) - use psb_error_mod - ! ...Subroutine Arguments - integer(psb_ipk_),Intent(in) :: len - integer(psb_ipk_),allocatable, intent(inout) :: rrax(:),y(:) - Real(psb_spk_),allocatable, intent(inout) :: z(:) - integer(psb_ipk_) :: info - character(len=20) :: name - integer(psb_ipk_) :: err_act, err - logical, parameter :: debug=.false. - - name='psb_reallocate2i1s' - call psb_erractionsave(err_act) - - - info=psb_success_ - call psb_realloc(len,rrax,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_realloc(len,y,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_realloc(len,z,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - End Subroutine psb_reallocate2i1s - - - Subroutine psb_reallocate2i1d(len,rrax,y,z,info) - use psb_error_mod - ! ...Subroutine Arguments - integer(psb_ipk_),Intent(in) :: len - integer(psb_ipk_),allocatable, intent(inout) :: rrax(:),y(:) - Real(psb_dpk_),allocatable, intent(inout) :: z(:) - integer(psb_ipk_) :: info - character(len=20) :: name - integer(psb_ipk_) :: err_act, err - - name='psb_reallocate2i1d' - call psb_erractionsave(err_act) - - info=psb_success_ - - call psb_realloc(len,rrax,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_realloc(len,y,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_realloc(len,z,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - End Subroutine psb_reallocate2i1d - - - - Subroutine psb_reallocate2i1c(len,rrax,y,z,info) - use psb_error_mod - ! ...Subroutine Arguments - integer(psb_ipk_),Intent(in) :: len - integer(psb_ipk_),allocatable, intent(inout) :: rrax(:),y(:) - complex(psb_spk_),allocatable, intent(inout) :: z(:) - integer(psb_ipk_) :: info - character(len=20) :: name - integer(psb_ipk_) :: err_act, err - - name='psb_reallocate2i1c' - call psb_erractionsave(err_act) - - - info=psb_success_ - call psb_realloc(len,rrax,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_realloc(len,y,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_realloc(len,z,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - End Subroutine psb_reallocate2i1c - - Subroutine psb_reallocate2i1z(len,rrax,y,z,info) - use psb_error_mod - ! ...Subroutine Arguments - integer(psb_ipk_),Intent(in) :: len - integer(psb_ipk_),allocatable, intent(inout) :: rrax(:),y(:) - complex(psb_dpk_),allocatable, intent(inout) :: z(:) - integer(psb_ipk_) :: info - character(len=20) :: name - integer(psb_ipk_) :: err_act, err - - name='psb_reallocate2i1z' - call psb_erractionsave(err_act) - - info=psb_success_ - call psb_realloc(len,rrax,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_realloc(len,y,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_realloc(len,z,info) - if (info /= psb_success_) then - err=4000 - call psb_errpush(err,name) - goto 9999 - end if - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - End Subroutine psb_reallocate2i1z - end module psb_realloc_mod diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index f2c8af8b..4dc71ecf 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -201,7 +201,9 @@ subroutine psb_c_coo_reallocate_nz(nz,a) call psb_erractionsave(err_act) nz_ = max(nz,ione) - call psb_realloc(nz_,a%ia,a%ja,a%val,info) + call psb_realloc(nz_,a%ia,info) + if (info == psb_success_) call psb_realloc(nz_,a%ja,info) + if (info == psb_success_) call psb_realloc(nz_,a%val,info) if (info /= psb_success_) then call psb_errpush(psb_err_alloc_dealloc_,name) diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 4e4c665c..1d9edb77 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -201,7 +201,9 @@ subroutine psb_d_coo_reallocate_nz(nz,a) call psb_erractionsave(err_act) nz_ = max(nz,ione) - call psb_realloc(nz_,a%ia,a%ja,a%val,info) + call psb_realloc(nz_,a%ia,info) + if (info == psb_success_) call psb_realloc(nz_,a%ja,info) + if (info == psb_success_) call psb_realloc(nz_,a%val,info) if (info /= psb_success_) then call psb_errpush(psb_err_alloc_dealloc_,name) diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 1a45e3ea..6eb29be8 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -201,7 +201,9 @@ subroutine psb_s_coo_reallocate_nz(nz,a) call psb_erractionsave(err_act) nz_ = max(nz,ione) - call psb_realloc(nz_,a%ia,a%ja,a%val,info) + call psb_realloc(nz_,a%ia,info) + if (info == psb_success_) call psb_realloc(nz_,a%ja,info) + if (info == psb_success_) call psb_realloc(nz_,a%val,info) if (info /= psb_success_) then call psb_errpush(psb_err_alloc_dealloc_,name) diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index 467ea950..570627a9 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -201,7 +201,9 @@ subroutine psb_z_coo_reallocate_nz(nz,a) call psb_erractionsave(err_act) nz_ = max(nz,ione) - call psb_realloc(nz_,a%ia,a%ja,a%val,info) + call psb_realloc(nz_,a%ia,info) + if (info == psb_success_) call psb_realloc(nz_,a%ja,info) + if (info == psb_success_) call psb_realloc(nz_,a%val,info) if (info /= psb_success_) then call psb_errpush(psb_err_alloc_dealloc_,name)