/[MITgcm]/MITgcm/tools/OAD_support/OAD_tape.F90
ViewVC logotype

Contents of /MITgcm/tools/OAD_support/OAD_tape.F90

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download)
Thu Jan 16 15:15:23 2014 UTC (5 years, 9 months ago) by utke
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint65, HEAD
Changes since 1.2: +25 -11 lines
resync with OAD

1 module OAD_tape
2
3 implicit none
4
5 private :: increment , dtt, itt, ltt, stt, &
6 init, dump_tapestats, &
7 dt_grow, it_grow, lt_grow, st_grow, &
8 push_d0, push_i0, push_d1, push_i1, &
9 pop_d0, pop_i0, pop_d1, pop_i1, &
10 push_d4, push_d6, &
11 pop_d4, pop_d6
12
13 public :: &
14 oad_dt, oad_dt_ptr, oad_dt_sz, oad_dt_grow, &
15 oad_it, oad_it_ptr, oad_it_sz, oad_it_grow, &
16 oad_lt, oad_lt_ptr, oad_lt_sz, oad_lt_grow, &
17 oad_st, oad_st_ptr, oad_st_sz, oad_st_grow, &
18 oad_chunk_size, &
19 oad_tape_init, &
20 oad_dump_tapestats, &
21 oad_tape_push, oad_tape_pop
22
23 double precision, dimension(:), allocatable :: oad_dt, dtt
24 integer, dimension(:), allocatable :: oad_it, itt
25 logical, dimension(:), allocatable :: oad_lt, ltt
26 character(80), dimension(:), allocatable :: oad_st, stt
27 integer :: oad_dt_ptr=0, oad_it_ptr=0
28 integer :: oad_dt_sz=0, oad_it_sz=0
29 integer :: oad_lt_ptr=0, oad_st_ptr=0
30 integer :: oad_lt_sz=0, oad_st_sz=0
31 integer :: increment
32 integer :: oad_chunk_size
33
34 interface oad_tape_init
35 module procedure init
36 end interface
37
38 interface oad_dump_tapestats
39 module procedure dump_tapestats
40 end interface
41
42 interface oad_dt_grow
43 module procedure dt_grow
44 end interface
45
46 interface oad_it_grow
47 module procedure it_grow
48 end interface
49
50 interface oad_lt_grow
51 module procedure lt_grow
52 end interface
53
54 interface oad_st_grow
55 module procedure st_grow
56 end interface
57
58 interface oad_tape_push
59 module procedure push_d0, push_i0
60 module procedure push_d1, push_i1
61 module procedure push_d4, push_d6
62 end interface
63
64 interface oad_tape_pop
65 module procedure pop_d0, pop_i0
66 module procedure pop_d1, pop_i1
67 module procedure pop_d4, pop_d6
68 end interface
69
70 contains
71
72 subroutine init
73 integer :: initialSize=1048576
74 increment=16777216
75 ! DT
76 oad_dt_ptr=1
77 if (allocated(oad_dt)) then
78 deallocate(oad_dt)
79 end if
80 oad_dt_sz=initialSize
81 allocate(oad_dt(oad_dt_sz))
82 ! IT
83 oad_it_ptr=1
84 if (allocated(oad_it)) then
85 deallocate(oad_it)
86 end if
87 oad_it_sz=initialSize
88 allocate(oad_it(oad_it_sz))
89 ! LT
90 oad_lt_ptr=1
91 if (allocated(oad_lt)) then
92 deallocate(oad_lt)
93 end if
94 oad_lt_sz=initialSize
95 allocate(oad_lt(oad_lt_sz))
96 ! ST
97 oad_st_ptr=1
98 if (allocated(oad_st)) then
99 deallocate(oad_st)
100 end if
101 oad_st_sz=initialSize
102 allocate(oad_st(oad_st_sz))
103 end subroutine init
104
105 subroutine dump_tapestats()
106 write(*,'(3(A,I9))',ADVANCE='NO') &
107 ' TD:',oad_dt_ptr,' TI:',oad_it_ptr, ' TS:',oad_st_ptr
108 end subroutine dump_tapestats
109
110 subroutine dt_grow
111 integer status
112 print *, "OAD: DT+ ", oad_dt_sz
113 allocate(dtt(oad_dt_sz),STAT=status)
114 if (status .gt. 0 ) then
115 print *,'OAD: allocation (1)failed with', status
116 stop
117 end if
118 dtt=oad_dt
119 deallocate(oad_dt)
120 allocate(oad_dt(oad_dt_sz+increment),STAT=status)
121 if (status .gt. 0 ) then
122 print *,'OAD: allocation (2)failed with', status
123 stop
124 end if
125 oad_dt(1:oad_dt_sz) = dtt
126 deallocate(dtt)
127 oad_dt_sz=oad_dt_sz+increment
128 end subroutine dt_grow
129
130 subroutine it_grow
131 integer status
132 print *, "OAD: IT+ ", oad_it_sz
133 allocate(itt(oad_it_sz),STAT=status)
134 if (status .gt. 0 ) then
135 print *,'OAD: allocation (1)failed with', status
136 stop
137 end if
138 itt=oad_it
139 deallocate(oad_it)
140 allocate(oad_it(oad_it_sz+increment),STAT=status)
141 if (status .gt. 0 ) then
142 print *,'OAD: allocation (2)failed with', status
143 stop
144 end if
145 oad_it(1:oad_it_sz) = itt
146 deallocate(itt)
147 oad_it_sz=oad_it_sz+increment
148 end subroutine it_grow
149
150 subroutine lt_grow
151 integer status
152 print *, "OAD: LT+ ", oad_lt_sz
153 allocate(ltt(oad_lt_sz),STAT=status)
154 if (status .gt. 0 ) then
155 print *,'OAD: allocation (1)failed wlth', status
156 stop
157 end if
158 ltt=oad_lt
159 deallocate(oad_lt)
160 allocate(oad_lt(oad_lt_sz+increment),STAT=status)
161 if (status .gt. 0 ) then
162 print *,'OAD: allocation (2)failed wlth', status
163 stop
164 end if
165 oad_lt(1:oad_lt_sz) = ltt
166 deallocate(ltt)
167 oad_lt_sz=oad_lt_sz+increment
168 end subroutine lt_grow
169
170 subroutine st_grow
171 integer status
172 print *, "OAD: ST+ ", oad_st_sz
173 allocate(stt(oad_st_sz),STAT=status)
174 if (status .gt. 0 ) then
175 print *,'OAD: allocation (1)failed wsth', status
176 stop
177 end if
178 stt=oad_st
179 deallocate(oad_st)
180 allocate(oad_st(oad_st_sz+increment),STAT=status)
181 if (status .gt. 0 ) then
182 print *,'OAD: allocation (2)failed wsth', status
183 stop
184 end if
185 oad_st(1:oad_st_sz) = stt
186 deallocate(stt)
187 oad_st_sz=oad_st_sz+increment
188 end subroutine st_grow
189
190 subroutine push_d0(v)
191 implicit none
192 double precision :: v
193 if(oad_dt_sz .lt. oad_dt_ptr+1) call oad_dt_grow()
194 oad_dt(oad_dt_ptr)=v; oad_dt_ptr=oad_dt_ptr+1
195 end subroutine push_d0
196
197 subroutine push_i0(v)
198 implicit none
199 integer :: v
200 if(oad_it_sz .lt. oad_it_ptr+1) call oad_it_grow()
201 oad_it(oad_it_ptr)=v; oad_it_ptr=oad_it_ptr+1
202 end subroutine push_i0
203
204 subroutine push_d1(v)
205 implicit none
206 double precision :: v(:)
207 integer :: chunk
208 chunk=size(v,1)
209 if(oad_dt_sz .lt. oad_dt_ptr+chunk) call oad_dt_grow()
210 oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1)=v; oad_dt_ptr=oad_dt_ptr+chunk
211 end subroutine push_d1
212
213 subroutine push_i1(v)
214 implicit none
215 integer :: v(:)
216 integer :: chunk
217 chunk=size(v,1)
218 if(oad_it_sz .lt. oad_it_ptr+chunk) call oad_it_grow()
219 oad_it(oad_it_ptr:oad_it_ptr+chunk-1)=v; oad_it_ptr=oad_it_ptr+chunk
220 end subroutine push_i1
221
222 subroutine push_d4(v)
223 implicit none
224 double precision :: v(:,:,:,:)
225 integer :: chunk(1), dims(4)
226 dims=shape(v)
227 chunk(1)=dims(1)*dims(2)*dims(3)*dims(4)
228 do while (oad_dt_sz .lt. oad_dt_ptr+chunk(1))
229 call oad_dt_grow()
230 end do
231 oad_dt(oad_dt_ptr:oad_dt_ptr+chunk(1)-1)=reshape(v,chunk)
232 oad_dt_ptr=oad_dt_ptr+chunk(1)
233 end subroutine push_d4
234
235 subroutine push_d6(v)
236 implicit none
237 double precision :: v(:,:,:,:,:,:)
238 integer :: chunk(1), dims(6)
239 dims=shape(v)
240 chunk(1)=dims(1)*dims(2)*dims(3)*dims(4)*dims(5)*dims(6)
241 do while (oad_dt_sz .lt. oad_dt_ptr+chunk(1))
242 call oad_dt_grow()
243 end do
244 oad_dt(oad_dt_ptr:oad_dt_ptr+chunk(1)-1)=reshape(v,chunk)
245 oad_dt_ptr=oad_dt_ptr+chunk(1)
246 end subroutine push_d6
247
248 subroutine pop_d0(v)
249 implicit none
250 double precision :: v
251 oad_dt_ptr=oad_dt_ptr-1
252 v=oad_dt(oad_dt_ptr)
253 end subroutine pop_d0
254
255 subroutine pop_i0(v)
256 implicit none
257 integer :: v
258 oad_it_ptr=oad_it_ptr-1
259 v=oad_it(oad_it_ptr)
260 end subroutine pop_i0
261
262 subroutine pop_d1(v)
263 implicit none
264 double precision :: v(:)
265 integer :: chunk
266 chunk=size(v,1)
267 oad_dt_ptr=oad_dt_ptr-chunk
268 v=oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1)
269 end subroutine pop_d1
270
271 subroutine pop_i1(v)
272 implicit none
273 integer :: v(:)
274 integer :: chunk
275 chunk=size(v,1)
276 oad_it_ptr=oad_it_ptr-chunk
277 v=oad_it(oad_it_ptr:oad_it_ptr+chunk-1)
278 end subroutine pop_i1
279
280 subroutine pop_d4(v)
281 implicit none
282 double precision :: v(:,:,:,:)
283 integer :: chunk, dims(4)
284 dims=shape(v)
285 chunk=dims(1)*dims(2)*dims(3)*dims(4)
286 oad_dt_ptr=oad_dt_ptr-chunk
287 v=reshape(oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1),dims)
288 end subroutine pop_d4
289
290 subroutine pop_d6(v)
291 implicit none
292 double precision :: v(:,:,:,:,:,:)
293 integer :: chunk, dims(6)
294 dims=shape(v)
295 chunk=dims(1)*dims(2)*dims(3)*dims(4)*dims(5)*dims(6)
296 oad_dt_ptr=oad_dt_ptr-chunk
297 v=reshape(oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1),dims)
298 end subroutine pop_d6
299
300 end module

  ViewVC Help
Powered by ViewVC 1.1.22