NCEPLIBS-g2 4.0.0
Loading...
Searching...
No Matches
realloc.F90
Go to the documentation of this file.
1
4
13
14 interface realloc
15 module procedure realloc_c1
16 module procedure realloc_r
17 module procedure realloc_i
18 end interface realloc
19
20contains
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
158end module re_alloc
Reallocate memory, preserving contents.
Definition realloc.F90:12
subroutine realloc_r(c, n, m, istat)
This subroutine reallocates an integer array, preserving its contents.
Definition realloc.F90:84
subroutine realloc_c1(c, n, m, istat)
This subroutine reallocates a character array, preserving its contents.
Definition realloc.F90:37
subroutine realloc_i(c, n, m, istat)
This subroutine reorganize integer type data in memory into one one dimensional array.
Definition realloc.F90:126