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 |