File indexing completed on 2018-03-02 18:45:09 UTC
view on githubraw file Latest commit 2aef7bde on 2014-01-16 15:15:23 UTC
8702af1f36 Patr*0001 module OAD_tape
0002
0003 implicit none
0004
231eb0b4f6 Jean*0005 private :: increment , dtt, itt, ltt, stt, &
0006 init, dump_tapestats, &
0007 dt_grow, it_grow, lt_grow, st_grow, &
2aef7bdee2 Jean*0008 push_d0, push_i0, push_d1, push_i1, &
0009 pop_d0, pop_i0, pop_d1, pop_i1, &
231eb0b4f6 Jean*0010 push_d4, push_d6, &
0011 pop_d4, pop_d6
0012
8702af1f36 Patr*0013 public :: &
0014 oad_dt, oad_dt_ptr, oad_dt_sz, oad_dt_grow, &
0015 oad_it, oad_it_ptr, oad_it_sz, oad_it_grow, &
0016 oad_lt, oad_lt_ptr, oad_lt_sz, oad_lt_grow, &
0017 oad_st, oad_st_ptr, oad_st_sz, oad_st_grow, &
231eb0b4f6 Jean*0018 oad_chunk_size, &
8702af1f36 Patr*0019 oad_tape_init, &
231eb0b4f6 Jean*0020 oad_dump_tapestats, &
0021 oad_tape_push, oad_tape_pop
8702af1f36 Patr*0022
0023 double precision, dimension(:), allocatable :: oad_dt, dtt
0024 integer, dimension(:), allocatable :: oad_it, itt
0025 logical, dimension(:), allocatable :: oad_lt, ltt
0026 character(80), dimension(:), allocatable :: oad_st, stt
0027 integer :: oad_dt_ptr=0, oad_it_ptr=0
0028 integer :: oad_dt_sz=0, oad_it_sz=0
0029 integer :: oad_lt_ptr=0, oad_st_ptr=0
0030 integer :: oad_lt_sz=0, oad_st_sz=0
0031 integer :: increment
231eb0b4f6 Jean*0032 integer :: oad_chunk_size
8702af1f36 Patr*0033
0034 interface oad_tape_init
0035 module procedure init
0036 end interface
0037
0038 interface oad_dump_tapestats
0039 module procedure dump_tapestats
0040 end interface
0041
0042 interface oad_dt_grow
0043 module procedure dt_grow
0044 end interface
0045
0046 interface oad_it_grow
0047 module procedure it_grow
0048 end interface
0049
0050 interface oad_lt_grow
0051 module procedure lt_grow
0052 end interface
0053
0054 interface oad_st_grow
0055 module procedure st_grow
0056 end interface
0057
231eb0b4f6 Jean*0058 interface oad_tape_push
2aef7bdee2 Jean*0059 module procedure push_d0, push_i0
231eb0b4f6 Jean*0060 module procedure push_d1, push_i1
0061 module procedure push_d4, push_d6
0062 end interface
0063
0064 interface oad_tape_pop
2aef7bdee2 Jean*0065 module procedure pop_d0, pop_i0
231eb0b4f6 Jean*0066 module procedure pop_d1, pop_i1
0067 module procedure pop_d4, pop_d6
0068 end interface
0069
8702af1f36 Patr*0070
0071
0072 subroutine init
0073 integer :: initialSize=1048576
0074 increment=16777216
0075
0076 oad_dt_ptr=1
0077 if (allocated(oad_dt)) then
0078 deallocate(oad_dt)
0079 end if
0080 oad_dt_sz=initialSize
0081 allocate(oad_dt(oad_dt_sz))
0082
0083 oad_it_ptr=1
0084 if (allocated(oad_it)) then
0085 deallocate(oad_it)
0086 end if
0087 oad_it_sz=initialSize
0088 allocate(oad_it(oad_it_sz))
0089
0090 oad_lt_ptr=1
0091 if (allocated(oad_lt)) then
0092 deallocate(oad_lt)
0093 end if
0094 oad_lt_sz=initialSize
0095 allocate(oad_lt(oad_lt_sz))
0096
0097 oad_st_ptr=1
0098 if (allocated(oad_st)) then
0099 deallocate(oad_st)
0100 end if
0101 oad_st_sz=initialSize
0102 allocate(oad_st(oad_st_sz))
0103 end subroutine init
0104
0105 subroutine dump_tapestats()
0106 write(*,'(3(A,I9))',ADVANCE='NO') &
0107 ' TD:',oad_dt_ptr,' TI:',oad_it_ptr, ' TS:',oad_st_ptr
0108 end subroutine dump_tapestats
0109
0110 subroutine dt_grow
0111 integer status
0112 print *, "OAD: DT+ ", oad_dt_sz
0113 allocate(dtt(oad_dt_sz),STAT=status)
0114 if (status .gt. 0 ) then
0115 print *,'OAD: allocation (1)failed with', status
0116 stop
0117 end if
0118 dtt=oad_dt
0119 deallocate(oad_dt)
0120 allocate(oad_dt(oad_dt_sz+increment),STAT=status)
0121 if (status .gt. 0 ) then
0122 print *,'OAD: allocation (2)failed with', status
0123 stop
0124 end if
0125 oad_dt(1:oad_dt_sz) = dtt
0126 deallocate(dtt)
0127 oad_dt_sz=oad_dt_sz+increment
0128 end subroutine dt_grow
0129
0130 subroutine it_grow
0131 integer status
0132 print *, "OAD: IT+ ", oad_it_sz
0133 allocate(itt(oad_it_sz),STAT=status)
0134 if (status .gt. 0 ) then
0135 print *,'OAD: allocation (1)failed with', status
0136 stop
0137 end if
0138 itt=oad_it
0139 deallocate(oad_it)
0140 allocate(oad_it(oad_it_sz+increment),STAT=status)
0141 if (status .gt. 0 ) then
0142 print *,'OAD: allocation (2)failed with', status
0143 stop
0144 end if
0145 oad_it(1:oad_it_sz) = itt
0146 deallocate(itt)
0147 oad_it_sz=oad_it_sz+increment
0148 end subroutine it_grow
0149
0150 subroutine lt_grow
0151 integer status
0152 print *, "OAD: LT+ ", oad_lt_sz
0153 allocate(ltt(oad_lt_sz),STAT=status)
0154 if (status .gt. 0 ) then
0155 print *,'OAD: allocation (1)failed wlth', status
0156 stop
0157 end if
0158 ltt=oad_lt
0159 deallocate(oad_lt)
0160 allocate(oad_lt(oad_lt_sz+increment),STAT=status)
0161 if (status .gt. 0 ) then
0162 print *,'OAD: allocation (2)failed wlth', status
0163 stop
0164 end if
0165 oad_lt(1:oad_lt_sz) = ltt
0166 deallocate(ltt)
0167 oad_lt_sz=oad_lt_sz+increment
0168 end subroutine lt_grow
0169
0170 subroutine st_grow
0171 integer status
0172 print *, "OAD: ST+ ", oad_st_sz
0173 allocate(stt(oad_st_sz),STAT=status)
0174 if (status .gt. 0 ) then
0175 print *,'OAD: allocation (1)failed wsth', status
0176 stop
0177 end if
0178 stt=oad_st
0179 deallocate(oad_st)
0180 allocate(oad_st(oad_st_sz+increment),STAT=status)
0181 if (status .gt. 0 ) then
0182 print *,'OAD: allocation (2)failed wsth', status
0183 stop
0184 end if
0185 oad_st(1:oad_st_sz) = stt
0186 deallocate(stt)
0187 oad_st_sz=oad_st_sz+increment
0188 end subroutine st_grow
0189
2aef7bdee2 Jean*0190 subroutine push_d0(v)
0191 implicit none
0192 double precision :: v
0193 if(oad_dt_sz .lt. oad_dt_ptr+1) call oad_dt_grow()
0194 oad_dt(oad_dt_ptr)=v; oad_dt_ptr=oad_dt_ptr+1
0195 end subroutine push_d0
0196
231eb0b4f6 Jean*0197 subroutine push_i0(v)
0198 implicit none
0199 integer :: v
0200 if(oad_it_sz .lt. oad_it_ptr+1) call oad_it_grow()
0201 oad_it(oad_it_ptr)=v; oad_it_ptr=oad_it_ptr+1
0202 end subroutine push_i0
0203
0204 subroutine push_d1(v)
0205 implicit none
0206 double precision :: v(:)
0207 integer :: chunk
0208 chunk=size(v,1)
0209 if(oad_dt_sz .lt. oad_dt_ptr+chunk) call oad_dt_grow()
0210 oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1)=v; oad_dt_ptr=oad_dt_ptr+chunk
0211 end subroutine push_d1
0212
0213 subroutine push_i1(v)
0214 implicit none
0215 integer :: v(:)
0216 integer :: chunk
0217 chunk=size(v,1)
0218 if(oad_it_sz .lt. oad_it_ptr+chunk) call oad_it_grow()
0219 oad_it(oad_it_ptr:oad_it_ptr+chunk-1)=v; oad_it_ptr=oad_it_ptr+chunk
0220 end subroutine push_i1
0221
0222 subroutine push_d4(v)
0223 implicit none
0224 double precision :: v(:,:,:,:)
0225 integer :: chunk(1), dims(4)
0226 dims=shape(v)
0227 chunk(1)=dims(1)*dims(2)*dims(3)*dims(4)
0228 do while (oad_dt_sz .lt. oad_dt_ptr+chunk(1))
0229 call oad_dt_grow()
0230 end do
0231 oad_dt(oad_dt_ptr:oad_dt_ptr+chunk(1)-1)=reshape(v,chunk)
0232 oad_dt_ptr=oad_dt_ptr+chunk(1)
0233 end subroutine push_d4
0234
0235 subroutine push_d6(v)
0236 implicit none
0237 double precision :: v(:,:,:,:,:,:)
0238 integer :: chunk(1), dims(6)
0239 dims=shape(v)
0240 chunk(1)=dims(1)*dims(2)*dims(3)*dims(4)*dims(5)*dims(6)
0241 do while (oad_dt_sz .lt. oad_dt_ptr+chunk(1))
0242 call oad_dt_grow()
0243 end do
0244 oad_dt(oad_dt_ptr:oad_dt_ptr+chunk(1)-1)=reshape(v,chunk)
0245 oad_dt_ptr=oad_dt_ptr+chunk(1)
0246 end subroutine push_d6
0247
2aef7bdee2 Jean*0248 subroutine pop_d0(v)
0249 implicit none
0250 double precision :: v
0251 oad_dt_ptr=oad_dt_ptr-1
0252 v=oad_dt(oad_dt_ptr)
0253 end subroutine pop_d0
0254
0255 subroutine pop_i0(v)
0256 implicit none
0257 integer :: v
0258 oad_it_ptr=oad_it_ptr-1
0259 v=oad_it(oad_it_ptr)
0260 end subroutine pop_i0
0261
231eb0b4f6 Jean*0262 subroutine pop_d1(v)
0263 implicit none
0264 double precision :: v(:)
0265 integer :: chunk
0266 chunk=size(v,1)
0267 oad_dt_ptr=oad_dt_ptr-chunk
0268 v=oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1)
0269 end subroutine pop_d1
0270
0271 subroutine pop_i1(v)
0272 implicit none
0273 integer :: v(:)
0274 integer :: chunk
0275 chunk=size(v,1)
0276 oad_it_ptr=oad_it_ptr-chunk
0277 v=oad_it(oad_it_ptr:oad_it_ptr+chunk-1)
0278 end subroutine pop_i1
0279
0280 subroutine pop_d4(v)
0281 implicit none
0282 double precision :: v(:,:,:,:)
0283 integer :: chunk, dims(4)
0284 dims=shape(v)
0285 chunk=dims(1)*dims(2)*dims(3)*dims(4)
0286 oad_dt_ptr=oad_dt_ptr-chunk
0287 v=reshape(oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1),dims)
0288 end subroutine pop_d4
0289
0290 subroutine pop_d6(v)
0291 implicit none
0292 double precision :: v(:,:,:,:,:,:)
0293 integer :: chunk, dims(6)
0294 dims=shape(v)
0295 chunk=dims(1)*dims(2)*dims(3)*dims(4)*dims(5)*dims(6)
0296 oad_dt_ptr=oad_dt_ptr-chunk
0297 v=reshape(oad_dt(oad_dt_ptr:oad_dt_ptr+chunk-1),dims)
0298 end subroutine pop_d6
0299
8702af1f36 Patr*0300 end module
