source: lmdz_wrf/WRFV3/external/io_grib2/g2lib/realloc.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 3.8 KB
Line 
1      module re_alloc
2
3      interface realloc
4         module procedure realloc_c1
5         module procedure realloc_r
6         module procedure realloc_i
7!!         subroutine realloc_c1(c,n,m,istat)
8!!            character(len=1),pointer,dimension(:) :: c
9!!            integer :: n,m
10!!            integer :: istat
11!!         end subroutine
12!!         subroutine realloc_r(c,n,m,istat)
13!!            real,pointer,dimension(:) :: c
14!!            integer :: n,m
15!!            integer :: istat
16!!         end subroutine
17!!         subroutine realloc_i(c,n,m,istat)
18!!            integer,pointer,dimension(:) :: c
19!!            integer :: n,m
20!!            integer :: istat
21!!         end subroutine
22      end interface
23
24      contains
25
26         subroutine realloc_c1(c,n,m,istat)
27            character(len=1),pointer,dimension(:) :: c
28            integer,intent(in) :: n,m
29            integer,intent(out) :: istat
30            integer :: num
31            character(len=1),pointer,dimension(:) :: tmp
32
33            istat=0
34            if ( (n<0) .OR. (m<=0) ) then
35               istat=10
36               return
37            endif
38 
39            if ( .not. associated(c) ) then
40               allocate(c(m),stat=istat)   ! allocate new memory
41               return
42            endif
43
44            tmp=>c                      ! save pointer to original mem
45            nullify(c)
46            allocate(c(m),stat=istat)   ! allocate new memory
47            if ( istat /= 0 ) then
48               c=>tmp
49               return
50            endif
51            if ( n /= 0 ) then
52               num=min(n,m)
53               c(1:num)=tmp(1:num)      ! copy data from orig mem to new loc.
54            endif
55            deallocate(tmp)             ! deallocate original memory
56            return
57         end subroutine
58
59         subroutine realloc_r(c,n,m,istat)
60            real,pointer,dimension(:) :: c
61            integer,intent(in) :: n,m
62            integer,intent(out) :: istat
63            integer :: num
64            real,pointer,dimension(:) :: tmp
65
66            istat=0
67            if ( (n<0) .OR. (m<=0) ) then
68               istat=10
69               return
70            endif
71 
72            if ( .not. associated(c) ) then
73               allocate(c(m),stat=istat)   ! allocate new memory
74               return
75            endif
76
77            tmp=>c                      ! save pointer to original mem
78            nullify(c)
79            allocate(c(m),stat=istat)   ! allocate new memory
80            if ( istat /= 0 ) then
81               c=>tmp
82               return
83            endif
84            if ( n /= 0 ) then
85               num=min(n,m)
86               c(1:num)=tmp(1:num)      ! copy data from orig mem to new loc.
87            endif
88            deallocate(tmp)             ! deallocate original memory
89            return
90         end subroutine
91
92         subroutine realloc_i(c,n,m,istat)
93            integer,pointer,dimension(:) :: c
94            integer,intent(in) :: n,m
95            integer,intent(out) :: istat
96            integer :: num
97            integer,pointer,dimension(:) :: tmp
98
99            istat=0
100            if ( (n<0) .OR. (m<=0) ) then
101               istat=10
102               return
103            endif
104 
105            if ( .not. associated(c) ) then
106               allocate(c(m),stat=istat)   ! allocate new memory
107               return
108            endif
109
110            tmp=>c                      ! save pointer to original mem
111            nullify(c)
112            allocate(c(m),stat=istat)   ! allocate new memory
113            if ( istat /= 0 ) then
114               c=>tmp
115               return
116            endif
117            if ( n /= 0 ) then
118               num=min(n,m)
119               c(1:num)=tmp(1:num)      ! copy data from orig mem to new loc.
120            endif
121            deallocate(tmp)             ! deallocate original memory
122            return
123         end subroutine
124
125      end module re_alloc
Note: See TracBrowser for help on using the repository browser.