From c7347e412973d9cfe575b68f2a5b851dcf032c7e Mon Sep 17 00:00:00 2001 From: cvs Date: Thu, 24 Jan 2002 13:22:44 +0000 Subject: [PATCH] removed --- tecs/tecs_dlog.f | 516 ----------------------------------------------- tecs/tecs_dlog.h | 17 -- 2 files changed, 533 deletions(-) delete mode 100644 tecs/tecs_dlog.f delete mode 100644 tecs/tecs_dlog.h diff --git a/tecs/tecs_dlog.f b/tecs/tecs_dlog.f deleted file mode 100644 index 814b4955..00000000 --- a/tecs/tecs_dlog.f +++ /dev/null @@ -1,516 +0,0 @@ - subroutine tecs_dlog - stop 'TECS_DLOG: do not call module header' - end - - integer function DLOG_OPEN_W(FILE) !! -!! ================================== -!! -!! open dlog file for write -!! - character*(*) FILE !! (in) filename - - include 'tecs_dlog.inc' - - logical done - integer i,iostat - - if (lunw .ne. 0) then - call err_msg('file already open for write') - dlog_open_w=-1 ! failure - return - endif - lunw=38 - - vers=0 - - open(lunw, name=file, status='old', access='direct' - 1 , recl=recl, iostat=iostat) - if (iostat .eq. 0) then - read(lunw, rec=1, iostat=iostat) vers, stim, etim, wrec, rrec, wdir - if (vers .ne. version .or. iostat .ne. 0) then - close(lunw, status='delete') - endif - else ! delete file - call sys_remove_file(file) - vers=0 - endif - if (vers .ne. version) then - dlog_open_w=1 ! new file created - vers=version - 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' - 1 , recl=recl, err=93) - else - dlog_open_w=1 ! reopened - read(lunw, rec=wrec+2, iostat=iostat) wdat - endif - - call dlog_write_block(1, done) - if (.not. done) then - call err_txt('dlog_write_block(1,done)') - goto 99 - endif - return - -93 call err_msg('can not open file for write') -99 dlog_open_w=-1 ! failure - close(lunw) - lunw=0 - end - - - integer function DLOG_PUT(TIME, N, DAT) !! -!! ======================================= -!! -!! 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 p,r,i,j,btim - logical done - - integer dlog_put_ - entry dlog_put_(time, n, dat) ! C interface for VMS - - dlog_put=0 ! assume success - - if (lunw .le. 0) then - if (lunw .eq. 0) then ! return error message only once - call err_msg('file not open') - dlog_put=-1 - endif - lunw=-1 - return - endif - - if (stim .eq. 0) then - stim=time - endif - - if (n .eq. 0) return - - ! check if value fits in actual record - if (wrec .lt. 0) then - btim=time+1 - else - btim=wdir(wrec) - endif - 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, done) - if (.not. done) then - call err_txt('dlog_write_block(wrec+2,done)') - goto 99 - endif - call dlog_write_block(1, done) - if (.not. done) then - call err_txt('dlog_write_block(1,done)') - goto 99 - endif - 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 - - etim=time - if (update) then - call dlog_write_block(wrec+2, done) - if (.not. done) then - call err_txt('dlog_write_block(wrec+2,done)') - goto 99 - endif - call dlog_write_block(1, done) - if (.not. done) then - call err_txt('dlog_write_block(1,done)') - goto 99 - endif - endif - return - -99 dlog_put=-1 - end - - - integer function DLOG_UPDATE(ALWAYS) !! -!! ==================================== -!! -!! update file. ALWAYS: switch on/off automatic update after DLOG_PUT -!! - include 'tecs_dlog.inc' - logical always, done - - if (wrec .ge. 0) then - call dlog_write_block(wrec+2, done) - if (.not. done) then - call err_txt('dlog_write_block(wrec+2,done)') - goto 99 - endif - endif - call dlog_write_block(1, done) - if (.not. done) then - call err_txt('dlog_write_block(1,done)') - goto 99 - endif - update=always - dlog_update=0 - return - -99 dlog_update=-1 - end - - - subroutine DLOG_CLOSE_W !! -!! ======================= -!! -!! close data file for write -!! - include 'tecs_dlog.inc' - logical done - - entry dlog_close_w_ - - if (.not. update) then - call dlog_write_block(wrec+2, done) - call dlog_write_block(1, done) - endif - if (lunw .gt. 0) close(lunw) - lunw=0 - end - - - integer function 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 - - integer sys_gmt_off - - if (lunr .ne. 0) then - dlog_open_r=1 - call err_msg('file already open for read') - return - endif - - lunr=39 - - open(lunr, name=file, status='old', access='direct' - 1 , recl=recl, err=99) - call dlog_read_block(1, done) - if (.not. done) then - close(lunr) - goto 99 - endif - - first=stim - last=etim - offset=first-mod(first+3*24*3600,7*24*3600)-sys_gmt_off() - dlog_open_r=0 - return - -99 call err_msg('can not open') - dlog_open_r=-1 - lunr=0 - end - - - integer function DLOG_GET(NDIM,NDAT,OFFSET,XMIN,XMAX,UNDEF_VALUE,X,Y) !! -!! ===================================================================== -!! -!! 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 -!! return value is the number of values returned or a negative value -!! if an error occured -!! - integer NDIM, NDAT !! (in) dimensions - integer OFFSET !! (in) time zero point (use value from DLOG_OPEN) - real XMIN !! (in) start time (XMIN=0: first used time, XMIN<0 seconds before XMAX) - real XMAX !! (in) end time (XMAX=0: last used time) - real UNDEF_VALUE !! (in) value to be returned for undefined data - real X(NDIM), Y(NDIM, NDAT) !! (out) data - - include 'tecs_dlog.inc' - - integer r,rtim,ftim,ltim,btim,ntim,xtim - integer irec, nres - integer i,j,i1,i2,iostat,n,d - logical done - - real ys(mdat),yj - integer ns(mdat) - - if (lunr .eq. 0) then - call err_msg('file not open') - dlog_get=-1 - return - endif - - n=min(mdat,ndat) - nres=0 - call dlog_read_block(1, done) - if (.not. done) then - call err_txt('dlog_read_block(1,done)') - dlog_get=-1 - return ! record locked - endif - - if (xmax .eq. 0) then - ltim=etim - else - ltim=min(etim,offset+nint(min( 2147480000.-offset,xmax))) - endif - if (xmin .eq. 0) then - ftim=stim - elseif (xmin .lt. 0) then - ftim=ltim+nint(xmin) - else - ftim=max(stim,offset+nint(max(-2147480000.-offset,xmin))) - endif - - 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) then - call err_txt('dlog_read_block(r+2,done)') - dlog_get=-1 - return ! record locked - endif - - 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)/max(ndim-nres-1,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) - 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 - 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) - endif - enddo - do j=n+1,ndat - y(nres,j)=undef_value - enddo - endif - dlog_get=nres - 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, done) - - integer recno - logical done - - include 'tecs_dlog.inc' - - integer iostat - real s - - s=0 -1 if (recno .eq. 1) then - write(lunw, rec=1, iostat=iostat) vers, stim, etim, wrec, rrec, wdir - else - write(lunw, rec=recno, iostat=iostat) wdat - endif - if (iostat .eq. 52) then ! record locked - if (s .eq. 0) then - s=secnds(0.0) - elseif (secnds(s) .gt. 2.0) then - done=.false. - call err_msg('record locked') - return - endif - goto 1 - endif - done=.true. -! if (s .ne. 0) then -! print *,'DLOG_PUT: locked for ',secnds(s),' seconds' -! endif - end - - - subroutine dlog_read_block(recno, done) - - integer recno - logical done - - include 'tecs_dlog.inc' - - integer iostat, i - real s - character*24 msg - save msg - - s=0 -1 if (recno .eq. 1) then - read(lunr, rec=1, iostat=iostat) vers, stim, etim, i, rrec, rdir - else - read(lunr, rec=recno, iostat=iostat) rdat - endif - if (iostat .eq. 52) then ! record locked - if (s .eq. 0) then - s=secnds(0.0) - elseif (secnds(s) .gt. 2.0) then - call err_msg('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 - write(msg, '(a,i5)') 'read error ',iostat - call err_msg(msg) - done=.false. - else -! if (s .ne. 0) then -! print *,'DLOG_GET: locked for ',secnds(s),' seconds' -! endif - done=.true. - endif - end - - -! -! C interface -! - integer function dlog_open_write(cfile) - - byte cfile(*) ! C char* - - integer m, i, j - character file*128 - - integer dlog_open_w - - integer dlog_open_write_ - entry dlog_open_write_(cfile) ! C interface for VMS - - do i=2,128 - if (cfile(i) .eq. 0) then - write(file, '(128a1)') (cfile(j), j=1,i-1) - dlog_open_write_=dlog_open_w(file(1:i-1)) - return - endif - enddo - dlog_open_write_=0 - call err_msg('filename too long') - end diff --git a/tecs/tecs_dlog.h b/tecs/tecs_dlog.h deleted file mode 100644 index 65ba9e4b..00000000 --- a/tecs/tecs_dlog.h +++ /dev/null @@ -1,17 +0,0 @@ -#ifndef _DLOG_H_ -#define _DLOG_H_ - -#include - -/* implemented in fortran TECS_DLOG.F */ - -int dlog_open_write_(char *file); -/* open dlog file */ - -int dlog_put_(time_t *time, int *nset, float val[]); -/* put values to dlog file */ - -int dlog_close_w_(void); -/* close dlog set */ - -#endif /* _DLOG_H_ */