diff --git a/tecs/Makefile b/tecs/Makefile index 2c45e534..6fa25d5a 100644 --- a/tecs/Makefile +++ b/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: diff --git a/tecs/coc_client.c b/tecs/coc_client.c index 1443f109..2d393bb4 100644 --- a/tecs/coc_client.c +++ b/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--; diff --git a/tecs/coc_server.c b/tecs/coc_server.c index e5c83825..c697ce7a 100644 --- a/tecs/coc_server.c +++ b/tecs/coc_server.c @@ -15,6 +15,7 @@ #include #include #include +#include "sys_util.h" #include "err_handling.h" #include "coc_logfile.h" #include "coc_server.h" diff --git a/tecs/coc_util.c b/tecs/coc_util.c index d08a57bd..9311cc21 100644 --- a/tecs/coc_util.c +++ b/tecs/coc_util.c @@ -7,6 +7,7 @@ #include #include #include +#include "sys_util.h" #include "err_handling.h" #include "str_util.h" #include "coc_util.h" diff --git a/tecs/err_handling.c b/tecs/err_handling.c index 2f2c3884..2fec2aac 100644 --- a/tecs/err_handling.c +++ b/tecs/err_handling.c @@ -2,6 +2,8 @@ #include #include +#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; - strncpy(buf, text, length); - buf[length]='\0'; + STR_TO_C(buf, text); ErrWrite(buf); } -#ifdef __VMS +void err_txt_(F_CHAR(text), int text_len) { + char buf[256]; -typedef struct { short size, dummy; char *text; } Desc; - -void err_show(Desc *desc) { - err_show_(desc->text, desc->size); + STR_TO_C(buf, text); + ErrTxt(buf,0); } -#endif - void errsetoutrtn_(void (*rtn)(), void *arg) { ErrSetOutRtn(rtn, arg); } diff --git a/tecs/err_handling.h b/tecs/err_handling.h index 466326d2..f977c6fb 100644 --- a/tecs/err_handling.h +++ b/tecs/err_handling.h @@ -1,9 +1,6 @@ #ifndef _ERR_HANDLING_H_ #define _ERR_HANDLING_H_ -#ifdef FORTIFY -#include "fortify.h" -#endif #include #include #include @@ -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; diff --git a/tecs/str_buf.c b/tecs/str_buf.c index 443f105d..efd47026 100644 --- a/tecs/str_buf.c +++ b/tecs/str_buf.c @@ -4,6 +4,7 @@ #include #include #include +#include "sys_util.h" #include "err_handling.h" #include "str_util.h" #include "str_buf.h" diff --git a/tecs/str_util.c b/tecs/str_util.c index e3899681..9f09a3a1 100644 --- a/tecs/str_util.c +++ b/tecs/str_util.c @@ -7,6 +7,7 @@ #include #include #include +#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 + +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); +} diff --git a/tecs/sys_util.h b/tecs/sys_util.h new file mode 100644 index 00000000..b27c5d5e --- /dev/null +++ b/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 add + int _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_ */ diff --git a/tecs/tecs.c b/tecs/tecs.c index 673efa43..71ed28c1 100644 --- a/tecs/tecs.c +++ b/tecs/tecs.c @@ -5,6 +5,7 @@ #include #include #include +#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; - t3[1]=samp.temp; - t3[2]=htr*htr*power*1e-4; - if (t3[2]==0.0) t3[2]=1e-20; - + if (cryo.nSens>0) { + t3[0]=cryo.temp; + } else { + 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*1000remoteMode"); diff --git a/tecs/tecs_cli.c b/tecs/tecs_cli.c index d4ee137d..7e4b0eee 100644 --- a/tecs/tecs_cli.c +++ b/tecs/tecs_cli.c @@ -1,5 +1,6 @@ #include #include +#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; - strncpy(nbuf, name, namelen); - while (namelen>0 && nbuf[namelen-1]==' ') namelen--; /* trim */ - nbuf[namelen]='\0'; + STR_TO_C(nbuf, name); + STR_TO_C(pbuf, par); - if (parlen>=sizeof(pbuf)) parlen=sizeof(pbuf)-1; - strncpy(pbuf, par, parlen); - while (parlen>0 && pbuf[parlen-1]==' ') parlen--; /* trim */ - pbuf[parlen]='\0'; - - ERR_I(CocSet(*conn, nbuf, pbuf)); + 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 l; +int tecs_get_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; - strncpy(nbuf, name, namelen); - while (namelen>0 && nbuf[namelen-1]==' ') namelen--; /* trim */ - nbuf[namelen]='\0'; - - ERR_I(CocGet(*conn, nbuf, pbuf)); - - l=strlen(pbuf); - if (l>parlen) l=parlen; - strncpy(par, pbuf, l); - return(l); + STR_TO_C(nbuf, name); + ERR_I(CocGet(conn, nbuf, pbuf)); + return(STR_TO_F(par, pbuf)); OnError: return(-1); } -int tecc_send_(pTecsClient *conn, char *cmd, char *reply, int cmdlen, int replylen) { - int l; +int tecs_send_(F_CHAR(cmd), F_CHAR(reply), int cmd_len, int reply_len) { char cbuf[80], rbuf[80]; - if (cmdlen>=sizeof(cbuf)) cmdlen=sizeof(cbuf)-1; - strncpy(cbuf, cmd, cmdlen); - while (cmdlen>0 && cbuf[cmdlen-1]==' ') cmdlen--; /* trim */ - 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); + STR_TO_C(cbuf, cmd); + ERR_I(TeccSend(conn, cbuf, rbuf, sizeof(rbuf))); + return(STR_TO_F(reply, rbuf)); 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; - strncpy(sbuf, server, serverlen); - while (serverlen>0 && sbuf[serverlen-1]==' ') serverlen--; /* trim */ - sbuf[serverlen]='\0'; - return(TeccInit(sbuf, *port)); + STR_TO_C(sbuf, startcmd); + ERR_P(conn=TeccInit(sbuf, *port)); + return(0); + OnError: return(-1); } -#ifdef __VMS -#define tecc_get_ tecc_get -#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 tecs_get_(float *temp) { + return(TeccGet(conn, temp)); } -int tecc_get3_(pTecsClient *conn, float *t1, float *t2, float *t3) { - return(TeccGet3(*conn, t1, t2, t3)); +int tecs_get3_(float *t1, float *t2, float *t3) { + return(TeccGet3(conn, t1, t2, t3)); } -int tecc_set_(pTecsClient *conn, float *temp) { - return(TeccSet(*conn, *temp)); +int tecs_set_(float *temp) { + return(TeccSet(conn, *temp)); } -int tecc_wait_(pTecsClient *conn) { - return(TeccWait(*conn)); +int tecs_wait_(void) { + return(TeccWait(conn)); } -void tecc_close_(pTecsClient *conn) { - TeccClose(*conn); +int tecs_is_open_() { + return(conn!=NULL); } -int tecc_quit_server_(pTecsClient *conn) { - return(TeccQuitServer(*conn)); +void tecs_close_(void) { + TeccClose(conn); + conn=NULL; } -#ifdef __VMS - -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 tecs_quit_server_(void) { + return(TeccQuitServer(conn)); } -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 diff --git a/tecs/tecs_dlog.f b/tecs/tecs_dlog.f index 45615786..13c22f0f 100644 --- a/tecs/tecs_dlog.f +++ b/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) - 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 diff --git a/tecs/tecs_dlog.h b/tecs/tecs_dlog.h index 83675599..285947a5 100644 --- a/tecs/tecs_dlog.h +++ b/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[]); diff --git a/tecs/tecs_dlog.inc b/tecs/tecs_dlog.inc index e6bc897e..3f0652a1 100644 --- a/tecs/tecs_dlog.inc +++ b/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 vers, wrec, wpos, rrec, rlim, wlim, wn, rn, nl, lastx - integer wtim(0:recl-1), rtim(0:recl-1) - real wdat(0:recl-1), rdat(0:recl-1) - common/tecs_dlog_inc/ lunw, lunl, lunr - 1, vers, wrec, wpos, rrec, rlim, wlim, wn, rn, nl, lastx - 1, wtim, wdat, rtim, rdat + integer lunw, lunr, wrec, rrec + integer vers, stim, etim + logical update + real wdat(mdat,0:recs-1), rdat(mdat,0:recs-1) + integer wdir(0:dirlen-1), rdir(0:dirlen-1) + common/tecs_dlog_inc/ lunw, lunr, wrec, rrec + 1, vers, stim, etim, update, wdat, rdat, wdir, rdir diff --git a/tecs/tecs_serial.c b/tecs/tecs_serial.c index 37e26263..d82e8283 100644 --- a/tecs/tecs_serial.c +++ b/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"