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