new version of tecs_dlog (now in fortran)
This commit is contained in:
cvs
321
tecs/tecs_dlog.f
Normal file
321
tecs/tecs_dlog.f
Normal file
@@ -0,0 +1,321 @@
|
||||
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
|
||||
Reference in New Issue
Block a user