22 real,
dimension(:,:,:,:),
allocatable:: buffer
23 character(len=128):: filename
24 logical:: locked=.false.
25 real(8):: position(3)=0d0
26 real:: gb=0.0, gbs=0.0
35 integer(8):: revision=1
43 SUBROUTINE init (self, patch, filename)
46 character(len=*),
optional :: filename
49 call trace_begin(
'direct_io_t%init')
52 if (
present(filename))
then 53 if (verbose>1) print *,
'direct_io_t: filename = ', trim(filename)
54 self%filename = filename
59 mpatch = nint(patch%mesh%b/patch%mesh%s)
60 if (patch%no_mans_land)
then 61 self%dims(1:3) = mpatch*patch%mesh%n
63 self%dims(1:3) = mpatch*(patch%mesh%n-1)+1
66 self%dims(4) = patch%nv
67 self%nbuf = product(mpatch)
77 SUBROUTINE output (self, patch)
81 character(len=64) :: filename
82 real,
pointer :: buf(:,:,:,:)
83 integer :: n(3), l(3), u(3), ng(3)=0, jt(2), id=0, offset(4)=1
86 call trace_begin(
'patch_t%output_direct')
91 if (self%count==self%nbuf-1)
then 92 write (filename,
'(a,i5.5,"/",i5.5)') trim(io%outputname), patch%iout, id
93 if (patch%no_mans_land)
then 98 open (io%data_unit, file=trim(filename)//
'.txt', form=
'formatted', status=
'unknown')
99 write (io%data_unit,
'(i2.2)') io%format
100 write (io%data_unit,
'(a)') trim(patch%kind)
101 write (io%data_unit,
'(a)') trim(patch%eos)
102 write (io%data_unit,
'(a)') trim(patch%opacity)
103 write (io%data_unit,
'(1p,2e18.10,6(2x,3e18.10)1x,1x,2e10.3)') patch%out_next, patch%dtime, &
104 self%position, patch%ds, patch%velocity, patch%llc_nat, patch%llc_cart, &
105 patch%mesh%centre_nat, patch%quality, patch%gamma
110 write (io%data_unit,
'(6(3i10.1,2x),3i2.1,1x,1i2.1,i3)') int(patch%box/patch%ds+0.5), &
111 n, l, u, n, n, ng, patch%nv, patch%level
112 write (io%data_unit,
'(3(1i8.1,1x),i2.1)') id, patch%iout, patch%istep, patch%mesh_type
114 self%filename = trim(filename)//
'.dat' 122 if (verbose>1) print *,
'output:', patch%id, l, u
123 allocate (buf(n(1),n(2),n(3),patch%nv))
124 call patch%time_interval (patch%out_next, jt, pt)
125 buf = patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),:,jt(1),1)*pt(1) &
126 + patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),:,jt(2),1)*pt(2)
127 offset(1:3) = 1 + patch%ipos*patch%ncell
128 call self%out (buf, offset)
132 END SUBROUTINE output
137 SUBROUTINE input (self, patch, ok)
142 character(len=64) :: filename
143 real,
pointer :: buf(:,:,:,:)
144 integer :: n(3), l(3), u(3), ng(3)=0, jt(2), id=0, offset(4)=1, iof
147 real(8),
save :: time
149 call trace_begin(
'patch_t%input_direct')
154 write (filename,
'(a,i5.5,"/",i5.5)') trim(io%outputname), patch%restart, id
155 inquire (file=trim(filename)//
'.dat', exist=exist)
157 if (self%count==0)
then 158 open (io%data_unit, file=trim(filename)//
'.txt', form=
'formatted', status=
'old')
159 read (io%data_unit,
'(i2.2)') iof
160 read (io%data_unit,
'(a)')
161 read (io%data_unit,
'(a)')
162 read (io%data_unit,
'(a)')
163 read (io%data_unit,
'(1p,2e18.10,6(2x,3e18.10)1x,1x,2e10.3)') time
165 self%filename = trim(filename)//
'.dat' 174 allocate (buf(n(1),n(2),n(3),patch%nv))
176 offset(1:3) = 1 + patch%ipos*patch%ncell
177 call self%in (buf, offset)
178 patch%mem( : , : , : ,:,patch%it,1) = 0.0
179 patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),:,patch%it,1) = buf
180 if (verbose>1) print *,
'id, dmin, dmax', patch%id, minval(buf(:,:,:,1)), maxval(buf(:,:,:,1)), l, u
181 if (verbose>1) print *,
'id, dmin, dmax', patch%id, patch%fminval(patch%idx%d), patch%fmaxval(patch%idx%d), shape(buf)
184 if (self%count==self%nbuf)
then 190 if (io%verbose > 0) &
191 print *,
'input_direct:', trim(filename)//
'.dat', exist, ok, self%count
199 SUBROUTINE out (self, data, offset)
201 real,
dimension(:,:,:,:) :: data
202 integer,
dimension(4) :: offset
204 call trace_begin(
'direct_io_t%out')
205 if (self%locked)
then 206 call out_real (self,
data, offset)
208 call out_real (self,
data, offset)
216 SUBROUTINE out_real (self, data, offset)
218 integer,
dimension(4) :: offset, n, l, u
219 real,
dimension(:,:,:,:) :: data
221 call trace_begin(
'direct_io_t%out_real')
226 print
'("direct_io_t%out",4(4i4,2x))', l, u, self%dims, shape(data)
227 if (.not.
allocated(self%buffer))
then 228 allocate (self%buffer(self%dims(1),self%dims(2),self%dims(3),self%dims(4)))
230 self%buffer(l(1):u(1),l(2):u(2),l(3):u(3),l(4):u(4)) =
data 231 self%count = self%count+1
232 if (self%count==self%nbuf)
call write_out (self)
234 END SUBROUTINE out_real
239 SUBROUTINE in (self, data, offset)
241 real,
dimension(:,:,:,:) :: data
242 integer,
dimension(4) :: offset
244 call trace_begin(
'direct_io_t%in')
245 if (self%locked)
then 246 call in_real (self,
data, offset)
248 call in_real (self,
data, offset)
256 SUBROUTINE in_real (self, data, offset)
258 integer,
dimension(4) :: offset, n, l, u
259 real,
dimension(:,:,:,:) :: data
261 call trace_begin(
'direct_io_t%in_real')
266 print
'("direct_io_t%in",4(4i4,2x))', l, u, self%dims, shape(data)
267 if (.not.
allocated(self%buffer))
then 268 allocate (self%buffer(self%dims(1),self%dims(2),self%dims(3),self%dims(4)))
270 if (self%count==0)
call read_in (self)
271 data = self%buffer(l(1):u(1),l(2):u(2),l(3):u(3),l(4):u(4))
272 self%count = self%count+1
274 END SUBROUTINE in_real
279 SUBROUTINE close (self)
282 call trace_begin(
'direct_io_t%close')
283 if (
allocated(self%buffer))
then 284 if (verbose>1) print *,
'deallocating buffer' 285 deallocate (self%buffer)
293 SUBROUTINE write_out (self, rec)
295 integer,
optional :: rec
296 integer :: l_rec, recl, i, j, i_rec
300 call trace_begin(
'direct_io_t%write_out')
302 if (
present(rec))
then 309 if (sizeof(self%buffer) < 2e9)
then 310 recl = 4*product(self%dims)
311 open (io_unit%direct, file=trim(self%filename), access=
'direct', &
312 status=
'unknown', recl=recl)
313 write (io_unit%direct, rec=l_rec) self%buffer
315 recl8 = 4_8*product(self%dims(1:3))
316 if (recl8 < 2e9)
then 318 open (io_unit%direct, file=trim(self%filename), access=
'direct', &
319 status=
'unknown', recl=recl)
321 write (io_unit%direct, rec=i+(l_rec-1)*self%dims(4)) self%buffer(:,:,:,i)
324 if (verbose>1) print *,
'DOUBLE LOOP' 325 recl = 4*product(self%dims(1:2))
326 open (io_unit%direct, file=trim(self%filename), access=
'direct', &
327 status=
'unknown', recl=recl)
330 i_rec = i + (j-1)*self%dims(3) + (l_rec-1)*self%dims(4)
331 write (io_unit%direct, rec=i_rec) self%buffer(:,:,i,j)
336 wt = max(wallclock()-wt,1d-9)
337 self%gb = 4.0*product(self%dims)/1024.**3
338 self%gbs = self%gb/wt
340 close (io_unit%direct)
341 self%locked = .false.
343 END SUBROUTINE write_out
348 SUBROUTINE read_in (self, rec)
350 integer,
optional :: rec
351 integer :: l_rec, recl, i, j, i_rec
355 call trace_begin(
'direct_io_t%read_in')
357 if (
present(rec))
then 364 if (sizeof(self%buffer) < 2e9)
then 365 recl = 4*product(self%dims)
366 open (io_unit%direct, file=trim(self%filename), access=
'direct', &
367 status=
'old', recl=recl)
368 read (io_unit%direct, rec=l_rec) self%buffer
370 recl8 = 4_8*product(self%dims(1:3))
371 if (recl8 < 2e9)
then 373 open (io_unit%direct, file=trim(self%filename), access=
'direct', &
374 status=
'old', recl=recl)
376 read (io_unit%direct, rec=i+(l_rec-1)*self%dims(4)) self%buffer(:,:,:,i)
379 if (verbose>1) print *,
'DOUBLE LOOP' 380 recl = 4*product(self%dims(1:2))
381 open (io_unit%direct, file=trim(self%filename), access=
'direct', &
382 status=
'old', recl=recl)
385 i_rec = i + (j-1)*self%dims(3) + (l_rec-1)*self%dims(4)
386 read (io_unit%direct, rec=i_rec) self%buffer(:,:,i,j)
391 print *,
'read_in:', shape(self%buffer), minval(self%buffer), maxval(self%buffer)
392 wt = max(wallclock()-wt,1d-9)
393 self%gb = 4.0*product(self%dims)/1024.**3
394 self%gbs = self%gb/wt
396 close (io_unit%direct)
397 self%locked = .false.
399 END SUBROUTINE read_in
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...