approved tecs_dlog, added sys_util.c

tecs/Makefile

@@ -5,12 +5,12 @@
 #--------------------------------------------------------------------------
 OBJ=   tecs_cli.o coc_client.o coc_util.o err_handling.o \
        str_util.o str_buf.o coc_server.o tecs_lsc.o tecs_serial.o \
-       coc_logfile.o tecs_dlog.o
+       coc_logfile.o tecs_dlog.o sys_util.o
 
 #------------ for DigitalUnix (add -DFORTIFY to CFLAGS for fortified version)
 CC=cc
 
-#CFLAGS= -std1 -g -c -warnprotos -I../ -I. -I../hardsup -DFORTIFY 
+#CFLAGS= -std1 -g -warnprotos -I../ -I. -I../hardsup -DFORTIFY 
 CFLAGS= -std1 -g -warnprotos -I../ -I. -I../hardsup
 
 .f.o:

tecs/coc_client.c

@@ -108,6 +108,7 @@ int CocCmdWithRetry(CocConn *conn) {
   int cnt, iret;
   char *err;
 
+  if (conn==NULL) ERR_MSG("not connected");
   cnt=3;
   while (1) {
     cnt--;

tecs/coc_server.c

@@ -15,6 +15,7 @@
 #include <unistd.h>
 #include <string.h>
 #include <assert.h>
+#include "sys_util.h"
 #include "err_handling.h"
 #include "coc_logfile.h"
 #include "coc_server.h"

tecs/coc_util.c

@@ -7,6 +7,7 @@
 #include <netdb.h>
 #include <string.h>
 #include <assert.h>
+#include "sys_util.h"
 #include "err_handling.h"
 #include "str_util.h"
 #include "coc_util.h"

tecs/err_handling.c

@@ -2,6 +2,8 @@
 #include <string.h>
 #include <stdlib.h>
 
+#include "sys_util.h"
+#include "str_util.h"
 #include "err_handling.h"
 
 #define SLEN 64
@@ -15,18 +17,6 @@ char *ErrMessage=NULL;
 void (*outrtn)()=NULL;
 void *outarg;
 
-void *my_malloc(size_t size, const char *text) {
-  void *ptr;
-  ptr=calloc(1,size);
-/*  printf("new %s %X %d\n", text, ptr, size); */
-  return(ptr);
-}
-
-void my_free(void *ptr) {
-/*  printf("my_free %X\n", ptr); */
-  free(ptr);
-}
-
 void ErrTxt(char *text, int systemError)
 {
   if (systemError) { sp=0; ErrCode=errno; ErrMessage=strerror(errno); }
@@ -93,25 +83,27 @@ void ERR_EXIT(char *text) {
   ErrWrite(text); exit(1);
 }
 
-void err_show_(char *text, int length) {
+/* FORTRAN wrappers */
+
+#ifdef __VMS
+#define err_show_ err_show
+#define err_txt_ err_txt
+#endif
+
+void err_show_(F_CHAR(text), int text_len) {
   char buf[256];
 
-  if (length>=256) length=255;
+  STR_TO_C(buf, text);
-  strncpy(buf, text, length);
-  buf[length]='\0';  
   ErrWrite(buf);
 }
 
-#ifdef __VMS
+void err_txt_(F_CHAR(text), int text_len) {
+  char buf[256];
 
-typedef struct { short size, dummy; char *text; } Desc;
+  STR_TO_C(buf, text);
-
+  ErrTxt(buf,0);
-void err_show(Desc *desc) {
-  err_show_(desc->text, desc->size);
 }
 
-#endif
-
 void errsetoutrtn_(void (*rtn)(), void *arg) {
   ErrSetOutRtn(rtn, arg);
 }

tecs/err_handling.h

@@ -1,9 +1,6 @@
 #ifndef _ERR_HANDLING_H_
 #define _ERR_HANDLING_H_
 
-#ifdef FORTIFY
-#include "fortify.h"
-#endif
 #include <stdio.h>
 #include <sys/errno.h>
 #include <fortify.h>
@@ -75,8 +72,6 @@ Global Variables (read only)
 #define ERR_MSG(R) { ErrMsg(R); goto OnError; }
 #define ERR_COD(R) { ErrCod(R); goto OnError; }
 
-#define NEW(PTR) ERR_SP(PTR=my_malloc(sizeof(*PTR),#PTR))
-
 void ErrTxt(char *text, int systemError);
 void ErrMsg(char *msg);
 void ErrCod(int code);
@@ -85,8 +80,6 @@ void ERR_EXIT(char *text);
 void ErrLog(char *text);
 void ErrSetOutRtn(void (*rtn)(), void *arg);
 void ErrSetOutFile(FILE *file);
-void *my_malloc(size_t size, const char *text);
-void my_free(void *ptr);
 
 extern int ErrCode;
 extern char *ErrMessage;

tecs/str_buf.c

@@ -4,6 +4,7 @@
 #include <string.h>
 #include <strings.h>
 #include <stdlib.h>
+#include "sys_util.h"
 #include "err_handling.h"
 #include "str_util.h"
 #include "str_buf.h"

tecs/str_util.c

@@ -7,6 +7,7 @@
 #include <assert.h>
 #include <string.h>
 #include <ctype.h>
+#include "sys_util.h"
 #include "err_handling.h"
 #include "str_util.h"
 
@@ -56,6 +57,22 @@ int str_ntrim(char *dest, const char *src, int ldest, int lsrc) {
   return(i);
 }
 
+int str_npad(char *dest, const char *src, int ldest) {
+  int i, lsrc;
+
+  lsrc=strlen(src);
+  if (lsrc>=ldest) {
+    if (dest!=src) strncpy(dest, src, ldest);
+    lsrc=ldest;
+  } else {
+    if (dest!=src) strcpy(dest, src);
+    for (i=lsrc; i<ldest; i++) {
+      dest[i]=' ';
+    }
+  }
+  return;
+}
+
 char *str_nsplit(char *dst, const char *src, char sep, int dstlen) {
   char *s;
   int i;

tecs/str_util.h

@@ -6,6 +6,7 @@
 */
 
 #define str_trim(DST,SRC,L)             str_ntrim(DST,SRC,sizeof(DST),L)
+#define str_pad(DST,SRC)                str_npad(DST,SRC,sizeof(DST))
 #define str_split(DST,SRC,SEP)          str_nsplit(DST,SRC,SEP,sizeof(DST))
 #define str_substitute(DST,SRC,OLD,NEW) str_nsubstitute(DST,SRC,OLD,NEW,sizeof(DST))
 #define str_upcase(DST,SRC)             str_nupcase(DST,SRC,sizeof(DST))
@@ -35,6 +36,11 @@ int str_ntrim(char *dest, const char *src, int ldest, int lsrc);
   copy characters 0 to lsrc-1 from src to dest (max ldest chars).
 */
 
+int str_npad(char *dest, const char *src, int ldest);
+/*
+  copy src to dest and fill with spaces (fortran string format)
+*/
+
 char *str_nsplit(char *dst, const char *src, char sep, int dstlen);
 /*
   returns a pointer to the text after the separator sep in *src

tecs/sys_util.c

@@ -0,0 +1,13 @@
+#include <stdlib.h>
+
+void *my_malloc(size_t size, const char *text) {
+  void *ptr;
+  ptr=calloc(1,size);
+/*  printf("new %s %X %d\n", text, ptr, size); */
+  return(ptr);
+}
+
+void my_free(void *ptr) {
+/*  printf("my_free %X\n", ptr); */
+  free(ptr);
+}

tecs/sys_util.h

@@ -0,0 +1,41 @@
+#ifndef _SYS_UTIL_H_
+#define _SYS_UTIL_H_
+
+#ifdef FORTIFY
+#include "fortify.h"
+#endif
+
+/* secure allocation stuff ---------------------------------- */
+
+#define NEW(PTR) ERR_SP(PTR=my_malloc(sizeof(*PTR),#PTR))
+
+void *my_malloc(size_t size, const char *text);
+void my_free(void *ptr);
+
+/* fortran interface stuff ----------------------------------
+
+   declare fortran character arguments as CHAR(arg)
+   and at at the end for each character argument <arg> add
+   int <arg>_len to the argument list
+
+*/
+
+#if defined __VMS
+
+#define F_CHAR(VAR) SysVmsChar *VAR##_desc
+#define STR_TO_C(DST,SRC) str_ntrim(DST, SRC##_desc->text, sizeof(DST), SRC##_len=SRC##_desc->size)
+#define STR_TO_F(DST,SRC) str_npad(DST##_desc->text, SRC, DST##_len=DST##_desc->size)
+
+typedef struct { short size, dummy; char *text; } SysVmsChar;
+
+#elif defined __alpha
+
+#define F_CHAR(VAR) char *VAR
+#define STR_TO_C(DST,SRC) str_ntrim(DST, SRC, sizeof(DST), SRC##_len)
+#define STR_TO_F(DST,SRC) str_npad(DST, SRC, DST##_len)
+
+#else
+#error this machine is not supported
+#endif
+
+#endif /* _SYS_UTIL_H_ */

tecs/tecs.c

@@ -5,6 +5,7 @@
 #include <sys/timeb.h>
 #include <string.h>
 #include <ctype.h>
+#include "sys_util.h"
 #include "err_handling.h"
 #include "coc_server.h"
 #include "coc_logfile.h"
@@ -16,6 +17,7 @@ int ftime (struct timeb *__timeptr); /* for some reason not defined in timeb.h w
 
 #define TABLE_FILE "lsci.tab"
 #define Progress(I) if (configuring) { configuring+=I; }
+#define undef -65535.
 
 static SerChannel *ser=NULL;
 static char *serverId=NULL;
@@ -469,7 +471,7 @@ int SetTemp(int switchOn) {
   tempH=(tempC+tShift)/scale;
   if (tempC==0) {
     ERR_P(LscCmd(ser, "CSET 1:[chan],1,1,0;RANGE:0;SETP 1:0"));
-  } else if (remoteMode==1) { /* local mode: do not switch on heater */
+  } else if (remoteMode==1) { /* in local mode: do not switch on heater */
     ERR_P(LscCmd(ser, "SETP 1:[tempH]"));
   } else if (switchOn) {
     ERR_P(LscCmd(ser, "CSET 1:[chan],1,1,0;RANGE:[iRange];SETP 1:[tempH]"));
@@ -541,6 +543,7 @@ int PeriodicTask(void) {
   ERR_P(LscCmd(ser, "DIOST?>cod1,out1;DOUT 3,29;HTR?>htr;BUSY?>busy"));
   if (cryo.codDefined && samp.codDefined) {
     per=period; /* no timeout on above command and codes are defined: normal period */
+    if (per>logPeriod*1000) per=logPeriod*1000;
   }
 
   if (noResp) { /* there was no response on an earlier command, or we are initializing */
@@ -601,11 +604,21 @@ int PeriodicTask(void) {
   ERR_I(ReadTemp());
 
   if (cryo.dirty==0 && samp.dirty==0 && noResp==0 && tim>logTime) {
-    t3[0]=cryo.temp;
+    if (cryo.nSens>0) {
-    t3[1]=samp.temp;
+      t3[0]=cryo.temp;
-    t3[2]=htr*htr*power*1e-4;
+    } else {
-    if (t3[2]==0.0) t3[2]=1e-20;
+      t3[0]=undef;
-
+    }
+    if (samp.nSens>0) {
+      t3[1]=samp.temp;
+    } else {
+      t3[1]=undef;
+    }
+    if (tempC!=0 || htr!=0) {
+      t3[2]=htr*htr*power*1e-4;
+    } else {
+      t3[2]=undef;
+    }
     time(&putTim);
     i=3;
     dlog_put_(&putTim, &i, t3);
@@ -616,7 +629,7 @@ int PeriodicTask(void) {
     d=(tempH-cryo.temp)/cryo.temp-1.0; /* relative difference */
     w=exp(-d*d*230); /* gaussian */
     if (w<0.1) tInt=0; /* reset when far from setpoint (more than 10 %) */
-    if (tInt<30000/period) tInt+=w; /* increase integral time until 30 sec. */
+    if (tInt<30000/per) tInt+=w; /* increase integral time until 30 sec. */
     if (tInt>w) {
       p=w/tInt;
     } else {
@@ -678,7 +691,12 @@ int PeriodicTask(void) {
     remoteMode=1;
     ERR_P(LscCmd(ser, "MODE?>remoteMode"));
     if (remoteMode==2) { /* user switched to remote mode */
-      ERR_P(LscCmd(ser, "RANGE?>iRange;SETP?1>tempC"));
+      if (controlMode==2) {
+        ERR_P(LscCmd(ser, "RANGE?>iRange"));
+        if (iRange==0) tempC=0;
+      } else {
+        ERR_P(LscCmd(ser, "RANGE?>iRange;SETP?1>tempC"));
+      }
       setFlag=(iRange>0);
     }
   }
@@ -981,7 +999,6 @@ int main(int argc, char *argv[])
   if (port==0) port=9753;
   if (msecTmo==0) msecTmo=1000;
   if (logPeriod==0) logPeriod=10;
-  if (logPeriod*1000<period) period=logPeriod*1000;
 
   str_copy(buf, logDir);
   str_append(buf, serverId);
@@ -1041,6 +1058,7 @@ int main(int argc, char *argv[])
   CocDefInt(iRange, CocRD);
   CocDefInt(remoteMode, CocRD);
 
+  CocDefInt(logPeriod, CocWR);
   CocDefInt(readTemp, CocWR);
   CocDefInt(controlMode, CocWR);
   CocDefInt(busy, CocRD);
@@ -1057,7 +1075,7 @@ int main(int argc, char *argv[])
   str_append(dlogfile, serverId);
   str_append(dlogfile, ".dlog");
   logfileOut(LOG_INFO, "open data log file: %s\n", dlogfile);
-  dlog_open_write_(dlogfile, 2000); /* max size of 2 MB */
+  dlog_open_write_(dlogfile);
   logfileWrite(logMask);
 
   LscCmd(ser, "MODE?>remoteMode");

tecs/tecs_cli.c

@@ -1,5 +1,6 @@
 #include <stdlib.h>
 #include <string.h>
+#include "sys_util.h"
 #include "err_handling.h"
 #include "str_util.h"
 #include "tecs_cli.h"
@@ -105,124 +106,93 @@ void TeccClose(pTecsClient conn) {
   }
 }
 
-/* fortran interface ---------------- */
+/* fortran wrappers --------------------------------------------------
 
-int tecc_set_par_(pTecsClient *conn, char *name, char *par, int namelen, int parlen) {
+  reduced functionality:
+  connection is static, so only one connection at a time may be opened 
+
+*/
+
+#ifdef __VMS
+#define tecs_get_par_ tecs_get_par
+#define tecs_set_par_ tecs_set_par
+#define tecs_send_ tecs_send
+#define tecs_init_ tecs_init
+#define tecs_get3_ tecs_get3
+#define tecs_set_ tecs_set
+#define tecs_wait_ tecs_wait
+#define tecs_is_open_ tecs_is_open
+#define tecs_close_ tecs_close
+#define tecs_quit_server_ tecs_quit_server
+#endif
+
+static pTecsClient conn=NULL;
+
+int tecs_set_par_(F_CHAR(name), F_CHAR(par), int name_len, int par_len) {
   char nbuf[64], pbuf[256];
 
-  if (namelen>=sizeof(nbuf)) namelen=sizeof(nbuf)-1;
+  STR_TO_C(nbuf, name);
-  strncpy(nbuf, name, namelen);
+  STR_TO_C(pbuf, par);
-  while (namelen>0 && nbuf[namelen-1]==' ') namelen--; /* trim */
-  nbuf[namelen]='\0';
 
-  if (parlen>=sizeof(pbuf)) parlen=sizeof(pbuf)-1;
+  ERR_I(CocSet(conn, nbuf, pbuf));
-  strncpy(pbuf, par, parlen);
-  while (parlen>0 && pbuf[parlen-1]==' ') parlen--; /* trim */
-  pbuf[parlen]='\0';
-
-  ERR_I(CocSet(*conn, nbuf, pbuf));
 
   return(0);
   OnError: return(-1);
 }
 
-int tecc_get_par_(pTecsClient *conn, char *name, char *par, int namelen, int parlen) {
+int tecs_get_par_(F_CHAR(name), F_CHAR(par), int name_len, int par_len) {
-  int l;
   char nbuf[64], pbuf[256];
 
-  if (namelen>=sizeof(nbuf)) namelen=sizeof(nbuf)-1;
+  STR_TO_C(nbuf, name);
-  strncpy(nbuf, name, namelen);
+  ERR_I(CocGet(conn, nbuf, pbuf));
-  while (namelen>0 && nbuf[namelen-1]==' ') namelen--; /* trim */
+  return(STR_TO_F(par, pbuf));
-  nbuf[namelen]='\0';
-
-  ERR_I(CocGet(*conn, nbuf, pbuf));
-
-  l=strlen(pbuf);
-  if (l>parlen) l=parlen;
-  strncpy(par, pbuf, l);
-  return(l);
   OnError: return(-1);
 }
 
-int tecc_send_(pTecsClient *conn, char *cmd, char *reply, int cmdlen, int replylen) {
+int tecs_send_(F_CHAR(cmd), F_CHAR(reply), int cmd_len, int reply_len) {
-  int l;
   char cbuf[80], rbuf[80];
 
-  if (cmdlen>=sizeof(cbuf)) cmdlen=sizeof(cbuf)-1;
+  STR_TO_C(cbuf, cmd);
-  strncpy(cbuf, cmd, cmdlen);
+  ERR_I(TeccSend(conn, cbuf, rbuf, sizeof(rbuf)));
-  while (cmdlen>0 && cbuf[cmdlen-1]==' ') cmdlen--; /* trim */
+  return(STR_TO_F(reply, rbuf));
-  cbuf[cmdlen]='\0';
-
-  ERR_I(TeccSend(*conn, cbuf, rbuf, sizeof(rbuf)));
-
-  l=strlen(rbuf);
-  if (l>replylen) l=replylen;
-  strncpy(reply, rbuf, l);
-  return(l);
   OnError: return(-1);
 }
 
-pTecsClient tecc_init_(char *server, int *port, int serverlen) {
+int tecs_init_(F_CHAR(startcmd), int *port, int startcmd_len) {
   char sbuf[132];
 
-  if (serverlen>=sizeof(sbuf)) serverlen=sizeof(sbuf)-1;
+  STR_TO_C(sbuf, startcmd);
-  strncpy(sbuf, server, serverlen);
+  ERR_P(conn=TeccInit(sbuf, *port));
-  while (serverlen>0 && sbuf[serverlen-1]==' ') serverlen--; /* trim */
+  return(0);
-  sbuf[serverlen]='\0';
+  OnError: return(-1);  
-  return(TeccInit(sbuf, *port));
 }
 
-#ifdef __VMS
+int tecs_get_(float *temp) {
-#define tecc_get_ tecc_get
+  return(TeccGet(conn, temp));
-#define tecc_get3_ tecc_get3
-#define tecc_set_ tecc_set
-#define tecc_wait_ tecc_wait
-#define tecc_close_ tecc_close
-#define tecc_quit_server_ tecc_quit_server
-#endif
-
-int tecc_get_(pTecsClient *conn, float *temp) {
-  return(TeccGet(*conn, temp));
 }
 
-int tecc_get3_(pTecsClient *conn, float *t1, float *t2, float *t3) {
+int tecs_get3_(float *t1, float *t2, float *t3) {
-  return(TeccGet3(*conn, t1, t2, t3));
+  return(TeccGet3(conn, t1, t2, t3));
 }
 
-int tecc_set_(pTecsClient *conn, float *temp) {
+int tecs_set_(float *temp) {
-  return(TeccSet(*conn, *temp));
+  return(TeccSet(conn, *temp));
 }
 
-int tecc_wait_(pTecsClient *conn) {
+int tecs_wait_(void) {
-  return(TeccWait(*conn));
+  return(TeccWait(conn));
 }
 
-void tecc_close_(pTecsClient *conn) {
+int tecs_is_open_() {
-  TeccClose(*conn);
+  return(conn!=NULL);
 }
 
-int tecc_quit_server_(pTecsClient *conn) {
+void tecs_close_(void) {
-  return(TeccQuitServer(*conn));
+  TeccClose(conn);
+  conn=NULL;
 }
 
-#ifdef __VMS
+int tecs_quit_server_(void) {
-
+  return(TeccQuitServer(conn));
-typedef struct { short size, dummy; char *text; } Desc;
-
-pTecsClient tecc_init(Desc *server, int *port, int serverlen) {
-  return(tecc_init_(server->text, port, server->size));
 }
 
-int tecc_set_par(pTecsClient *conn, Desc *name, Desc *par) {
-  return(tecc_set_par_(conn, name->text, par->text, name->size, par->size));
-}
-
-int tecc_get_par(pTecsClient *conn, Desc *name, Desc *par) {
-  return(tecc_get_par_(conn, name->text, par->text, name->size, par->size));
-}
-
-int tecc_send(pTecsClient *conn, Desc *cmd, Desc *reply) {
-  return(tecc_send_(conn, cmd->text, reply->text, cmd->size, reply->size));
-}
-
-#endif

tecs/tecs_dlog.f

@@ -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)
+	  do i=0,dirlen-1
-	  rrec=2
+	    wdir(i)=0
-	  wrec=2
+	  enddo
-	  wpos=0
+	  stim=0
-	  wn=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
+	! check if value fits in actual record 
-
+	if (wrec .lt. 0) then
-	if ((wpos+1)*(n+1)+2 .gt. recl .or. n .ne. wn) then ! next record
+	  btim=time+1
-	  wrec=wrec+1
+	else
-	  if (wrec .gt. wlim) then
+	  btim=wdir(wrec)
-	    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
+	if (time .lt. btim .or. time .ge. btim+recs*step) then
-	j=wpos*wn
+	  if (.not. update .and. wrec .ge. 0) then
-	do i=1,wn
+	    call dlog_write_block(wrec+2)
-	  wdat(j)=dat(i)
+	    call dlog_write_block(1)
-	  j=j+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)
+	etim=time
-	lastx=time
+	if (update) then
-	call dlog_write_block(1)
+	  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
+	first=stim
-	else
+	last=etim
-	  first=rtim(0)
-	endif
-	last=lastx
 	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))
+!	print *,xmin,xmax
-	imax=nint(min( 2147480000.,xmax))
+	n=min(mdat,ndat)
-
+	nres=0
 	call dlog_read_block(1, done)
 	if (.not. done) return ! record locked
 
-1	continue
+	ftim=max(stim,offset+nint(max(-2147480000.-offset,xmin)))
-	  call dlog_read_block(rrec, done)
+	ltim=min(etim,offset+nint(min( 2147480000.-offset,xmax)))
-	  if (.not. done) return ! record locked
+
-	  do i=0,nl-1
+	do j=1,mdat
-            ix=rtim(i)-offset
+	  ys(j)=0
-	    if (ix .ge. imin .and. ix .le. imax .and. nres .lt. ndim) then
+	  ns(j)=0
-	      nres=nres+1
+	enddo
-	      x(nres)=ix
+
-	      j=i*rn
+	xtim=0
-	      do k=1,min(rn, ndat)
+	rtim=ftim
-	        y(nres,k)=rdat(j)
+	ntim=0
-	        j=j+1
+	d=step
-	      enddo
+
-	      do k=min(rn, ndat)+1,ndat ! fill with zeros
+	do irec=rrec,rrec+dirlen-2
-	        y(nres,k)=0
+	  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
+	  do j=n+1,ndat
-	  rrec=rrec+1
+	    y(nres,j)=undef_value
-	  if (rrec .gt. rlim) then
+	  enddo
-	    rrec=2
+	endif
-	  endif
-	goto 1
-9	continue
-
 	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
+	  write(lunw, rec=recno, iostat=iostat) wdat
-	1   , (wtim(j), (wdat(j*wn+k), k=0,wn-1), j=0,wpos-1)
+!	  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
+	  if (s .eq. 0) then
-	  print *,'DLOG_PUT: record locked'
+	    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
+	  read(lunr, rec=recno, iostat=iostat) rdat
-	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
+	  if (s .eq. 0) then
-	  print *,'DLOG_GET: record locked'
+	    s=secnds(0.0)
-	  done=.false.
+	  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

tecs/tecs_dlog.h

@@ -5,7 +5,7 @@
 
 /* implemented in fortran TECS_DLOG.FOR */
 
-int dlog_open_write_(char *file, int maxsize);
+int dlog_open_write_(char *file);
 /* open dlog file */
 
 int dlog_put_(time_t *time, int *nset, float val[]);

tecs/tecs_dlog.inc

@@ -1,9 +1,11 @@
-	parameter version=104, recl=16
+	parameter version=106, recs=1024, mdat=4, recl=mdat*recs
+	parameter step=5, size=8*24*3600/step, dirlen=size/recs+1
+	parameter undef=-65535.0
 
-	integer lunw, lunl, lunr
+	integer lunw, lunr, wrec, rrec
-	integer vers, wrec, wpos, rrec, rlim, wlim, wn, rn, nl, lastx
+	integer vers, stim, etim
-	integer wtim(0:recl-1), rtim(0:recl-1)
+	logical update
-	real wdat(0:recl-1), rdat(0:recl-1)
+	real wdat(mdat,0:recs-1), rdat(mdat,0:recs-1)
-	common/tecs_dlog_inc/ lunw, lunl, lunr
+	integer wdir(0:dirlen-1), rdir(0:dirlen-1)
-	1, vers, wrec, wpos, rrec, rlim, wlim, wn, rn, nl, lastx
+	common/tecs_dlog_inc/ lunw, lunr, wrec, rrec
-	1, wtim, wdat, rtim, rdat
+	1, vers, stim, etim, update, wdat, rdat, wdir, rdir

tecs/tecs_serial.c

@@ -4,6 +4,7 @@
 #include "rs232c_def.h"
 #include "asynsrv_def.h"
 #include "sinq_prototypes.h"
+#include "sys_util.h"
 #include "err_handling.h"
 #include "tecs_serial.h"
 #include "coc_logfile.h"