NCEPLIBS-g2  3.5.0
realloc.F90
Go to the documentation of this file.
1 
4 
12 module re_alloc
13 
14  interface realloc
15  module procedure realloc_c1
16  module procedure realloc_r
17  module procedure realloc_i
18  end interface realloc
19 
20 contains
21 
36  subroutine realloc_c1(c,n,m,istat)
37  character(len=1),pointer,dimension(:) :: c
38  integer,intent(in) :: n,m
39  integer,intent(out) :: istat
40  integer :: num
41  character(len=1),pointer,dimension(:) :: tmp
42 
43  istat=0
44  if ( (n<0) .OR. (m<=0) ) then
45  istat=10
46  return
47  endif
48 
49  if ( .not. associated(c) ) then
50  allocate(c(m),stat=istat) ! allocate new memory
51  return
52  endif
53 
54  tmp=>c ! save pointer to original mem
55  nullify(c)
56  allocate(c(m),stat=istat) ! allocate new memory
57  if ( istat /= 0 ) then
58  c=>tmp
59  return
60  endif
61  if ( n /= 0 ) then
62  num=min(n,m)
63  c(1:num)=tmp(1:num) ! copy data from orig mem to new loc.
64  endif
65  deallocate(tmp) ! deallocate original memory
66  return
67  end subroutine realloc_c1
68 
83  subroutine realloc_r(c,n,m,istat)
84  real,pointer,dimension(:) :: c
85  integer,intent(in) :: n,m
86  integer,intent(out) :: istat
87  integer :: num
88  real,pointer,dimension(:) :: tmp
89 
90  istat=0
91  if ( (n<0) .OR. (m<=0) ) then
92  istat=10
93  return
94  endif
95 
96  if ( .not. associated(c) ) then
97  allocate(c(m),stat=istat) ! allocate new memory
98  return
99  endif
100 
101  tmp=>c ! save pointer to original mem
102  nullify(c)
103  allocate(c(m),stat=istat) ! allocate new memory
104  if ( istat /= 0 ) then
105  c=>tmp
106  return
107  endif
108  if ( n /= 0 ) then
109  num=min(n,m)
110  c(1:num)=tmp(1:num) ! copy data from orig mem to new loc.
111  endif
112  deallocate(tmp) ! deallocate original memory
113  return
114  end subroutine realloc_r
115 
124 
125  subroutine realloc_i(c,n,m,istat)
126  integer,pointer,dimension(:) :: c
127  integer,intent(in) :: n,m
128  integer,intent(out) :: istat
129  integer :: num
130  integer,pointer,dimension(:) :: tmp
131 
132  istat=0
133  if ( (n<0) .OR. (m<=0) ) then
134  istat=10
135  return
136  endif
137 
138  if ( .not. associated(c) ) then
139  allocate(c(m),stat=istat) ! allocate new memory
140  return
141  endif
142 
143  tmp=>c ! save pointer to original mem
144  nullify(c)
145  allocate(c(m),stat=istat) ! allocate new memory
146  if ( istat /= 0 ) then
147  c=>tmp
148  return
149  endif
150  if ( n /= 0 ) then
151  num=min(n,m)
152  c(1:num)=tmp(1:num) ! copy data from orig mem to new loc.
153  endif
154  deallocate(tmp) ! deallocate original memory
155  return
156  end subroutine realloc_i
157 
158 end module re_alloc
re_alloc::realloc
Definition: realloc.F90:14
re_alloc
Reallocate memory, preserving contents.
Definition: realloc.F90:12
re_alloc::realloc_r
subroutine realloc_r(c, n, m, istat)
This subroutine reallocates an integer array, preserving its contents.
Definition: realloc.F90:84
re_alloc::realloc_c1
subroutine realloc_c1(c, n, m, istat)
This subroutine reallocates a character array, preserving its contents.
Definition: realloc.F90:37
re_alloc::realloc_i
subroutine realloc_i(c, n, m, istat)
This subroutine reorganize integer type data in memory into one one dimensional array.
Definition: realloc.F90:126