linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

approved tecs_dlog, added sys_util.c

Browse Source
This commit is contained in:
cvs
2000-05-16 14:01:23 +00:00
parent d9cac91b81
commit 24ae65783a
17 changed files with 407 additions and 240 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
tecs/Makefile
View File

@ -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:

1
tecs/coc_client.c
View File

@ -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--;

1
tecs/coc_server.c
View File

@ -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"

1
tecs/coc_util.c
View File

@ -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"

38
tecs/err_handling.c
View File

@ -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;
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);
}

7
tecs/err_handling.h
View File

@ -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;

1
tecs/str_buf.c
View File

@ -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"

17
tecs/str_util.c
View File

@ -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;

6
tecs/str_util.h
View File

@ -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

13
tecs/sys_util.c Normal file
View File

@ -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);
}

41
tecs/sys_util.h Normal file
View File

@ -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_ */

38
tecs/tecs.c
View File

@ -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;
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*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");

138
tecs/tecs_cli.c
View File

@ -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;
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

320
tecs/tecs_dlog.f
View File

@ -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

2
tecs/tecs_dlog.h
View File

@ -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[]);

18
tecs/tecs_dlog.inc
View File

@ -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

1
tecs/tecs_serial.c
View File

@ -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"