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