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

improved tecs driver M.Z.

Browse Source
This commit is contained in:
cvs
2004-03-09 15:18:01 +00:00
parent 7422a261ea
commit 55848218a4
23 changed files with 1372 additions and 713 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hardsup/makefile
View File

@ -1,7 +1,5 @@
# this makefile delegates to a version specific makefile
# where this subdirectory is (relative to the sics root)
S_DOWN=psi/hardsup
# where root is (from here)
S_UP=../..

2
makefile
View File

@ -1,7 +1,5 @@
# this makefile delegates to a version specific makefile
# where this subdirectory is (relative to root)
S_DOWN=psi
# where root is
S_UP=..

4
psi.c
View File

@ -309,7 +309,9 @@ static void ConfigureController(char *name, pEVControl pNew,
SConnection *pCon){
EVCSetPar(pNew,"upperlimit",300.0,pCon);
EVCSetPar(pNew,"lowerlimit",1.0,pCon);
if(strcmp(name,"euro") == 0){
if(strcmp(name,"tecs") == 0){
TecsCustomize(pCon, pNew);
} else if(strcmp(name,"euro") == 0){
EVCSetPar(pNew,"upperlimit",750.0,pCon);
EVCSetPar(pNew,"lowerlimit",15.0,pCon);
} else if(strcmp(name,"el755") == 0){

14
tecs/coc_client.c
View File

@ -35,6 +35,8 @@ int CocConnect(CocConn *conn) { /* connect, but do not start */
ERR_SI(setsockopt(conn->fd,SOL_SOCKET,SO_REUSEADDR,&i,sizeof(int))); /* allow quick port reuse */
i=connect(conn->fd, (struct sockaddr *)&sadr, sizeof(sadr));
if (i<0) {
close(conn->fd);
conn->fd=-1;
if (errno==ECONNREFUSED) return(1);
ERR_COD(errno);
}
@ -132,7 +134,7 @@ int CocCheck(CocConn *conn) {
int CocTryCmd(CocConn *conn) {
int iret=-1, siz;
int j;
signal(SIGPIPE, SIG_IGN);
if (conn->fd<0) {
ERR_I(iret=CocConnect(conn)); /* was CocOpen earlier */
@ -290,10 +292,12 @@ int CocGetArray(CocConn *conn, const char *name, float *value, int value_size) {
int CocDoIt(CocConn *conn, char *res, int res_len) {
StrBuf *buf;
int i, pending;
float *arr;
CocArg *a;
char *resp, *t, tag;
int iret=0;
int siz;
assert(conn!=NULL);
ERR_I(CocCmdWithRetry(conn));
buf=&conn->resbuf;
@ -341,7 +345,11 @@ int CocDoIt(CocConn *conn, char *res, int res_len) {
} else if (a->type==ARG_FLT) {
ERR_I(StrGetFloat(buf, (float *)a->adr, COC_SEP));
} else if (a->type==ARG_ARR) {
ERR_I(StrGetArray(buf, (float *)a->adr, a->size));
arr=(float *)a->adr;
ERR_I(siz=StrGetArray(buf, arr, a->size));
while (siz < a->size) { /* fill with zeroes */
arr[siz++]=0.0;
}
resp="<array>";
} else if (a->type==ARG_CHAR) {
ERR_P(StrNGet(buf, (char *)a->adr, a->size, COC_SEP));

2
tecs/coc_util.c
View File

@ -73,7 +73,7 @@ int CocRecv(int fd, StrBuf *buf, int timeout, int *flag) {
fd_set mask;
int i, l;
int siz, n;
if (timeout>=0) {
tmo.tv_sec=timeout;

3
tecs/coc_util.h
View File

@ -5,7 +5,8 @@
#include "myc_buf.h"
#define COC_CMD_LEN 256
#define COC_RES_LEN 16384
/* the follwing should be larger than 4x(largest array)+length of additional parameters */
#define COC_RES_LEN 50000
int CocCreateSockAdr(
struct sockaddr_in *sockaddrPtr, /* Socket address */

15
tecs/didi
View File

@ -1,10 +1,15 @@
#!/bin/tcsh
set what="$1"
set where="$2"
set destlist=( type@osf1 \
AMOR@lnsa14:bin/ DMC@lnsa05:bin/ FOCUS@lnsa16:bin/ \
HRPT@lnsa11:bin/ TASP@lnsa12:bin/ TRICS@lnsa18:bin/ \
HRPT@lnsa11:bin/ TRICS@lnsa18:bin/ \
lnslib@lnsa15:bin/ \
type@linux \
zolliker@llc3:/afs/psi.ch/project/sinq/linux/bin/ \
TASP@pc4478:tasp_sics/ \
TOPSI@pc4120:topsi_sics/ SANS@pc3965:sans_sics/ SANS2@sans2:sans2_sics/ \
)
@ -33,7 +38,9 @@ set items=(TecsServer TecsClient six keep_running cfg)
echo ""
echo " all $items"
echo -n "distribute what: "
set what=$<
if ("$what" == "") then
set what=$<
endif
if ($what == all) then
set what=($items)
endif
@ -41,7 +48,9 @@ endif
echo ""
echo " all $dests"
echo "distribute where: "
set where=$<
if ("$where" == "") then
set where=$<
endif
if ($where == all) then
set where=($dests)
endif

10
tecs/instr_hosts.c
View File

@ -16,11 +16,11 @@ static Instrument list[]={
{ "TRICS", "lnsa18.psi.ch", 9753, "TRICS" , 1},
{ "AMOR", "lnsa14.psi.ch", 9753, "AMOR" , 1},
{ "FOCUS", "lnsa16.psi.ch", 9753, "FOCUS" , 1},
{ "TASP", "lnsa12.psi.ch", 9753, "TASP", 1},
{ "TASP0", "lnsa09.psi.ch", 9753, NULL , 0},
{ "TASP", "pc4478.psi.ch", 9753, "TASP", 1},
{ "RITA", "pc4345.psi.ch", 9753, NULL , 0},
{ "PREP", "lnsa15.psi.ch", 9753, "lnsg" , 2},
{ "AREA", "lnsa15.psi.ch", 9751, "lnsg" , 2},
{ "PREP", "lnsa15.psi.ch", 9751, "lnsg" , 2},
{ "PREP2", "lnsa15.psi.ch", 9756, "lnsg" , 2},
{ "AREA", "lnsa15.psi.ch", 9757, "lnsg" , 2},
{ "TEST", "lnsa15.psi.ch", 9755, "lnslib", 2}
};
@ -61,6 +61,8 @@ int InstrHost(char *input, char *instr, char *host, char *user, char *pcod
lnscode=getenv("LNSCODE");
if (lnscode == NULL) {
sprintf(pcod, "%02dlns%d", tim.tm_year % 100, tim.tm_mon/6+1);
} else if (strlen(lnscode)==3) {
sprintf(pcod, "%c%clns%c", lnscode[0], lnscode[1], lnscode[2]);
} else {
sprintf(pcod, "%02dlns%s", tim.tm_year % 100, lnscode);
}

16
tecs/make_gen
View File

@ -24,12 +24,6 @@ TECLI_OBJ =tecs_client.o tecs_plot.o str.o instr_hosts.o \
HARDSUPLIB = ../hardsup/libhlib.a
#.f.o:
# $(FC) $(FFLAGS) -c $F
#
#.c.o:
# $(CC) $(CFLAGS) -c $C
libtecsl.a: $(CLI_OBJ)
rm -f $@
$(AR) $(ARFLAGS) $@ $Q
@ -43,6 +37,10 @@ test: tecs_cli.c
TecsServer: $(SERV_OBJ) $(HARDSUPLIB) $(FORTIFYOBJ)
$(CC) $(CFLAGS) -o $@ $Q -lm
lsc331: lsc331.o coc_server.o tecs_lsc.o tecs_serial.o coc_logfile.o \
$(LIBR_OBJ) $(HARDSUPLIB) $(FORTIFYOBJ)
$(CC) $(CFLAGS) -o $@ $Q -lm
TecsClient: $(TECLI_OBJ) $(FORTIFYOBJ)
$(FC) -o $@ $Q $(PGLIB) $(RDLIB)
@ -79,12 +77,6 @@ six: six.c term.o sys_select.o libtecsl.a
rexstart: rstart.c myc_str.o myc_err.o instr_hosts.o
$(CC) $(CFLAGS) -o $@ $Q $(FORTIFYOBJ)
@ echo "$(PWD)/rstart"
#
#serverd: serverd.c myc_str.o myc_err.o coc_util.o myc_buf.o
# $(CC) $(CFLAGS) -o $@ $Q $(FORTIFYOBJ)
#
#starts: starts.c myc_str.o myc_err.o coc_util.o myc_buf.o
# $(CC) $(CFLAGS) -o $@ $Q $(FORTIFYOBJ)
clean:
rm -f *.o *.a six keep_running TecsServer TecsClient

4
tecs/makefile
View File

@ -1,8 +1,6 @@
# this makefile delegates to a version specific makefile
# where this subdirectory is (relative to the sics root)
S_DOWN=psi/tecs
# where root is (from here)
S_UP=../..
include $(S_UP)/make_forward
include ../../make_forward

2
tecs/makefile_linux
View File

@ -5,7 +5,7 @@
# Markus Zolliker, March 2003
#--------------------------------------------------------------------------
include ../../linux_def
include $(SRC)../../linux_def
SICST=..
SICS=$(SRC)..

3
tecs/myc_time.h
View File

@ -25,7 +25,8 @@ int mycDate(int time);
int mycTime(int date);
/*
does the inverse of MycDate. Chooses the last possible date not later than today
does the inverse of MycDate. Chooses the last possible date not later than today,
if day, month or year is undefined (zero)
*/
/* the following subroutines are to be called from FORTRAN

143
tecs/six.c
View File

@ -22,27 +22,32 @@ static char pswd1[32]="";
static char user2[32]="";
static char pswd2[32]="";
void Usage(void) {
printf("\n");
printf(" six commandline options:\n");
printf(" - login as spy\n");
printf(" + login as manager\n");
printf(" 0 login as user\n");
printf(" -- set spy as default\n");
printf(" 00 set user as default\n");
printf(" ++ set manager as default\n");
printf(" help show this help text\n");
printf(" -a or a ask always for username/password, forget passwords\n");
printf(" -s or s simulation mode (on some instruments)\n");
printf(" -w or w do not skip welcome message\n");
printf(" -h \"host\" connect to a SICServer on a different host\n");
printf(" no option login with default privilege\n");
void Usage(int cmds_only) {
if (!cmds_only) {
printf("\n");
printf(" six commandline options:\n");
printf(" - login as spy\n");
printf(" + login as manager\n");
printf(" 0 login as user\n");
printf(" -- set spy as default\n");
printf(" 00 set user as default\n");
printf(" ++ set manager as default\n");
printf(" help show this help text\n");
printf(" -a or a ask always for username/password, forget passwords\n");
printf(" -s or s simulation mode (on some instruments)\n");
printf(" -w or w do not skip welcome message\n");
printf(" -h \"host\" connect to a SICServer on a different host\n");
printf(" -p \"port\" connect to a SICServer on a different port\n");
printf(" -n do not login\n");
printf(" no option login with default privilege\n");
}
printf("\n");
printf(" Special commands treated by six (these are no SICS commands!)\n");
printf("\n");
printf(" quit exit six\n");
printf(" exit exit six\n");
printf(" stop interrupt SICS\n");
printf(" help show this help text\n");
printf(" + increase privilege\n");
printf(" - decrease privilege\n");
printf("\n");
@ -350,7 +355,7 @@ int setrights(int gotolevel) {
level=gotolevel;
ERR_I(sendCmd(fd, "config list"));
ERR_P(p=readWrite(fd,10000,1,"UserRights = "));
if (p!=NULL) {
if (*p!='\0') {
level=*p-'0';
}
if (level==3) {
@ -393,11 +398,11 @@ int setrights(int gotolevel) {
int main (int argc, char *argv[]) {
int iret, pos;
fd_set mask;
int l, i, j, port, skip, gotolevel;
int l, i, j, port, skip, gotolevel, sicslogin;
char buf[128], lbuf[16], ilow[64];
char stdPrompt[128], prompt[256];
char *sim="";
char *p, *statusMatch;
char *p, *statusMatch=NULL;
char *pnam[4]={"0", "MANAGER", "user", "spy"};
struct sockaddr_in sadr;
@ -407,6 +412,7 @@ int main (int argc, char *argv[]) {
printf("---------------------------------------------------\n");
port=1301;
skip=1;
sicslogin=1;
j=0;
deflevel=0;
gotolevel=0;
@ -434,27 +440,40 @@ int main (int argc, char *argv[]) {
gotolevel=2;
deflevel=2;
} else if (0==strcmp(argv[i], "help")) {
Usage();
Usage(0);
return 0;
} else if (0==strcmp(argv[i], "-h")) {
i++;
if (i>=argc) {
printf("missing host\n");
Usage(); return 0;
Usage(0); return 0;
}
host=argv[i];
} else if (0==strcmp(argv[i], "-p")) {
i++;
if (i>=argc) {
printf("missing port\n");
Usage(0); return 0;
}
port=atoi(argv[i]);
if (port == 0) {
printf("illegal port\n");
Usage(0); return 0;
}
} else if (0==strcmp(argv[i], "-n")) {
sicslogin=0;
} else {
if (strlen(argv[i])>=32) {
printf("argument too long\n");
Usage(); return 0;
Usage(0); return 0;
} else if (argv[i][0]!='-') {
if (j==0) {
printf("syntax has changed, username can not be given as argument\n");
Usage(); j=1;
Usage(0); j=1;
}
} else {
printf("unknown option: %s\n", argv[i]);
Usage(); return 0;
Usage(0); return 0;
}
}
}
@ -462,38 +481,44 @@ int main (int argc, char *argv[]) {
ERR_SI(fd=socket(AF_INET, SOCK_STREAM, 0));
term_reg_socket(fd);
ERR_SI(connect(fd, (struct sockaddr *)&sadr, sizeof(sadr)));
ERR_I(sendCmd(fd, "sicslogin Spy 007"));
ERR_P(p=readWrite(fd,10000,skip,"SICS"));
if (*p=='\0') {
printf("rejected\n");
return 0;
}
if (skip) printf("reading welcome message ...\n");
if (sicslogin) {
ERR_I(sendCmd(fd, "sicslogin Spy 007"));
ERR_P(p=readWrite(fd,10000,skip,"SICS"));
if (*p=='\0') {
printf("rejected\n");
return 0;
}
if (skip) printf("reading welcome message ...\n");
ERR_I(sendCmd(fd, "status interest"));
ERR_P(readWrite(fd,10000,0,"OK"));
ERR_I(sendCmd(fd, "status interest"));
ERR_P(readWrite(fd,10000,0,"OK"));
ERR_I(sendCmd(fd, "Instrument"));
ERR_P(p=readWrite(fd,10000,0,"Instrument = "));
str_copy(instr, p);
if (*instr=='\0') {
printf("can not detect instrument\n");
return 0;
}
p=strchr(instr,' ');
if (p!=NULL) *p='\0';
if (0==strcmp(instr,"SANS-II")) {
str_copy(instr, "SANS2");
}
ERR_I(i=setrights(gotolevel));
if (i==1) return 0;
printf("\rlogged in to SICS as %s on %s\n", pnam[level], instr);
ERR_I(sendCmd(fd, "Instrument"));
ERR_P(p=readWrite(fd,10000,0,"Instrument = "));
str_copy(instr, p);
if (*instr=='\0') {
printf("can not detect instrument\n");
return 0;
}
p=strchr(instr,' ');
if (p!=NULL) *p='\0';
if (0==strcmp(instr,"SANS-II")) {
str_copy(instr, "SANS2");
}
ERR_I(i=setrights(gotolevel));
if (i==1) return 0;
printf("\rlogged in to SICS as %s on %s\n", pnam[level], instr);
str_lowcase(ilow,instr);
sprintf(stdPrompt, "six[%s] ", ilow);
str_lowcase(ilow,instr);
sprintf(stdPrompt, "six[%s] ", ilow);
ERR_I(sendCmd(fd, "status"));
ERR_P(p=readWrite(fd,10000,0,"status = "));
ERR_I(sendCmd(fd, "status"));
ERR_P(p=readWrite(fd,10000,0,"status = "));
} else {
sprintf(stdPrompt, "six[%s] ", host);
p="E";
}
iret=1;
buf[0]='\0';
@ -514,7 +539,7 @@ int main (int argc, char *argv[]) {
str_lowcase(lbuf, buf);
if (0==strcmp(lbuf,"quit")) break;
if (0==strcmp(lbuf,"exit")) break;
statusMatch="status = ";
if (sicslogin) statusMatch="status = ";
skip=0;
printf("\n");
if (0==strcmp(lbuf,"stop")) {
@ -542,14 +567,16 @@ int main (int argc, char *argv[]) {
}
skip=1;
strcpy(buf, "status");
} else if (0==strcmp(buf, "help")) {
Usage(1);
strcpy(buf, "status");
} else if (0==strcmp(buf, "six help")) {
Usage();
Usage(0);
strcpy(buf, "status");
} else if (0==strcmp(buf, "")) {
strcpy(buf, "status");
statusMatch=NULL;
}
ERR_I(sendCmd(fd, buf));
ERR_P(p=readWrite(fd,1000,skip,statusMatch));
buf[0]='\0';
@ -559,13 +586,15 @@ int main (int argc, char *argv[]) {
} else { /* socket iret ready to read */
assert(fd==iret);
ERR_P(p=readWrite(fd,1000,0,"status = "));
if (strcmp(p, "0") == 0) {
printf("\nconnection lost\n");
break;
}
}
}
fputs("\n", stdout);
term_save_hist(1); /* save history wihtout last line */
term_save_hist(1); /* save history without last line */
return 0;
Usage:
return 0;
OnError:
ErrShow("end");
return 0;

1034
tecs/tecs.c
View File

File diff suppressed because it is too large Load Diff

11
tecs/tecs_cli.c
View File

@ -28,7 +28,7 @@ pTecsClient TeccStart(char *startcmd, char *host, int port) {
gethostname(thishost, sizeof(thishost));
th=getenv(thishost);
if (th==NULL) th=thishost;
if (0!=strcmp(th, host)) {
if (0!=strcmp(th, host) && host!=strstr(host, th)) {
code=rdCode;
cmd="";
}
@ -36,7 +36,9 @@ pTecsClient TeccStart(char *startcmd, char *host, int port) {
ERR_I(iret=CocInitClient(conn, host, port, code, 0, cmd));
if (iret==1) ErrShort("TECS_INIT: can not connect to TecsServer");
return((pTecsClient)conn);
OnError: return(NULL);
OnError:
if (conn!=NULL) FREE(conn);
return NULL;
}
pTecsClient TeccInit(char *startcmd, int port) {
@ -215,7 +217,8 @@ int F_FUN(tecs_get_mult)(F_CHAR(names), int *time, int *nvalues, float values[],
while (nams!=NULL && i < *nvalues) {
nams=str_split(nam, nams, ' ');
if (nam[0]!='\0') {
ERR_I(CocGetFloat(conn, nam, values+i));
values[i]=DATA_UNDEF;
CocGetFloat(conn, nam, values+i);
i++;
}
}
@ -303,7 +306,7 @@ int F_FUN(tecs_get_data)(F_CHAR(names), int *startTime, int *endTime, int *step,
, int retLen[], int names_len) {
char nam[64];
char str[128];
float offset, fact, *py, data[8192];
float offset, fact, *py, data[COC_RES_LEN/4-100];
int i, j, k, l, iret;
if (*endTime - *startTime > *step * (*maxLen-1)) {

56
tecs/tecs_client.f
View File

@ -37,10 +37,12 @@
oneCommand=.true.
port=instr_host(line, inst, host, user, pcod)
else
call sys_getenv('HOST', line)
port=instr_host(line, inst, host, user, pcod)
oneCommand=.false.
port=0
endif
call sys_getenv('TECS_START', start)
if (port .gt. 0) then
if (port .eq. 1) port=9753
@ -60,26 +62,12 @@
if (oneCommand) goto 11
print *
print *,'Tecs Client'
print *,'-----------'
print *
print *,'set <temp> set temperature'
print *,'send <command> direct command to LSC340'
print *,'device <device> set cryo device'
print *,'<parameter> show parameter'
print *,'<parameter> <value> set parameter'
print *
print *,'<empty line> show summary'
print *,'plot <var> chart for temperature and <var>'
1 ,' var = P (default), He, Aux'
print *,'log <n> show last n lines of logfile'
print *,'remote set to remote mode'
print *,'reset reset alarms'
print *,'kill shut down TecsServer'
print *,'restart restart TecsServer'
print *,'exit,quit exit tecs client'
print *,'help show list of parameters and cryo devices'
line='tecs'
line(52-i:64)='connected to '//inst(1:i)
print '(x,64(''-''))'
print '(x,a)',line(1:64)
print '(x,64(''-''))'
print '(33x,a)','type help for a list of commands'
print *
l=0
@ -180,7 +168,26 @@
call tecs_plot(' ')
elseif (cmd .eq. 'help') then
print *
print *,'Writeable parameters:'
print *,'tecs client commands (can not be used from SICS)'
print *
print *,'<empty line> show summary'
print *,'plot chart for temperature'
print *,'log <n> show last n lines of logfile'
print *,'remote set to remote mode'
print *,'reset reset alarms'
print *,'kill shut down TecsServer'
print *,'restart restart TecsServer'
print *,'exit, quit exit tecs client'
print *
print *,'commands/parameters:'
print *
print *,' From tecs: <parameter> show parameter'
print *,' <parameter> <value> set parameter'
print *
print *,' From SICS: tt <parameter> show parameter'
print *,' tt <parameter> <value> set parameter'
print *
print *,'changeable parameters:'
print *
print *,'set temperature set-point'
print *,'device temperature device'
@ -193,14 +200,15 @@
print *,'deriv PID derivation term'
print *,'maxShift maximum (set-tempH) for controlMode=2'
print *,'int2 integration time (sec) for controlMode=2'
print *,'tLimit temperature limit'
! print *,'remoteMode 1: local, 2: remote'
print *,'send direct command to LSC340'
print *
print *,'Read only parameters:'
print *,'read only parameters:'
print *
print *,'Tm main temperature'
print *,'Ts sample temperature'
print *,'Tr set-point on regulation'
print *,'tLimit temperature limit'
print *,'helium helium level'
print *,'htr heater current percentage'
print *,'resist heater resistance'

7
tecs/tecs_data.c
View File

@ -204,6 +204,7 @@ int Put(Set *set, int time, float value) {
int t, try = 1;
int size;
float last;
static int errcnt=0;
ERR_P(set);
if (value == DATA_UNDEF) return 0;
@ -221,9 +222,13 @@ int Put(Set *set, int time, float value) {
}
if (t<0) {
if (t<-1) {
logfileOut(LOG_MAIN, "%s %d <? %d\n", set->set.name, time, r->endTime);
if (errcnt<4) {
errcnt++;
logfileOut(LOG_MAIN, "%s %d <? %d\n", set->set.name, time, r->endTime);
}
ERR_MSG("back in time not possible");
}
if (errcnt>0) errcnt--;
t=0;
}
if (t == 0) {

638
tecs/tecs_plot.f
View File

@ -1,10 +1,11 @@
subroutine tecs_plot(auxpar)
subroutine tecs_plot(reserved)
character*(*) auxpar
integer dmax, nmax, tmax, amax, nmenu, chartperiod, naux
parameter (dmax=400, nmax=10, tmax=9, amax=3, nmenu=13
character*(*) reserved
integer dmax, nmax, nmenu, chartperiod, naux, nwin
parameter (dmax=1024, nmax=12, nmenu=13, nwin=4
1 , chartperiod=5, naux=1)
! dmax*nmax*4 should be less than COC_RES_LEN in coc_util.h
integer minRange, maxRange, oneDay
parameter (minRange=60, maxRange=7*24*3600, oneDay=24*3600)
integer zoom, right, live
@ -12,74 +13,95 @@
real winmin, undef
parameter (winmin=60., undef=-1.125/1024./1024./1024.)
real*4 x1,x2,xmin,xmax,ymin(2),ymax(2),window
real*4 x1,x2,xmin,xmax,ymin(nwin),ymax(nwin),window
real*4 xd(dmax, nmax),yd(dmax,nmax), yy0(nmax), yy1(nmax)
real*4 ylast1,ylast2,y1,y2
real*4 ex,ey,fx,fy,row,ticks,tim0,tim1,menuwid
real*4 dx,dy
integer l,j,i,n,t,leng,i1,i2,rl,startday,thisday
integer ncol, nset, mode
real*4 ylim(nmax) ! limits of sensor label text
integer l,j,n,t,leng,i1,i2,rl,startday,thisday
integer iostat
integer nset
integer ncol, mode
integer is ! 1...nset
integer im ! 1...nmax
integer first,last,step,tbase,lastj
integer colorList(nmax)/5,3,2,4,6,8,14,15,9,8/
integer color(nmax)
integer retLen(nmax)
integer sel/0/, sel1, sel2, auxsel/1/
logical focus(nmax)/3*.true.,9*.false./
logical omit(nmax)/12*.false./
logical fixleft/.false./
integer winconf(nwin) ! number of windows below actual
integer showsets
real winh
integer nticks
character key*1
character text(2,nmenu)*16/
1 'L' ,'live off'
1 ,'z' ,'sel. zoom'
1 ,'+' ,'zoom in'
1 ,'-' ,'zoom out'
1 ,'x' ,'show all'
1 ,'2d' ,'2 days'
1 ,'1h' ,'1 hour'
1 ,'15m' ,'15 min'
1 ,'31.7t','goto date'
1 ,'c' ,'show P/He/Aux'
1 ,'s' ,'select T'
1 ,'a' ,'all chan'
1 ,'c' ,'clear chan'
1 ,'s' ,'focus'
1 ,'f' ,'write file'
1 ,'q' ,'quit'/
character weekdays(7)*4/
1 'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/
character buf*8, device*8, name*40, filnam*128, numb*16
character title*64, pars*64
character*4 tpar(tmax)/'Te','Tr','Tm','Ts','Tk','T1','T2','T3','T4'/
character*4 apar(amax)/'P', 'He', 'Aux'/
character*16 parnam(nmax)
character title*64, pars*64, allpars*64
character*4 parnam(nmax)
1 /'Tm','Ts','Tr','Te','Tk','T1','T2','T3','T4','P','He','Aux'/
integer unit(nmax)
1 / 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 4/ ! 1: Kelvin, 2: Watt, 3: %, 4: other
integer color(nmax)
1 / 2, 4, 3, 5, 6, 8, 14, 15, 13, 2, 2, 2/
integer isx(nmax)/12*1/ ! at begin all channels selected
integer imx(nmax)
save imx
integer idx(nmax)
logical gap, done
logical saveit
integer iret, lund, numl, mon, day
integer pars_len, title_len, text_len, name_len
integer idx(nmax)
character line*132
real x0
logical loop
integer tdif
integer fact
! functions
integer myc_now, myc_time, myc_date, get_data
integer tecs_get_mult, tecs_get_par
integer pgopen
data window/0./
fact=1
read(reserved, *, iostat=iostat) fact
if (fact .lt. 1) fact=1
if (window .eq. 0) window=1800.
saveit=.false.
mode=live
call pgopen(' ')
iret=pgopen(' ')
call pgqinf('TYPE', device, l)
if (device .eq. 'NULL') then
if (device .eq. 'NULL' .or. iret .le. 0) then
call pgclos
call pgopen('?')
iret=pgopen('?')
call pgqinf('TYPE', device, l)
if (device .eq. 'NULL') then
if (device .eq. 'NULL' .or. iret .le. 0) then
print *,'No PGPLOT-Device defined'
goto 9
endif
call sys_setenv('PGPLOT_DEV', '/'//device)
endif
call pgqcol(i,ncol)
! print *,i,ncol,' colors ',device
call pgqcol(j,ncol)
! print *,j,ncol,' colors ',device
if (ncol .ge. 8 .and. device .ne. 'VT125') then
call pgscr(0, 1.0, 1.0, 1.0)
call pgscr(1, 0.0, 0.0, 0.0)
@ -97,38 +119,67 @@
l=0
x1=0
step=0
do i=1,amax
if (auxpar .eq. apar(i)) then
auxsel=i
allpars=' '
do im=1,nmax
call str_trim(allpars, allpars, l)
allpars=allpars(1:l)//' '//parnam(im)
enddo
showsets=1
1 continue
iret=tecs_get_mult(allpars, t, nmax, yy1)
if (iret .lt. 0) goto 99
tdif=myc_now()-t
tdif=tdif-mod(tdif+1800*25, 3600)+1800 ! round to next full hour
if (tdif .ne. 0) then
print *,'time difference ',tdif
endif
t=t+tdif
if (showsets .eq. 1) then ! select only channels which have NOW a signal
do im=1,nmax
if (isx(im) .eq. 0 .and. yy1(im) .ne. undef) then
isx(im)=1
endif
enddo
else if (showsets .eq. 2) then ! select all channels
do im=1,nmax
isx(im)=1
enddo
endif
is=0
pars=' '
do im=1,nmax
if (omit(im)) then
isx(im)=0
omit(im)=.false.
else if (isx(im) .ne. 0) then
is=is+1
isx(im)=is
imx(is)=im
call str_trim(pars, pars, pars_len)
pars=pars(1:pars_len)//' '//parnam(im)
endif
enddo
nset=is
1 pars=' '
nset=0
do i=1,tmax
nset=nset+1
color(nset)=colorList(i)
parnam(nset)=tpar(i)
call str_trim(pars, pars, pars_len)
pars=pars(1:pars_len)//' '//parnam(nset)
enddo
nset=nset+1
color(nset)=colorList(3)
parnam(nset)=apar(auxsel)
call str_trim(pars, pars, pars_len)
pars=pars(1:pars_len)//' '//parnam(nset)
iret=tecs_get_mult(pars, t, nset, yy0)
if (iret .lt. 0) goto 99
if (window .eq. 0) then
last=t
step=maxRange/dmax
window=maxRange
first=t-min(dmax*step-1,maxRange-step)
else if (mode .ge. right) then
last=t
if (fixleft) then
window=last-tbase-x1
fixleft=.false.
endif
step=window/(dmax-2)+0.99
last=t
first=t-min(dmax*step-1,nint(window))
if (first .ne. t-nint(window)) then
print *,'t-shift',first-(t-nint(window))
endif
else
if (mode .eq. zoom) then
x2=(x1+x2+window)/2
@ -145,7 +196,7 @@
step=(step+59)/60*60
else if (step .gt. 30) then
step=60
elseif (step .gt. 20) then
else if (step .gt. 20) then
step=30
else
step=(step+4)/5*5
@ -153,7 +204,7 @@
first=last-(last-first+step-1)/step*step ! round first
! print *,step,last-first
tbase=first-mod(first,7*oneDay)
iret=get_data(pars, first, last, step, tbase
iret=get_data(pars, first-tdif, last-tdif, step*fact, tbase-tdif
1 , xd, yd, dmax, nmax, retLen)
if (iret .lt. 0) goto 99
@ -164,47 +215,112 @@
x1 = first - tbase
endif
tim0=t-tbase
do i=1,nset
leng=retLen(i)
do while (leng .gt. 1 .and. yd(leng,i) .eq. undef)
do is=1,nset
im=imx(is)
leng=retLen(is)
do while (leng .gt. 1 .and. yd(leng,is) .eq. undef)
leng=leng-1
enddo
if (leng .eq. 1) leng=0
retLen(i)=leng
if (mode .eq. live .and. leng .gt. 0) then
xd(leng,i)=tim0
yd(leng,i)=yy0(i)
retLen(is)=leng
yy0(is)=yy1(im)
if (leng .gt. 0) then
if (mode .eq. live) then
xd(leng,is)=tim0
yd(leng,is)=yy0(is)
endif
omit(im)=.false.
! else if (showsets .eq. 2) then ! next time omit unused channels
! omit(im)=.true.
endif
enddo
if (sel .ne. 0) then
do while (sel .lt. nset .and. retLen(sel) .eq. 0)
sel=sel+1
showsets=0
j=0
do im=1,nmax
is=isx(im)
if (focus(im)) then
if (is .ne. 0 .and. unit(im) .eq. 1) then
if (retLen(is) .gt. 0) then
j=j+1 ! focus o.k.
goto 2
endif
endif
focus(im)=.false.
if (j .eq. 0 .and. im .lt. nmax) focus(im+1)=.true.
2 continue
endif
enddo
if (j .eq. 0) then ! no T-channel in focus: select all
do is=1,nset
im=imx(is)
if (retLen(is) .gt. 0 .and. unit(im) .eq. 1) focus(im)=.true.
enddo
if (sel .ge. nset) sel = 0
endif
if (saveit) goto 9
if (mode .eq. live) then
x2=max(tim0,x2)+min(1800., window*0.5)
endif
if (window .gt. 50*3600) then
ticks=8*3600
elseif (window .gt. 25*3600) then
ticks=4*3600
if (window .gt. 36*3600) then
ticks=12*3600
if (window .lt. 60*3600) then
nticks=6
else
nticks=2
endif
elseif (window .gt. 18*3600) then
ticks=6*3600
if (window .lt. 30*3600) then
nticks=6
else
nticks=3
endif
elseif (window .gt. 10*3600) then
ticks=2*3600
nticks=2
elseif (window .gt. 3*3600) then
ticks=3600
if (window .lt. 5*3600) then
nticks=6
else
nticks=2
endif
elseif (window .gt. 6000) then
ticks=1200
nticks=2
elseif (window .gt. 1800) then
ticks=600
if (window .lt. 3600) then
nticks=5
else
nticks=2
endif
elseif (window .gt. 900) then
ticks=300
nticks=5
elseif (window .gt. 600) then
ticks=120
nticks=2
elseif (window .gt. 120) then
ticks=60
if (window .lt. 300) then
nticks=6
else
nticks=2
endif
else
ticks=0.0 ! automatic
ticks=30
nticks=3
endif
i1=1
i2=nset-naux
if (sel .eq. 0) then
sel1=i1
sel2=i2
else
sel1=sel
sel2=sel
endif
do rl=1,2
do rl=1,nwin
winconf(rl)=nwin-rl ! number of windows to follow
enddo
do rl=1,nwin
if (mode .eq. zoom .and. rl .eq. 1) then
ymin(1)=y1
ymax(1)=y2
@ -213,19 +329,22 @@
ymax(rl)=-1e30
ylast1=ymin(rl)
ylast2=ymax(rl)
do i=sel1,sel2
do j=1,retLen(i)
if (yd(j,i) .ne. undef) then
ymin(rl)=min(ymin(rl),yd(j,i))
ymax(rl)=max(ymax(rl),yd(j,i))
endif
enddo
do j=max(1,retLen(i)-4),retLen(i)
if (yd(j, i) .ne. undef) then
ylast1=min(ylast1,yd(j, i))
ylast2=max(ylast2,yd(j, i))
endif
enddo
do is=1,nset
im=imx(is)
if (unit(im) .eq. rl .and. (focus(im) .or. rl .gt. 1)) then
do j=1,retLen(is)
if (yd(j,is) .ne. undef) then
ymin(rl)=min(ymin(rl),yd(j,is))
ymax(rl)=max(ymax(rl),yd(j,is))
endif
enddo
do j=max(1,retLen(is)-4),retLen(is)
if (yd(j,is) .ne. undef) then
ylast1=min(ylast1,yd(j, is))
ylast2=max(ylast2,yd(j, is))
endif
enddo
endif
enddo
ey=(ymax(rl)-ymin(rl))
@ -239,89 +358,109 @@
endif
if (ymax(rl) .lt. ymin(rl)) then
do j=1,rl-1
winconf(j)=winconf(j)-1
enddo
ymax(rl)=1.0
ymin(rl)=0
elseif (ymax(rl) .eq. ymin(rl)) then
ymax(rl)=ymin(rl)*1.00001+1.0
ymin(rl)=-1.0e-3
endif
enddo
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
winh=0.9/(winconf(1)+3.5)
do i=i1,i2
call pgsci(color(i))
l=0
lastj=1
do j=1,retLen(i)
if (yd(j,i) .eq. undef) then
if (j .gt. lastj) then
call pgline(j-lastj, xd(lastj,i), yd(lastj,i))
do rl=1,nwin
if (rl .gt. 1) then
if (winconf(rl) .eq. winconf(rl-1)) goto 6 ! window empty
endif
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
do is=nset,1,-1
im=imx(is)
if (unit(im) .eq. rl) then
call pgsci(color(im))
l=0
lastj=1
do j=1,retLen(is)
if (yd(j,is) .eq. undef) then
if (j .gt. lastj) then
call pgline(j-lastj, xd(lastj,is), yd(lastj,is))
endif
lastj=j+1
else
l=j
endif
lastj=j+1
else
l=j
endif
enddo
if (retLen(i) .gt. lastj)
1 call pgline(retLen(i)+1-lastj, xd(lastj,i), yd(lastj,i))
retLen(i)=l
enddo
if (retLen(is) .gt. lastj)
1 call pgline(retLen(is)+1-lastj, xd(lastj,is), yd(lastj,is))
retLen(is)=l
endif
enddo
call pgsci(1)
if (rl .eq. 1) then
call pgsch(1.0)
call pgtbox('ZHXYBINST', ticks, 0, 'BCINMST', 0.0, 0)
call pgtbox('ZHXYBINST', ticks, nticks, 'BCINMST1', 0.0, 0)
call pgtbox('C', 0.0, 0, ' ', 0.0, 0)
ey=0.0
do i=i1,i2
if (retLen(i) .gt. 0) then
name=parnam(i)
do is=1,nset
im=imx(is)
if (unit(im) .eq. rl .and. retLen(is) .gt. 0) then
name=parnam(im)
if (name .eq. 'Tm') then
name='Main Sensor'
name='Main'
elseif (name .eq. 'Ts') then
name='Sample Sensor'
name='Sample'
elseif (name .eq. 'Tr') then
name='SetPoint'
name='Set'
endif
call str_trim(name, name, name_len)
if (sel .eq. i) then
if (focus(im)) then
name=name(1:name_len)//'*'
call str_trim(name, name, name_len)
endif
call pglen(5, name(1:name_len), fx, fy)
call pgsci(color(i))
call pgsci(color(im))
call pgmtxt ('L', 2.5, ey, 0.0, name(1:name_len))
ey=ey+fy+0.04
endif
ylim(is)=ymin(1)+(ey-0.02)*(ymax(1)-ymin(1))
enddo
call pgsci(1)
call pgmtxt ('L', 2.5, ey, 0.0, 'T [K]')
else
call pgsch(0.7)
call pgtbox('ZCIST', ticks, 0, 'BCVINMST', 0.0, 0)
call pgtbox('B', 0.0, 0, ' ', 0.0, 0)
call pgsci(color(nset))
call pgsch(1.0)
if (parnam(nset) .eq. 'P' .or. parnam(nset) .eq. 'p') then
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Power [W]')
elseif (parnam(nset) .eq. 'He') then
title='%'
iret=tecs_get_par('heUnits', title, 0)
call str_trim(title, title, title_len)
call pgmtxt ('L', 2.5, 0.5, 0.5,
1 'Helium ['//title(1:title_len)//']')
else
call pgmtxt ('L', 2.5, 0.5, 0.5, parnam(nset))
do is=1,nset
im=imx(is)
if (unit(im) .eq. rl) goto 5
enddo
im=0
5 if (im .ne. 0) then
call pgsch(4*winh)
call pgtbox('ZCIST', ticks, nticks, 'BINST1', 0.0, 0)
call pgtbox('B', 0.0, 0, 'CIVMST', 0.0, 0)
call pgsci(color(im))
call pgsch(1.0)
if (parnam(im) .eq. 'P' .or. parnam(im) .eq. 'p') then
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Power [W]')
elseif (parnam(im) .eq. 'He') then
title='%'
iret=tecs_get_par('heUnits', title, 0)
call str_trim(title, title, title_len)
call pgmtxt ('L', 2.5, 0.5, 0.5,
1 'Helium ['//title(1:title_len)//']')
else
call pgmtxt ('L', 2.5, 0.5, 0.5, parnam(im))
endif
endif
endif
i1=nset-naux+1
i2=nset
sel1=i1
sel2=i2
6 continue
enddo
call pgsch(0.7)
rl=1
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
call pgsci(1)
call pgsclp(0)
@ -330,14 +469,13 @@
else
text(2,1)='live on'
endif
text(2,10)='show '//apar(mod(auxsel,3)+1)
menuwid=0.0
do i=1,nmenu
call str_trim(text(2,i), text(2,i), text_len)
call pglen(5, text(2,i)(1:text_len), fx, fy)
call pgmtxt('T', 3.0, menuwid, 0.0, '|'//text(1,i))
do j=1,nmenu
call str_trim(text(2,j), text(2,j), text_len)
call pglen(5, text(2,j)(1:text_len), fx, fy)
call pgmtxt('T', 3.0, menuwid, 0.0, '|'//text(1,j))
call pgmtxt('T', 2.5, menuwid, 0.0, '|')
call pgmtxt('T', 2.0, menuwid, 0.0, '|'//text(2,i))
call pgmtxt('T', 2.0, menuwid, 0.0, '|'//text(2,j))
menuwid=menuwid+fx+0.01
enddo
call pgmtxt('T', 3.0, menuwid, 0.0, '|')
@ -349,14 +487,14 @@
done=.false.
row=(ymax(rl)-ymin(rl))/30.
ey=ymin(rl)-row*3.5
i=max(0,int((x1+oneDay/2)/oneDay))
j=max(0,int((x1+oneDay/2)/oneDay))
ex=(i+0.5)*oneDay
ex=(j+0.5)*oneDay
do while (ex .le. x2)
done=.true.
write(buf,'(i8.8)') myc_date(nint(ex)+tbase)
call pgptxt(ex, ey, 0.0, 0.5,
1 weekdays(mod(i,7)+1)//buf(7:8)//'.'//buf(5:6))
1 weekdays(mod(j,7)+1)//buf(7:8)//'.'//buf(5:6))
ex=ex-12*3600
if (ex .gt. x1) then
call pgmove(ex, ey)
@ -367,41 +505,43 @@
call pgmove(ex, ey)
call pgdraw(ex, ey+row)
endif
i=i+1
ex=(i+0.5)*oneDay
j=j+1
ex=(j+0.5)*oneDay
enddo
if (.not. done) then
n=nint(x2)/oneDay*oneDay
i=nint(x1)-n
l=nint(x1)-n
j=nint(x2)-n
if (i .lt. 0) then
if (-i .gt. j) then
if (l .lt. 0) then
if (-l .gt. j) then
ex=0.0
i=nint(x1)+tbase
l=nint(x1)+tbase
else
ex=1.0
i=nint(x2)+tbase
l=nint(x2)+tbase
endif
else
ex=0.5
i=nint(x2)+tbase
l=nint(x2)+tbase
endif
thisday=mod(i/oneDay,7)+1
write(buf,'(i8.8)') myc_date(i)
thisday=mod(l/oneDay,7)+1
write(buf,'(i8.8)') myc_date(l)
call pgmtxt('B', 3.5, ex, ex,
1 weekdays(thisday)//buf(7:8)//'.'//buf(5:6))
endif
iret=tecs_get_par('device', title, 0)
if (iret .lt. 0) goto 99
i=index(title, '(')
if (i .gt. 2 ) then
title=title(1:i-1)
else
j=index(title, '(')
if (j .gt. 2 ) then
title=title(1:j-1)
else if (title .eq. ' ') then
title='test - no device'
endif
call pgmtxt('T', -1.5, 0.02, 0.0, title)
if (mode .eq. live) then
call pgmtxt('T', -1.5, 0.02, 0.0, title)
endif
call pgsclp(1)
call purge_keys ! purge buffer
@ -414,52 +554,52 @@
! call pgmtxt('T', 0.5, 0.0, 0.0, 'LIVE MODE (click on text window before pressing any further key)')
! endif
! call get_key(key, 0, chartperiod)
i=chartperiod-mod(myc_now(), chartperiod)
call get_cursor(ex, ey, key, -i)
j=chartperiod-mod(myc_now(), chartperiod)
call get_cursor(ex, ey, key, -j)
do while (key .eq. char(0) .or. key .eq. ' ') ! no key or space key pressed
iret=tecs_get_mult(pars, t, nset, yy1)
if (iret .lt. 0) goto 99
t=t+tdif
tim1=t-tbase
if (tim1 .gt. x2) then
call pgpage
window=x2-x1
fixleft=.true.
goto 1
endif
if (tim1 .gt. tim0) then
i1=1
i2=nset-naux
do rl=1,2
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
do i=i1,i2
if (yy0(i) .ne. undef .and. yy1(i) .ne. undef) then
if ((sel .eq. 0 .or. sel .eq. i) .and.
1 (yy1(i) .lt. ymin(rl) .or.
1 yy1(i) .gt. ymax(rl))) then
call pgpage
window=x2-x1
goto 1
do rl=1,nwin
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
do is=nset,1,-1
im=imx(is)
if (unit(im) .eq. rl) then
if (yy0(is) .ne. undef .and. yy1(is) .ne. undef) then
if ((focus(im) .or. unit(im) .gt. 1) .and.
1 (yy1(is) .lt. ymin(rl) .or.
1 yy1(is) .gt. ymax(rl))) then
call pgpage
fixleft=.true.
goto 1
endif
call pgsci(color(im))
call pgmove(tim0, yy0(is))
call pgdraw(tim1, yy1(is))
endif
call pgsci(color(i))
call pgmove(tim0, yy0(i))
call pgdraw(tim1, yy1(i))
yy0(is)=yy1(is)
endif
yy0(i)=yy1(i)
enddo
i1=nset-naux+1
i2=nset
enddo
tim0=tim1
endif
i=chartperiod-mod(myc_now(), chartperiod)
call get_cursor(ex, ey, key, -i)
j=chartperiod-mod(myc_now(), chartperiod)
call get_cursor(ex, ey, key, -j)
enddo
else
call get_cursor(ex, ey, key, 0)
endif
rl=1
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
8 if (key .ge. 'a') key=char(ichar(key)-32)
if (key .eq. '-') then
@ -547,19 +687,19 @@
goto 7
elseif (key .eq. 'D') then
ex=1
read(numb, *, iostat=i) ex
read(numb, *, iostat=iostat) ex
window=min(maxRange,max(minRange, nint(oneDay*ex)))
if (mode .lt. right) mode=right
x1=0
elseif (key .eq. 'H') then
ex=1
read(numb, *, iostat=i) ex
read(numb, *, iostat=iostat) ex
window=min(maxRange,max(minRange, nint(3600*ex)))
if (mode .lt. right) mode=right
x1=0
elseif (key .eq. 'M') then
ex=1
read(numb, *, iostat=i) ex
read(numb, *, iostat=iostat) ex
window=min(maxRange,max(minRange, nint(60*ex)))
if (mode .lt. right) mode=right
x1=0
@ -568,12 +708,12 @@
j=index(numb,'.')
day=0
if (j .gt. 1 .and. j .lt. numl) then
read(numb(1:j-1), *, iostat=i) day
read(numb(1:j-1), *, iostat=iostat) day
mon=0
read(numb(j+1:numl), *, iostat=i) mon
read(numb(j+1:numl), *, iostat=iostat) mon
tbase = myc_time(day+mon*100)
else
read(numb, *, iostat=i) day
read(numb, *, iostat=iostat) day
tbase = myc_time(day)
endif
x1=0
@ -591,13 +731,67 @@
elseif (key .eq. 'Q' .or. key .eq. char(13)
1 .or. key .eq. char(10)) then
goto 9
elseif (key .eq. 'S') then
sel=sel+1
if (sel .gt. tmax) sel=0
if (mode .eq. zoom) mode=0
elseif (key .eq. 'C') then
auxsel=auxsel+1
if (auxsel .gt. amax) auxsel=1
elseif (key .eq. 'A') then
showsets=2
elseif (key .eq. 'C') then ! clear set
if (ex .lt. x1) then
if (ey .ge. ymin(1) .and.
1 ey .le. ymax(1)) then
do is=1,nset
if (ey .lt. ylim(is)) then
im=imx(is)
omit(im)=.true.
goto 7
endif
enddo
else
ey=(ymin(1)-ey)/(ymax(1)-ymin(1))*3.0+0.5
if (ey .gt. 1.0) then
do im=1,nmax
j=unit(im)
if (winconf(1)-winconf(j) .eq. int(ey)) then
omit(im)=.true.
endif
enddo
endif
endif
endif
elseif (key .eq. 'S') then ! toggle focus
if (ex .lt. x1) then
if (ey .ge. ymin(1) .and.
1 ey .le. ymax(1)) then
do is=1,nset
if (ey .lt. ylim(is)) then
im=imx(is)
focus(im)=.not. focus(im)
goto 89
endif
enddo
endif
endif
j=nset
n=0
do is=1,nset
im=imx(is)
if (focus(im)) then
focus(im)=.false.
j=is
n=n+1
endif
enddo
if (n .gt. 1) then
if (j .gt. 4) then ! was "all", set to "default"
focus(1)=.true.
focus(2)=.true.
focus(3)=.true.
else ! was "default" select 1
focus(1)=.true.
endif
else if (j .lt. nset) then ! select next
im=imx(j)
focus(im)=.true.
endif ! else select none -> will be all
89 if (mode .eq. zoom) mode=0
elseif (mode .eq. live) then
goto 7
endif
@ -616,16 +810,17 @@
read(*,'(a)') filnam
open(lund, file=filnam, status='unknown')
line='time [h]'
line='hour'
call str_trim(line, line, l)
do j=1,nset
idx(j)=0
do i=1,retlen(j)
if (yd(i,j) .ne. undef) then
idx(j)=1
do is=1,nset
im=imx(is)
idx(is)=0
do j=1,retlen(is)
if (yd(j,is) .ne. undef) then
idx(is)=1
l=l+1
line(l:l)=char(9)
call str_trim(line(l+1:), parnam(j), text_len)
call str_trim(line(l+1:), parnam(im), text_len)
l=l+max(9,text_len)
goto 109
endif
@ -638,24 +833,24 @@
x0=0
do while (x0 .lt. 3e7)
x0=4e7
do j=1,nmax ! find next x
if (idx(j) .gt. 0 .and. idx(j) .lt. retlen(j)) then
x0=min(x0,xd(idx(j),j))
do is=1,nmax ! find next x
if (idx(is) .gt. 0 .and. idx(is) .lt. retlen(is)) then
x0=min(x0,xd(idx(is),is))
endif
enddo
if (x0 .lt. 3e7) then
write(line,'(f9.4)') x0/3600.
l=9
do j=1,nmax
if (idx(j) .gt. 0) then
do is=1,nmax
if (idx(is) .gt. 0) then
l=l+1
line(l:l)=char(9)
if (idx(j) .le. retlen(j)) then
if (xd(idx(j),j) .lt. x0+1) then
if (idx(is) .le. retlen(is)) then
if (xd(idx(is),is) .lt. x0+1) then
write(line(l+1:), '(f9.4)')
1 max(-999.,min(9999.,yd(idx(j),j)))
1 max(-999.,min(9999.,yd(idx(is),is)))
l=l+9
idx(j)=idx(j)+1
idx(is)=idx(is)+1
endif
endif
endif
@ -706,14 +901,19 @@
end
subroutine set_win(rl, x1, x2, y1, y2)
subroutine set_win(rl, winh, winconf, x1, x2, y1, y2)
integer rl
real winh
integer winconf(*)
real x1, x2, y1, y2
real b
if (rl .eq. 1) then
call pgsvp(0.07,0.93,0.3,0.9)
call pgsvp(0.07,0.93,0.9-3*winh,0.9)
else
call pgsvp(0.07,0.93,0.01,0.20)
b=winconf(rl)*winh
call pgsvp(0.07,0.93,b+0.01,b+winh-0.01)
endif
call pgswin(x1,x2,y1,y2)
@ -728,7 +928,7 @@
real*4 xd(dmax,nmax), yd(dmax,nmax)
integer oneDay, maxn
parameter (oneDay = 24*3600, maxn=10)
parameter (oneDay = 24*3600, maxn=12)
integer tecs_get_data
integer i,j,rl(maxn),m,k,n,mm
@ -752,13 +952,15 @@
n=retlen(j)
do k=m+1,m+rl(j)
n=n+1
xd(n,j)=xd(k,j)
yd(n,j)=yd(k,j)
xd(n,j)=xd(k,j)
yd(n,j)=yd(k,j)
enddo
retlen(j)=n
mm=max(mm,n)
enddo
! print *,mm-m,' points read'
if (m .gt. 0) then
print '(a,$)',' .'
endif
m=mm
enddo
endif

13
tecs/tecs_serial.c
View File

@ -161,6 +161,7 @@ char *SerCmd(SerChannel *serch, char *cmnd) {
AsynSrvChan *aser;
TermSrvChan *tser;
char *result, *pos, *trm;
char junk[256];
int iret, incomplete;
l=strlen(cmnd);
@ -181,6 +182,18 @@ char *SerCmd(SerChannel *serch, char *cmnd) {
if (result==NULL) ERR_MSG("empty result");
} else if (serch->type==TERMSRV_TYPE) {
tser=(TermSrvChan *)serch;
ERR_I(iret=SerWait(0, tser->fd));
while (iret>0) { /* skip contents in type-ahead buffer */
ERR_SI(l=recv(tser->fd, junk, sizeof(junk)-1, 0));
if (l==0) {
ErrMsg("disconnected");
SerClose(serch);
goto OnError;
}
junk[l]='\0';
logfileOut(LOG_MAIN, "skipped: '%s'\n", junk);
ERR_I(iret=SerWait(0, tser->fd));
}
iret=send(tser->fd, cmnd, l, 0);
if (iret<0) {
ErrMsg("disconnected");

1
tecs/term.c
View File

@ -1,3 +1,4 @@
#include <limits.h>
#include <unistd.h>
#include <stdlib.h>
#include <sys/socket.h>

101
tecsdriv.c
View File

@ -1,9 +1,9 @@
/*---------------------------------------------------------------------------
T E C S D R I V . C
This is the implementation for TECS object derived from an more general
environment controller. At present, TECS is used for driving the
LakeShore 340 Temperutre Controller.
LakeShore 340 Temperature Controller.
Markus Zolliker, March 2000
@ -68,6 +68,7 @@
char *lastError;
time_t lastGet;
int iLastError, port;
int (*EVLimits)(void *, float , char *, int);
char server[256];
} TecsDriv, *pTecsDriv;
@ -78,7 +79,7 @@
int argc, char *argv[])
{
pEVControl self = NULL;
char pBueffel[256], result[1024];
char pBueffel[256], result[1024], *res;
int iRet;
pEVDriver pD;
pTecsDriv pMe;
@ -111,43 +112,51 @@
iRet=CocGet(pMe->pData,"set",result); /* get parameter */
if (iRet<0) goto Error;
self->fTarget = atof(result);
iRet=CocGet(pMe->pData,"tlimit",result); /* get parameter */
if (iRet<0) goto Error;
fVal = atof(result);
iRet = EVCSetPar(self, "upperlimit", fVal,pCon);
iRet = EVControlWrapper(pCon,pSics,pData,argc,argv);
if (iRet != 0) {
iRet=CocGet(pMe->pData,"tlimit",result); /* get parameter */
if (iRet<0) goto Error;
fVal = atof(result);
if (fVal != 0 && ObVal(self->pParam,UPLIMIT) > fVal) {
sprintf(pBueffel,"WARNING: upper limit is above %g, (limit of the device)", fVal);
SCWrite(pCon,pBueffel,eValue);
}
iRet=CocGet(pMe->pData,"status",result); /* get parameter */
iRet=CocGet(pMe->pData,"status",result); /* show status */
if (iRet<0) goto Error;
SCWrite(pCon,result,eValue);
}
return iRet;
} else if (0==strcmp(pBueffel," upperlimit ")) {
if (argc > 2) {
iRet=CocGet(pMe->pData,"tlimit",result); /* get parameter */
if (iRet<0) goto Error;
fVal=atof(result);
if (atof(argv[2]) > fVal) {
sprintf(pBueffel,"ERROR: upper limit must not be higher than %g", fVal);
SCWrite(pCon,pBueffel,eError);
return 0;
}
if (argc == 3) {
iRet=CocSetGet(pMe->pData,"tLimit",argv[2],result); /* set and get parameter */
res=strchr(result, '=');
if (res != NULL) {
str_copy(result, res+1);
}
} else if (argc == 2) {
iRet=CocGet(pMe->pData,"tLimit",result); /* get parameter */
}
return EVControlWrapper(pCon,pSics,pData,argc,argv);
if (iRet<0) goto Error;
fVal=atof(result);
if (argc==3 && atof(argv[2]) > fVal) {
sprintf(pBueffel,"WARNING: upper limit reduced to maximal allowed value: %g", fVal);
SCWrite(pCon,pBueffel,eWarning);
}
iRet = EVCSetPar(self, "upperlimit", fVal,pCon);
if (iRet) {
sprintf(pBueffel,"%s.%s = %s\n",self->pName,
argv[1],result);
SCWrite(pCon,pBueffel,eValue);
}
return iRet;
} else if (0==strcmp(pBueffel," lowerlimit ")) {
if (argc > 2) {
if (atof(argv[2]) > ObVal(self->pParam,UPLIMIT)) {
SCWrite(pCon,"ERROR: lower limit must not be higher than upperlimit",eError);
return 0;
}
}
}
return EVControlWrapper(pCon,pSics,pData,argc,argv);
} else if (NULL!=strstr(
" log send tolerance access errorhandler interrupt interest safevalue currentvalue maxwait settle "
, pBueffel)) {
" log send tolerance access errorhandler interrupt interest safevalue currentvalue maxwait settle errorscript driver "
, pBueffel)) {
/* forward to standard handler */
return EVControlWrapper(pCon,pSics,pData,argc,argv);
}
@ -386,12 +395,12 @@
pPort=fgets(buf, sizeof(buf), fil);
if (pPort != NULL) {
pMe->port=atoi(pPort);
}
fgets(buf, sizeof(buf), fil);
fgets(pMe->server, sizeof(pMe->server), fil);
}
fgets(buf, sizeof(buf), fil);
fgets(pMe->server, sizeof(pMe->server), fil);
}
}
if (pMe->port==0) {
/* get the port number for tecs */
pPort = IFindOption(pSICSOptions, "TecsPort");
@ -414,4 +423,38 @@
pNew->GetValues= TecsGetX;
return pNew;
}
}
/*------------------------------------------------------------------------*/
static int TecsLimits(void *pData, float fVal, char *pError, int iErrLen) {
/* wrapper for EVILimits */
pEVControl pEvc;
pTecsDriv pMe;
int iRet;
float f;
char result[64];
pEvc = (pEVControl)pData;
assert(pEvc);
pMe=pEvc->pDriv->pPrivate;
assert(pMe);
iRet=CocGet(pMe->pData,"tLimit",result); /* get parameter */
if (iRet>=0) {
f=0.0;
f=atof(result);
if (f>0.0) pEvc->pParam[UPLIMIT].fVal=f;
}
return pMe->EVLimits(pData, fVal, pError, iErrLen);
}
/*------------------------------------------------------------------------*/
void TecsCustomize(SConnection *pCon, pEVControl pEvc) {
/* customize tecs driver */
pTecsDriv pMe;
pMe=pEvc->pDriv->pPrivate;
assert(pMe);
assert(pMe->EVLimits != pEvc->pDrivInt->CheckLimits);
pMe->EVLimits=pEvc->pDrivInt->CheckLimits; /* save original CheckLimits function */
pEvc->pDrivInt->CheckLimits=TecsLimits;
EVCSetPar(pEvc,"upperlimit",1800.0,pCon);
EVCSetPar(pEvc,"lowerlimit",0.01,pCon);
}

2
tecsdriv.h
View File

@ -24,4 +24,6 @@
int TecsError(pEVDriver self, int *iCode, char *error, int iErrLen);
void TecsCustomize(SConnection *pCon, pEVControl pEvc);
#endif

2
utils/makefile
View File

@ -1,7 +1,5 @@
# this makefile delegates to a version specific makefile
# where this subdirectory is (relative to the sics root)
S_DOWN=psi/utils
# where root is (from here)
S_UP=../..