	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
	data lunw/0/

	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', shared
	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', shared
	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
	data update/.true./
	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
	data lunr/0/

	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', shared
	1   , recl=recl, err=99, readonly)
	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
