322 lines
6.4 KiB
Fortran
322 lines
6.4 KiB
Fortran
subroutine DLOG_OPEN_W(FILE, MAXSIZE) !!
|
|
!! =====================================
|
|
!!
|
|
!! open dlog file for write
|
|
!!
|
|
character*(*) FILE !! (in) filename
|
|
integer MAXSIZE !! (in) max. size of file (in kBytes)
|
|
|
|
include 'tecs_dlog.inc'
|
|
|
|
integer j, k, iostat
|
|
data lunw/0/
|
|
|
|
if (lunw .ne. 0) then
|
|
print *,'DLOG_OPEN_W: file already open for write'
|
|
return
|
|
endif
|
|
lunw=38
|
|
|
|
vers=0
|
|
|
|
open(lunw, name=file, status='old', access='direct', shared
|
|
1 , iostat=iostat)
|
|
if (iostat .eq. 0) then
|
|
read(lunw, rec=1) vers, wrec, rrec, rlim, lastx
|
|
if (vers .ne. version) then
|
|
close(lunw, status='delete')
|
|
else
|
|
read(lunw, rec=wrec) wn, wpos
|
|
1 , (wtim(j), (wdat(j*wn+k), k=0,wn-1), j=0,wpos-1)
|
|
endif
|
|
else
|
|
vers=0
|
|
endif
|
|
if (vers .ne. version) then
|
|
print *,'DLOG_OPEN_W: create new file'
|
|
vers=version
|
|
rlim=max(5,maxsize*256/recl)
|
|
rrec=2
|
|
wrec=2
|
|
wpos=0
|
|
wn=0
|
|
open(lunw, name=file, status='new', access='direct', shared
|
|
1 , recl=recl, err=93)
|
|
write(lunw, rec=2)
|
|
endif
|
|
|
|
call dlog_write_block(1)
|
|
|
|
wlim=max(5,maxsize*256/recl)
|
|
return
|
|
|
|
93 print *,'DLOG_OPEN_W: can not open file for write'
|
|
close(lunw)
|
|
lunw=0
|
|
end
|
|
|
|
|
|
subroutine DLOG_PUT(TIME, N, DAT) !!
|
|
!! =================================
|
|
!!
|
|
!! put data for N channels to logfile
|
|
!!
|
|
integer N, TIME !! (in) convention: time is in seconds since UNIX
|
|
real DAT(N) !! (in) data (0 is none)
|
|
|
|
include 'tecs_dlog.inc'
|
|
|
|
integer i,ival,j
|
|
|
|
entry dlog_put_(time, n, dat) ! C interface for VMS
|
|
|
|
if (lunw .le. 0) then
|
|
if (lunw .eq. 0) print *,'DLOG_PUT: file not open'
|
|
lunw=-1
|
|
return
|
|
endif
|
|
|
|
if (n .eq. 0) return
|
|
|
|
if (wn .eq. 0) wn=n
|
|
|
|
if ((wpos+1)*(n+1)+2 .gt. recl .or. n .ne. wn) then ! next record
|
|
wrec=wrec+1
|
|
if (wrec .gt. wlim) then
|
|
rlim=wlim
|
|
wrec=2
|
|
if (rrec .gt. rlim) rrec=2
|
|
endif
|
|
if (wlim .gt. rlim) rlim=wlim
|
|
if (wrec .eq. rrec) then ! move read pointer
|
|
rrec=rrec+1
|
|
if (rrec .gt. rlim) then
|
|
rrec=2
|
|
endif
|
|
endif
|
|
call dlog_write_block(1)
|
|
wn=n
|
|
wpos=0
|
|
endif
|
|
wtim(wpos)=time
|
|
j=wpos*wn
|
|
do i=1,wn
|
|
wdat(j)=dat(i)
|
|
j=j+1
|
|
enddo
|
|
wpos=wpos+1
|
|
call dlog_write_block(wrec)
|
|
lastx=time
|
|
call dlog_write_block(1)
|
|
end
|
|
|
|
|
|
|
|
subroutine DLOG_CLOSE_W !!
|
|
!! =======================
|
|
!!
|
|
!! close data file for write
|
|
!!
|
|
include 'tecs_dlog.inc'
|
|
|
|
entry dlog_close_w_
|
|
|
|
if (lunw .gt. 0) close(lunw)
|
|
lunw=0
|
|
end
|
|
|
|
|
|
subroutine DLOG_OPEN_R(FILE, FIRST, LAST, OFFSET) !!
|
|
!! =================================================
|
|
!!
|
|
!! open dlog file for read
|
|
!!
|
|
character*(*) FILE !! (in) filename
|
|
integer FIRST !! first time
|
|
integer LAST !! last time
|
|
integer OFFSET !! recommended offset for DLOG_GET:
|
|
!! last Monday 0h00 before FIRST
|
|
|
|
include 'tecs_dlog.inc'
|
|
|
|
logical done
|
|
integer iostat,i,j
|
|
data lunr/0/
|
|
|
|
if (lunr .ne. 0) then
|
|
print *,'DLOG_OPEN_R: file already open for read'
|
|
return
|
|
endif
|
|
|
|
lunr=39
|
|
|
|
open(lunr, name=file, status='old', access='direct', shared
|
|
1 , recl=recl, err=99, readonly)
|
|
call dlog_read_block(1, done)
|
|
if (done) call dlog_read_block(rrec, done)
|
|
if (.not. done) then
|
|
close(lunr)
|
|
goto 99
|
|
endif
|
|
if (nl .eq. 0) then
|
|
first=0
|
|
else
|
|
first=rtim(0)
|
|
endif
|
|
last=lastx
|
|
offset=first-mod(first+3*24*3600,7*24*3600)
|
|
return
|
|
|
|
99 print *,'DLOG_OPEN_R: can not open'
|
|
lunr=0
|
|
end
|
|
|
|
|
|
subroutine DLOG_GET(NDIM, NDAT, OFFSET, XMIN, XMAX, X, Y, NRES) !!
|
|
!! ===============================================================
|
|
!!
|
|
!! Get data from logfile in the range XMIN..XMAX
|
|
!! not available data is represented by 0
|
|
!! for precision reasons, and because time is internally stored
|
|
!! as integer seconds since UNIX (1 Jan 1970), a time offset is used.
|
|
!! X(i)+OFFSET, XMIN+OFFSET, XMAX+OFFSET is in seconds since UNIX
|
|
!!
|
|
integer NDIM, NDAT !! (in) dimensions
|
|
integer OFFSET !! (in) time zero point (use value from DLOG_OPEN)
|
|
real XMIN, XMAX !! (in) start and end time
|
|
real X(NDIM), Y(NDIM, NDAT) !! (out) data
|
|
integer NRES !! (out) returned size
|
|
|
|
include 'tecs_dlog.inc'
|
|
|
|
integer i, j, k, ix, imin, imax, rpos, iostat
|
|
logical done
|
|
|
|
nres=0
|
|
if (lunr .eq. 0) return ! file not open
|
|
|
|
imin=nint(max(-2147480000.,xmin))
|
|
imax=nint(min( 2147480000.,xmax))
|
|
|
|
call dlog_read_block(1, done)
|
|
if (.not. done) return ! record locked
|
|
|
|
1 continue
|
|
call dlog_read_block(rrec, done)
|
|
if (.not. done) return ! record locked
|
|
do i=0,nl-1
|
|
ix=rtim(i)-offset
|
|
if (ix .ge. imin .and. ix .le. imax .and. nres .lt. ndim) then
|
|
nres=nres+1
|
|
x(nres)=ix
|
|
j=i*rn
|
|
do k=1,min(rn, ndat)
|
|
y(nres,k)=rdat(j)
|
|
j=j+1
|
|
enddo
|
|
do k=min(rn, ndat)+1,ndat ! fill with zeros
|
|
y(nres,k)=0
|
|
enddo
|
|
endif
|
|
enddo
|
|
8 if (rrec .eq. wrec) goto 9
|
|
rrec=rrec+1
|
|
if (rrec .gt. rlim) then
|
|
rrec=2
|
|
endif
|
|
goto 1
|
|
9 continue
|
|
|
|
end
|
|
|
|
|
|
subroutine DLOG_CLOSE_R !!
|
|
!! =======================
|
|
!!
|
|
!! close data file for read
|
|
!!
|
|
include 'tecs_dlog.inc'
|
|
|
|
if (lunr .ne. 0) close(lunr)
|
|
lunr=0
|
|
end
|
|
|
|
|
|
|
|
subroutine dlog_write_block(recno)
|
|
|
|
integer recno
|
|
|
|
include 'tecs_dlog.inc'
|
|
|
|
integer i,j,k,iostat
|
|
real s
|
|
|
|
s=secnds(0.0)
|
|
1 if (recno .eq. 1) then
|
|
write(lunw, rec=1, iostat=iostat) vers, wrec, rrec, rlim, lastx
|
|
else
|
|
write(lunw, rec=recno, iostat=iostat) wn, wpos
|
|
1 , (wtim(j), (wdat(j*wn+k), k=0,wn-1), j=0,wpos-1)
|
|
endif
|
|
if (iostat .eq. 52) then ! record locked
|
|
if (secnds(s) .lt. 2.0) goto 1
|
|
print *,'DLOG_PUT: record locked'
|
|
endif
|
|
end
|
|
|
|
|
|
subroutine dlog_read_block(recno, done)
|
|
|
|
integer recno
|
|
logical done
|
|
|
|
include 'tecs_dlog.inc'
|
|
|
|
integer i,j,k,iostat
|
|
real s
|
|
|
|
s=secnds(0.0)
|
|
1 if (recno .eq. 1) then
|
|
read(lunr, rec=1, iostat=iostat) vers, wrec, rrec, rlim, lastx
|
|
else
|
|
read(lunr, rec=recno, iostat=iostat) rn, nl
|
|
1 , (rtim(j), (rdat(j*rn+k), k=0,rn-1), j=0,nl-1)
|
|
endif
|
|
if (iostat .eq. 52) then ! record locked
|
|
if (secnds(s) .lt. 2.0) goto 1
|
|
print *,'DLOG_GET: record locked'
|
|
done=.false.
|
|
elseif (iostat .ne. 0) then
|
|
print *,'DLOG_GET: can not read record'
|
|
done=.false.
|
|
else
|
|
done=.true.
|
|
endif
|
|
end
|
|
|
|
|
|
!
|
|
! C interface
|
|
!
|
|
subroutine dlog_open_write(cfile, maxsize)
|
|
|
|
byte cfile(*) ! C char*
|
|
integer maxsize ! C int
|
|
|
|
integer m, i, j
|
|
character file*128
|
|
|
|
entry dlog_open_write_(cfile, maxsize) ! C interface for VMS
|
|
|
|
m=%loc(maxsize)
|
|
do i=2,128
|
|
if (cfile(i) .eq. 0) then
|
|
write(file, '(128a1)') (cfile(j), j=1,i-1)
|
|
call dlog_open_w(file(1:i-1), m)
|
|
return
|
|
endif
|
|
enddo
|
|
print *,'DLOG_OPEN_WRITE: filename too long'
|
|
end
|