linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

approved tecs_dlog, added sys_util.c

Browse Source
This commit is contained in:
cvs
2000-05-16 14:01:23 +00:00
parent d9cac91b81
commit 24ae65783a
17 changed files with 407 additions and 240 deletions
Download Patch File Download Diff File Expand all files Collapse all files

320
tecs/tecs_dlog.f
View File

@@ -1,14 +1,14 @@
subroutine DLOG_OPEN_W(FILE, MAXSIZE) !!
!! =====================================
subroutine DLOG_OPEN_W(FILE) !!
!! ============================
!!
!! 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
logical done
integer i,iostat
data lunw/0/
if (lunw .ne. 0) then
@@ -20,37 +20,39 @@
vers=0
open(lunw, name=file, status='old', access='direct', shared
1 , iostat=iostat)
1 , recl=recl, iostat=iostat)
if (iostat .eq. 0) then
read(lunw, rec=1) vers, wrec, rrec, rlim, lastx
read(lunw, rec=1) vers, stim, etim, wrec, rrec, wdir
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
else ! delete file
open(lunw, name=file, status='old', iostat=iostat, shared)
if (iostat .eq. 0) close(lunw, status='delete')
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
do i=0,dirlen-1
wdir(i)=0
enddo
stim=0
etim=0
wrec=-1
rrec=0
open(lunw, name=file, status='new', access='direct', shared
1 , recl=recl, err=93)
write(lunw, rec=2)
else
read(lunw, rec=wrec+2, iostat=iostat) wdat
endif
call dlog_write_block(1)
wlim=max(5,maxsize*256/recl)
return
93 print *,'DLOG_OPEN_W: can not open file for write'
print *,file
close(lunw)
lunw=0
end
@@ -59,14 +61,16 @@
subroutine DLOG_PUT(TIME, N, DAT) !!
!! =================================
!!
!! put data for N channels to logfile
!! put data for N channels to logfile.
!! by default the file is updated in every call (see also DLOG_UPDATE)
!!
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
integer p,r,i,j,btim
data update/.true./
entry dlog_put_(time, n, dat) ! C interface for VMS
@@ -76,41 +80,63 @@
return
endif
if (stim .eq. 0) then
stim=time
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
! check if value fits in actual record
if (wrec .lt. 0) then
btim=time+1
else
btim=wdir(wrec)
endif
wtim(wpos)=time
j=wpos*wn
do i=1,wn
wdat(j)=dat(i)
j=j+1
if (time .lt. btim .or. time .ge. btim+recs*step) then
if (.not. update .and. wrec .ge. 0) then
call dlog_write_block(wrec+2)
call dlog_write_block(1)
endif
wrec=mod(wrec+1,dirlen)
btim=time-step/2
wdir(wrec)=btim
wdir(mod(wrec+1,dirlen))=0 ! disable next block
rrec=mod(wrec+2,dirlen)
if (wdir(rrec) .eq. 0) rrec=0
stim=wdir(rrec)
do i=0,recs-1
do j=1,mdat
wdat(j,i)=undef
enddo
enddo
endif
i=(time-btim)/step
do j=1,min(n,mdat)
wdat(j,i)=dat(j)
enddo
wpos=wpos+1
call dlog_write_block(wrec)
lastx=time
call dlog_write_block(1)
etim=time
if (update) then
call dlog_write_block(wrec+2)
call dlog_write_block(1)
endif
end
subroutine DLOG_UPDATE(ALWAYS) !!
!! ==============================
!!
!! update file. ALWAYS: switch on/off automatic update after DLOG_PUT
!!
include 'tecs_dlog.inc'
logical always
if (wrec .ge. 0) call dlog_write_block(wrec+2)
call dlog_write_block(1)
update=always
end
subroutine DLOG_CLOSE_W !!
!! =======================
@@ -121,6 +147,10 @@
entry dlog_close_w_
if (.not. update) then
call dlog_write_block(wrec+2)
call dlog_write_block(1)
endif
if (lunw .gt. 0) close(lunw)
lunw=0
end
@@ -140,7 +170,7 @@
include 'tecs_dlog.inc'
logical done
integer iostat,i,j
integer iostat
data lunr/0/
if (lunr .ne. 0) then
@@ -153,17 +183,13 @@
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
first=stim
last=etim
offset=first-mod(first+3*24*3600,7*24*3600)
return
@@ -172,8 +198,8 @@
end
subroutine DLOG_GET(NDIM, NDAT, OFFSET, XMIN, XMAX, X, Y, NRES) !!
!! ===============================================================
subroutine DLOG_GET(NDIM,NDAT,OFFSET,XMIN,XMAX,UNDEF_VALUE,X,Y,NRES) !!
!! ====================================================================
!!
!! Get data from logfile in the range XMIN..XMAX
!! not available data is represented by 0
@@ -184,49 +210,123 @@
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 UNDEF_VALUE !! (in) value to be returned for undefined data
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
integer r,rtim,ftim,ltim,btim,ntim,xtim
integer irec
integer i,j,i1,i2,iostat,n,d
logical done
nres=0
real ys(mdat),yj
integer ns(mdat)
if (lunr .eq. 0) return ! file not open
imin=nint(max(-2147480000.,xmin))
imax=nint(min( 2147480000.,xmax))
! print *,xmin,xmax
n=min(mdat,ndat)
nres=0
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
ftim=max(stim,offset+nint(max(-2147480000.-offset,xmin)))
ltim=min(etim,offset+nint(min( 2147480000.-offset,xmax)))
do j=1,mdat
ys(j)=0
ns(j)=0
enddo
xtim=0
rtim=ftim
ntim=0
d=step
do irec=rrec,rrec+dirlen-2
r=mod(irec,dirlen)
btim=rdir(r)
rtim=max(rtim,btim,ftim)
i1=(rtim-btim+step/2)/step
if (i1 .lt. recs) then
call dlog_read_block(r+2, done)
if (.not. done) return ! record locked
i2=min((ltim-btim+step/2)/step,recs-1)
do i=i1,i2
rtim=btim+step*i
if (rtim .ge. ntim) then ! next point
if (xtim .ne. 0) then ! some data already cumulated
if (nres .lt. ndim) then
nres=nres+1
! we calculate over how long time we have to average in order not to exceed NDIM
d=max(step,(ltim-rtim)/(ndim-nres+1)+1)
x(nres)=xtim+d/2-offset
do j=1,n
if (ns(j) .eq. 0) then
y(nres,j)=undef_value
else
y(nres,j)=ys(j)/ns(j)
! if (j .eq. 1) print *,'get',x(nres),y(nres,j)
endif
enddo
do j=n+1,ndat
y(nres,j)=undef_value
enddo
do j=1,mdat
ys(j)=0
ns(j)=0
enddo
endif
xtim=0
elseif (ntim+120 .lt. rtim .and. ntim .ne. 0) then ! no reading for 120 secnds
if (nres .lt. ndim) then ! put a undef_value for separation
nres=nres+1
x(nres)=rtim-offset
do j=1,ndat
y(nres,j)=undef_value
enddo
! print *,'get undef',x(nres)
endif
ntim=0
endif
endif
do j=1,n
yj=rdat(j,i)
if (yj .ne. undef) then
if (xtim .eq. 0) then
xtim=rtim
ntim=xtim+d
endif
ns(j)=ns(j)+1
ys(j)=ys(j)+yj
endif
enddo
enddo !i
endif
enddo ! irec
if (xtim .ne. 0 .and. nres .lt. ndim) then
nres=nres+1
x(nres)=xtim+d/2-offset
do j=1,n
if (ns(j) .eq. 0) then
y(nres,j)=undef_value
else
y(nres,j)=ys(j)/ns(j)
! if (j .eq. 1) print *,'get last',x(nres),y(nres,j)
endif
enddo
8 if (rrec .eq. wrec) goto 9
rrec=rrec+1
if (rrec .gt. rlim) then
rrec=2
endif
goto 1
9 continue
do j=n+1,ndat
y(nres,j)=undef_value
enddo
endif
end
@@ -249,20 +349,26 @@
include 'tecs_dlog.inc'
integer i,j,k,iostat
integer iostat
real s
s=secnds(0.0)
s=0
1 if (recno .eq. 1) then
write(lunw, rec=1, iostat=iostat) vers, wrec, rrec, rlim, lastx
write(lunw, rec=1, iostat=iostat) vers, stim, etim, wrec, rrec, wdir
else
write(lunw, rec=recno, iostat=iostat) wn, wpos
1 , (wtim(j), (wdat(j*wn+k), k=0,wn-1), j=0,wpos-1)
write(lunw, rec=recno, iostat=iostat) wdat
! print *,'write',recno-2,wdat(1,0),wdat(1,recs-1)
endif
if (iostat .eq. 52) then ! record locked
if (secnds(s) .lt. 2.0) goto 1
print *,'DLOG_PUT: record locked'
if (s .eq. 0) then
s=secnds(0.0)
elseif (secnds(s) .gt. 2.0) then
print *,'DLOG_PUT: record locked'
return
endif
goto 1
endif
if (s .ne. 0) print *,'DLOG_PUT: locked for ',secnds(s),' seconds'
end
@@ -273,24 +379,30 @@
include 'tecs_dlog.inc'
integer i,j,k,iostat
integer iostat, i
real s
s=secnds(0.0)
s=0
1 if (recno .eq. 1) then
read(lunr, rec=1, iostat=iostat) vers, wrec, rrec, rlim, lastx
read(lunr, rec=1, iostat=iostat) vers, stim, etim, i, rrec, rdir
else
read(lunr, rec=recno, iostat=iostat) rn, nl
1 , (rtim(j), (rdat(j*rn+k), k=0,rn-1), j=0,nl-1)
read(lunr, rec=recno, iostat=iostat) rdat
endif
if (iostat .eq. 52) then ! record locked
if (secnds(s) .lt. 2.0) goto 1
print *,'DLOG_GET: record locked'
done=.false.
if (s .eq. 0) then
s=secnds(0.0)
elseif (secnds(s) .gt. 2.0) then
print *,'DLOG_PUT: record locked'
done=.false.
return
endif
read(lunr, rec=mod(recno-2,dirlen)+1, iostat=iostat) i ! dummy read to wait
goto 1
elseif (iostat .ne. 0) then
print *,'DLOG_GET: can not read record'
done=.false.
else
if (s .ne. 0) print *,'DLOG_GET: locked for ',secnds(s),' seconds'
done=.true.
endif
end
@@ -299,21 +411,19 @@
!
! C interface
!
subroutine dlog_open_write(cfile, maxsize)
subroutine dlog_open_write(cfile)
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
entry dlog_open_write_(cfile) ! 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)
call dlog_open_w(file(1:i-1))
return
endif
enddo