23 class(
dump_t),
pointer:: next => null()
27 real(4),
dimension(:),
pointer:: data
37 integer(8):: record = 0
38 integer:: n_buffer = 0
39 integer:: max_buffer = 10
40 class(
dump_t),
pointer:: head => null()
41 class(
dump_t),
pointer:: tail => null()
44 procedure,
nopass:: output
52 integer(8):: revision=1
59 SUBROUTINE output (patch)
63 integer:: n_buf, n_data, ibuf, it1, it2, iv
64 real(4),
dimension(:),
pointer:: buffer
65 real,
dimension(:,:,:),
pointer:: var
70 call trace_begin (
'patch_t%output_new')
72 n_buf = product(patch%gn)
73 n_data = n_header + patch%nv*n_buf
74 allocate (buffer(n_data), var(patch%gn(1),patch%gn(2),patch%gn(3)))
78 call patch%patch_to_header (header)
80 call anonymous_copy (n_header, header, buffer(ibuf))
81 ibuf = ibuf + n_header
85 it1 = patch%iit(patch%nt-2)
86 it2 = patch%iit(patch%nt-1)
87 pt = (patch%out_next-patch%t(it1))/max(patch%t(it2)-patch%t(it1),1d-30)
89 var = patch%mem(:,:,:,iv,it1,1)*(1.-pt) + patch%mem(:,:,:,iv,it2,1)*pt
90 call anonymous_copy (n_buf, var, buffer(ibuf))
94 call buffered_io%buffer (patch%id, patch%iout, patch%out_next, buffer)
95 call buffered_io%check
104 SUBROUTINE open (self, nwords, iout)
106 integer:: nwords, iout
107 logical,
save:: first_time=.true., exist
108 character(len=64):: filename
110 call trace_begin(
'buffered_io_mod::open')
113 write (filename,
'(a,i5.5,"/buffered")') trim(io%outputname), iout
115 print
'(a)',
'OPEN: '//trim(filename)
121 print*,
'index file: ', trim(filename)//
'.idx' 122 inquire (file=trim(filename)//
'.idx', exist=exist)
124 open (io_unit%index, file=trim(filename)//
'.idx', &
125 form=
'unformatted', access=
'direct', status=
'unknown', recl=2*io%word_size)
126 read (io_unit%index, rec=3) self%record
128 open (io_unit%index, file=trim(filename)//
'.idx', &
129 form=
'unformatted', access=
'direct', status=
'unknown', recl=2*io%word_size)
131 write (io_unit%index, rec=3) self%record
133 write (io_unit%index, rec=1) revision
134 write (io_unit%index, rec=2) int(nwords,kind=8)
139 print*,
' dump file: ', trim(filename)//
'.dat' 140 open (io_unit%dump, file=trim(filename)//
'.dat', &
141 form=
'unformatted', access=
'direct', status=
'unknown', recl=nwords*io%word_size)
148 SUBROUTINE buffer (self, id, iout, time, data)
152 real(4),
dimension(:),
pointer:: data
153 class(
dump_t),
pointer:: dump
155 call trace_begin(
'buffered_io_mod::buffer')
160 dump%ndata =
size(data)
162 if (
associated(self%tail))
then 163 self%tail%next => dump
168 self%n_buffer = self%n_buffer+1
170 print*,
'buffered_io_mod::buffer: id, iout, n_buffer=', id, iout, self%n_buffer
173 END SUBROUTINE buffer
179 SUBROUTINE check (self)
181 class(
dump_t),
pointer:: dump
183 if (self%n_buffer >= self%max_buffer)
then 194 SUBROUTINE write (self)
196 class(
dump_t),
pointer:: dump, old
198 call trace_begin(
'buffered_io_mod::write')
201 print
'(a,i7,i6,i9,g15.6)',
'output: it, nbuf, ndata, time', &
202 dump%id, self%n_buffer, dump%ndata, dump%time
203 do while (
associated(dump))
207 if (dump%iout /= self%iout)
then 208 if (self%iout >= 0)
call self%close
209 call self%open (dump%ndata, dump%iout)
215 self%record = self%record+1
216 write (io_unit%index, rec=3) self%record
217 write (io_unit%index, rec=self%record+3) dump%id, dump%iout
218 flush (io_unit%index)
219 write (io_unit%dump, rec=self%record) dump%data
222 self%n_buffer = self%n_buffer-1
224 print
'(a,i7,i6,i9,g15.6)',
'output: id, it, ndata, time', &
225 dump%id, dump%iout, dump%ndata, dump%time
231 deallocate (old%data)
243 SUBROUTINE close (self)
246 if (io%do_legacy)
return 247 call trace_begin(
'buffered_io_mod::close')
248 close (io_unit%index)
257 FUNCTION find (self, id, iout)
259 integer,
optional:: id, iout
260 integer:: find, loc(1)
261 integer(8),
dimension(:),
pointer:: index
262 integer(8):: key, ndata, nrecord, revision, i
264 call trace_begin(
'buffered_io_mod::find')
268 open (io_unit%index, file=trim(io%outputname)//
'index.dat', &
269 form=
'unformatted', access=
'direct', status=
'old', recl=8)
270 read (io_unit%index,rec=1) revision
271 read (io_unit%index,rec=2) ndata
272 read (io_unit%index,rec=3) nrecord
273 print *, revision, ndata, nrecord
274 close (io_unit%index)
278 allocate (index(nrecord))
279 open (io_unit%index, file=trim(io%outputname)//
'index.dat', &
280 form=
'unformatted', access=
'direct', status=
'old', recl=8*(nrecord+3))
281 read (io_unit%index,rec=1) revision, ndata, nrecord, index
282 close (io_unit%index)
286 key = int(id,kind=8) + int(iout,kind=8)*2_8**32
288 print*,
'searching for id, iout, key =', id, iout, key
289 if (io%verbose>2)
then 294 loc = minloc(abs(index-key))
297 print*,
'record =', find
306 SUBROUTINE test (self)
308 real(4),
dimension(:),
pointer:: data
309 integer,
dimension(:),
pointer:: p
310 integer:: n=20, nv=8, id, it, ndata, record
313 call trace_begin (
'buffered_io_mod::test')
315 call self%open (ndata,0)
319 allocate (
data(ndata))
320 call self%buffer (id, it, time, data)
324 record = self%find (id=2,iout=3)
325 print *,
'record =', record
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...