10 procedure,
nopass:: output => output
11 procedure,
nopass:: input => input
12 procedure,
nopass:: check_error
22 SUBROUTINE output (self, experiment_name)
24 character(len=64) filename, logname, experiment_name
25 optional:: experiment_name
27 integer:: iv, li(3)=0, ui(3)=0, l(3), u(3), no, jo, it, i
29 logical:: first_time=.true.
30 integer:: it1, it2, n(3)
32 real(4),
dimension(:,:,:),
pointer:: buf
33 real(8):: time, t1, t2
36 call trace%begin(
'legacy_io%output')
41 self%max_files = self%max_files-1
42 if (self%max_files <= 0)
then 43 write (io_unit%log,*)
'TOO MANY FILES' 50 if (io%guard_zones)
then 57 if (io%time_derivs>0)
then 62 if (io%out_time==0.0)
then 66 else if (io%time_derivs>0)
then 68 time = self%t(self%nt-2)
78 if (self%no_mans_land)
then 86 if (self%id < 100000)
then 87 write (filename,
'(a,i5.5,"/",i5.5)') trim(io%outputname), self%iout, self%id
88 else if (self%id < 1000000)
then 89 write (filename,
'(a,i5.5,"/",i6.6)') trim(io%outputname), self%iout, self%id
91 write (filename,
'(a,i5.5,"/",i7.7)') trim(io%outputname), self%iout, self%id
94 open (io_unit%data, file=trim(filename)//
'.dat', form=
'unformatted', access=
'direct', &
95 status=
'unknown', recl=kind(buf)*product(n))
98 allocate (buf(n(1),n(2),n(3)))
104 it1 = self%iit(self%nt-2)
107 it2 = self%iit(self%nt-1)
109 if (io%out_time == 0.0)
then 110 buf = self%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,self%it,jo)
123 pt = (time-t1)/max(t2-t1,1d-30)
126 buf = self%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,it1,jo)*qt &
127 + self%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,it2,jo)*pt
129 call check_error(self, buf,
"output 2")
131 write (io_unit%log,
'(1x,a,2i5,i3,1p,3e11.3)') &
132 trim(filename),iv,it1,jo,minval(buf),maxval(buf),pt
133 write (io_unit%data,rec=iv+(jo-1)*self%nv) buf
134 if (io%verbose>1 .and. iv==self%idx%d) &
135 print *,
'rho minmax',minval(buf), maxval(buf)
142 END SUBROUTINE output
147 SUBROUTINE check_error (patch, a, label, error)
149 character(len=*),
optional:: label
150 integer,
optional:: error(3)
151 integer:: loc(3), it, l(3), u(3), n(3), iy
152 real(4),
dimension(:,:,:),
pointer:: a, b
153 integer,
save:: nerror=4
155 if (.not.io%do_debug)
return 156 if (io%guard_zones)
then 164 allocate (b(n(1),n(2),n(3)))
166 b(:,iy,:)=a(:,iy,:)-a(:,1,:)
168 if (any(b /= 0.0))
then 169 loc = maxloc(abs(b)) + l-1
170 if (
present(label)) print*,
'legacy_io::error ', label
171 print*,
'legacy_io::error loc :', loc
172 print*,
'legacy_io::error it,new,iit :', patch%it, patch%new, patch%iit
174 print*,
'legacy_io::error iy, a:', iy, a(loc(1),iy,loc(3))
176 if (
present(error))
then 184 if (
present(label))
then 185 print*,
'legacy_io::check_error maxval ', label, maxval(abs(a))
187 print*,
'legacy_io::check_error maxval', maxval(abs(a))
191 END SUBROUTINE check_error
196 SUBROUTINE input (self, ok)
199 character(len=64) filename, line, fmt
200 integer:: iv, l(3), u(3), ioformat
202 logical,
save:: do_print=.true.
205 if (self%id==io%id_debug) &
206 print *,
'MK input', self%id, self%restart
207 if (self%restart < 0)
return 208 call trace_begin(
'legacy_io_t%input')
213 l = merge(self%mesh%lb, self%mesh%li, io%guard_zones)
214 u = merge(self%mesh%ub, self%mesh%ui, io%guard_zones)
218 if (self%id < 100000)
then 219 write (filename,
'(a,i5.5,"/",i5.5)') trim(io%inputdir), self%restart, self%id
220 else if (self%id < 1000000)
then 221 write (filename,
'(a,i5.5,"/",i6.6)') trim(io%inputdir), self%restart, self%id
223 write (filename,
'(a,i5.5,"/",i7.7)') trim(io%inputdir), self%restart, self%id
225 inquire (file=trim(filename)//
'.dat', exist=ok)
227 call io%abort(
'MK input_legacy: no .dat file'//trim(filename)//
'.dat')
230 open (io_unit%data, file=trim(filename)//
'.dat', form=
'unformatted', &
231 access=
'direct', status=
'unknown', recl=kind(self%mem)*product(u-l+1))
233 read (io_unit%data,rec=iv) self%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,self%it,1)
235 if (io%master .and. io%verbose>0 .or. self%track) &
236 print*,
'legacy_io%input_legacy: ', trim(filename), time
238 if (self%id==io%id_debug) &
239 print *,
'MK input_legacy', self%id, ok, self%mem(18,18,36,1,self%it,1)
243 self%out_next = (int(self%time/io%out_time)+1)*io%out_time
249 END MODULE legacy_io_mod
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...