1 |
heimbach |
1.1 |
module OAD_tape |
2 |
|
|
|
3 |
|
|
implicit none |
4 |
|
|
|
5 |
utke |
1.2 |
private :: increment , dtt, itt, ltt, stt, & |
6 |
|
|
init, dump_tapestats, & |
7 |
|
|
dt_grow, it_grow, lt_grow, st_grow, & |
8 |
utke |
1.3 |
push_d0, push_i0, push_d1, push_i1, & |
9 |
|
|
pop_d0, pop_i0, pop_d1, pop_i1, & |
10 |
utke |
1.2 |
push_d4, push_d6, & |
11 |
|
|
pop_d4, pop_d6 |
12 |
|
|
|
13 |
heimbach |
1.1 |
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 |
utke |
1.2 |
oad_chunk_size, & |
19 |
heimbach |
1.1 |
oad_tape_init, & |
20 |
utke |
1.2 |
oad_dump_tapestats, & |
21 |
|
|
oad_tape_push, oad_tape_pop |
22 |
heimbach |
1.1 |
|
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 |
utke |
1.2 |
integer :: oad_chunk_size |
33 |
heimbach |
1.1 |
|
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 |
utke |
1.2 |
interface oad_tape_push |
59 |
utke |
1.3 |
module procedure push_d0, push_i0 |
60 |
utke |
1.2 |
module procedure push_d1, push_i1 |
61 |
|
|
module procedure push_d4, push_d6 |
62 |
|
|
end interface |
63 |
|
|
|
64 |
|
|
interface oad_tape_pop |
65 |
utke |
1.3 |
module procedure pop_d0, pop_i0 |
66 |
utke |
1.2 |
module procedure pop_d1, pop_i1 |
67 |
|
|
module procedure pop_d4, pop_d6 |
68 |
|
|
end interface |
69 |
|
|
|
70 |
heimbach |
1.1 |
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 |
utke |
1.3 |
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 |
utke |
1.2 |
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 |
utke |
1.3 |
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 |
utke |
1.2 |
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 |
heimbach |
1.1 |
end module |