module re_alloc 5,3
interface realloc 5 module procedure realloc_c1
module procedure realloc_r
module procedure realloc_i
!! subroutine realloc_c1(c,n,m,istat) !! character(len=1),pointer,dimension(:) :: c !! integer :: n,m !! integer :: istat !! end subroutine !! subroutine realloc_r(c,n,m,istat) !! real,pointer,dimension(:) :: c !! integer :: n,m !! integer :: istat !! end subroutine !! subroutine realloc_i(c,n,m,istat) !! integer,pointer,dimension(:) :: c !! integer :: n,m !! integer :: istat !! end subroutine end interface contains
subroutine realloc_c1(c,n,m,istat) 1 character(len=1),pointer,dimension(:) :: c integer,intent(in) :: n,m integer,intent(out) :: istat integer :: num character(len=1),pointer,dimension(:) :: tmp istat=0 if ( (n<0) .OR. (m<=0) ) then istat=10 return endif if ( .not. associated(c) ) then allocate(c(m),stat=istat) ! allocate new memory return endif tmp=>c ! save pointer to original mem nullify(c) allocate(c(m),stat=istat) ! allocate new memory if ( istat /= 0 ) then c=>tmp return endif if ( n /= 0 ) then num=min(n,m) c(1:num)=tmp(1:num) ! copy data from orig mem to new loc. endif deallocate(tmp) ! deallocate original memory return end subroutine
subroutine realloc_r(c,n,m,istat) 1 real,pointer,dimension(:) :: c integer,intent(in) :: n,m integer,intent(out) :: istat integer :: num real,pointer,dimension(:) :: tmp istat=0 if ( (n<0) .OR. (m<=0) ) then istat=10 return endif if ( .not. associated(c) ) then allocate(c(m),stat=istat) ! allocate new memory return endif tmp=>c ! save pointer to original mem nullify(c) allocate(c(m),stat=istat) ! allocate new memory if ( istat /= 0 ) then c=>tmp return endif if ( n /= 0 ) then num=min(n,m) c(1:num)=tmp(1:num) ! copy data from orig mem to new loc. endif deallocate(tmp) ! deallocate original memory return end subroutine
subroutine realloc_i(c,n,m,istat) 1 integer,pointer,dimension(:) :: c integer,intent(in) :: n,m integer,intent(out) :: istat integer :: num integer,pointer,dimension(:) :: tmp istat=0 if ( (n<0) .OR. (m<=0) ) then istat=10 return endif if ( .not. associated(c) ) then allocate(c(m),stat=istat) ! allocate new memory return endif tmp=>c ! save pointer to original mem nullify(c) allocate(c(m),stat=istat) ! allocate new memory if ( istat /= 0 ) then c=>tmp return endif if ( n /= 0 ) then num=min(n,m) c(1:num)=tmp(1:num) ! copy data from orig mem to new loc. endif deallocate(tmp) ! deallocate original memory return end subroutine end module re_alloc