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

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

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


Revision 1.2 - (hide annotations) (download)
Wed Dec 18 20:01:00 2013 UTC (10 years, 3 months ago) by utke
Branch: MAIN
CVS Tags: checkpoint64s
Changes since 1.1: +120 -3 lines
sync this with what is in the OAD repo

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     push_i0, push_d1, push_i1, &
9     pop_i0, pop_d1, pop_i1, &
10     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     module procedure 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_i0
66     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.2 subroutine push_i0(v)
191     implicit none
192     integer :: v
193     if(oad_it_sz .lt. oad_it_ptr+1) call oad_it_grow()
194     oad_it(oad_it_ptr)=v; oad_it_ptr=oad_it_ptr+1
195     end subroutine push_i0
196    
197     subroutine pop_i0(v)
198     implicit none
199     integer :: v
200     oad_it_ptr=oad_it_ptr-1
201     v=oad_it(oad_it_ptr)
202     end subroutine pop_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_d1(v)
249     implicit none
250     double precision :: v(:)
251     integer :: chunk
252     chunk=size(v,1)
253     oad_dt_ptr=oad_dt_ptr-chunk
254     v=oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1)
255     end subroutine pop_d1
256    
257     subroutine pop_i1(v)
258     implicit none
259     integer :: v(:)
260     integer :: chunk
261     chunk=size(v,1)
262     oad_it_ptr=oad_it_ptr-chunk
263     v=oad_it(oad_it_ptr:oad_it_ptr+chunk-1)
264     end subroutine pop_i1
265    
266     subroutine pop_d4(v)
267     implicit none
268     double precision :: v(:,:,:,:)
269     integer :: chunk, dims(4)
270     dims=shape(v)
271     chunk=dims(1)*dims(2)*dims(3)*dims(4)
272     oad_dt_ptr=oad_dt_ptr-chunk
273     v=reshape(oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1),dims)
274     end subroutine pop_d4
275    
276     subroutine pop_d6(v)
277     implicit none
278     double precision :: v(:,:,:,:,:,:)
279     integer :: chunk, dims(6)
280     dims=shape(v)
281     chunk=dims(1)*dims(2)*dims(3)*dims(4)*dims(5)*dims(6)
282     oad_dt_ptr=oad_dt_ptr-chunk
283     v=reshape(oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1),dims)
284     end subroutine pop_d6
285    
286 heimbach 1.1 end module

  ViewVC Help
Powered by ViewVC 1.1.22