Get rid of duplicate reallocation code.

ILmat
Salvatore Filippone 8 years ago
parent 0c4a5c9716
commit 1bbb8b424c

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

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

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

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

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

Loading…
Cancel
Save