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

tecs_plot.f is now ext. f77

Browse Source
This commit is contained in:
cvs
2002-10-16 11:35:40 +00:00
parent f514cf51e9
commit a14b12b726
12 changed files with 860 additions and 756 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
tecs/coc_server.c
View File

@ -288,13 +288,20 @@ char *CocReadVars(char *str, char stop){
if (cr==NULL) return strchr(str, '\0'); if (cr==NULL) return strchr(str, '\0');
str=cr+1; str=cr+1;
} else { } else {
str+=l;
eql=strchr(buf,'='); eql=strchr(buf,'=');
if (eql==NULL) ERR_MSG("syntax error"); if (eql==NULL) ERR_MSG("syntax error");
*eql='\0'; *eql='\0';
if (eql[1] == '\'' || eql[1]== '"') {
eql=strchr(str, '=');
StrNLink(&sbuf, eql+1, 80);
ERR_I(CocGetVar(buf, &sbuf, StrNONE));
str = sbuf.buf + sbuf.rdpos;
} else {
str+=l;
StrLink(&sbuf, eql+1); StrLink(&sbuf, eql+1);
ERR_I(CocGetVar(buf, &sbuf, ' ')); ERR_I(CocGetVar(buf, &sbuf, ' '));
} }
}
i=sscanf(str, "%79s%n", buf, &l); i=sscanf(str, "%79s%n", buf, &l);
} }
return str; return str;

2
tecs/coc_util.c
View File

@ -90,7 +90,7 @@ int CocRecv(int fd, StrBuf *buf, int timeout, int *flag) {
n=0; n=0;
ERR_SI(i=recv(fd, &n, 4, 0)); ERR_SI(i=recv(fd, &n, 4, 0));
if (i!=4) { if (i!=4) {
ERR_COD(ECONNRESET); ERR_COD(ECONNREFUSED);
} }
siz=ntohl(n); siz=ntohl(n);
if (siz > buf->dsize) if (siz > buf->dsize)

16
tecs/makefile
View File

@ -7,7 +7,6 @@
#------------ for DigitalUnix (add -DFORTIFY to CC_... for fortified version) #------------ for DigitalUnix (add -DFORTIFY to CC_... for fortified version)
CC_alpha_osf1=cc -std1 -g -warnprotos -I../ -I. -I../hardsup CC_alpha_osf1=cc -std1 -g -warnprotos -I../ -I. -I../hardsup
FOR_alpha_osf1=f77 -u -g FOR_alpha_osf1=f77 -u -g
TECS_PLOT_alpha_osf1=f90 -c -u -g -free tecs_plot.f
TECLI_LIB_alpha_osf1=-L/data/lnslib/lib -lpgplot -lX11 -lXm -so_archive TECLI_LIB_alpha_osf1=-L/data/lnslib/lib -lpgplot -lX11 -lXm -so_archive
SYS_FILE_alpha_osf1=sys_aunix SYS_FILE_alpha_osf1=sys_aunix
#CFLAGS_alpha_osf1= -std1 -g -warnprotos -I../ -I. -I../hardsup -DFORTIFY #CFLAGS_alpha_osf1= -std1 -g -warnprotos -I../ -I. -I../hardsup -DFORTIFY
@ -15,14 +14,12 @@ SYS_FILE_alpha_osf1=sys_aunix
#---------- for Redhat linux #---------- for Redhat linux
CC_i386_linux= gcc -I/usr/local/include -I. -I../ -I../hardsup -DLINUX -g CC_i386_linux= gcc -I/usr/local/include -I. -I../ -I../hardsup -DLINUX -g
FOR_i386_linux= g77 -u -fvxt -g FOR_i386_linux= g77 -u -fvxt -g
TECS_PLOT_i386_linux=g77 -c -u -g -ff90 -ffree-form tecs_plot.f
SYS_FILE_i386_linux=sys_linux SYS_FILE_i386_linux=sys_linux
TECLI_LIB_i386_linux=pgplot/libpgplot.a -L/usr/X11R6/lib -lX11 TECLI_LIB_i386_linux=pgplot/libpgplot.a -L/usr/X11R6/lib -lX11
#------------ #------------
CC=$(CC_$(MACHTYPE)_$(OSTYPE)) CC=$(CC_$(MACHTYPE)_$(OSTYPE))
FOR=$(FOR_$(MACHTYPE)_$(OSTYPE)) FOR=$(FOR_$(MACHTYPE)_$(OSTYPE))
TECS_PLOT=$(TECS_PLOT_$(MACHTYPE)_$(OSTYPE))
TECLI_LIB=$(TECLI_LIB_$(MACHTYPE)_$(OSTYPE)) TECLI_LIB=$(TECLI_LIB_$(MACHTYPE)_$(OSTYPE))
SYS_FILE=$(SYS_FILE_$(MACHTYPE)_$(OSTYPE)) SYS_FILE=$(SYS_FILE_$(MACHTYPE)_$(OSTYPE))
@ -46,8 +43,7 @@ libtecsl.a: $(CLI_OBJ)
all: libtecsl.a bin/TecsServer bin/TecsClient bin/keep_running all: libtecsl.a bin/TecsServer bin/TecsClient bin/keep_running
tecs_plot.o: tecs_plot.f six: bin/six
$(TECS_PLOT)
bin/TecsServer: $(SERV_OBJ) bin/TecsServer: $(SERV_OBJ)
- rm bin/TecsServer - rm bin/TecsServer
@ -60,12 +56,18 @@ bin/TecsClient: $(TECLI_OBJ)
bin/libtecs.so: tecs_c.c $(CLI_OBJ) bin/libtecs.so: tecs_c.c $(CLI_OBJ)
$(CC) -shared -o bin/libtecs.so tecs_c.c $(CLI_OBJ) $(CC) -shared -o bin/libtecs.so tecs_c.c $(CLI_OBJ)
six: six.c term.c sys_select.c libtecsl.a bin/six: six.c term.c sys_select.c libtecsl.a
$(CC) -o six six.c term.c sys_select.c libtecsl.a $(CC) -o bin/six six.c term.c sys_select.c libtecsl.a
rstart: rstart.c myc_str.o myc_err.o instr_hosts.o rstart: rstart.c myc_str.o myc_err.o instr_hosts.o
$(CC) -o rstart rstart.c myc_str.o myc_err.o instr_hosts.o $(CC) -o rstart rstart.c myc_str.o myc_err.o instr_hosts.o
serverd: serverd.c myc_str.o myc_err.o coc_util.o myc_buf.o
$(CC) -o serverd serverd.c myc_str.o myc_err.o coc_util.o myc_buf.o -lm
starts: starts.c myc_str.o myc_err.o coc_util.o myc_buf.o
$(CC) -o starts starts.c myc_str.o myc_err.o coc_util.o myc_buf.o -lm
bin/keep_running: keep_running.c bin/keep_running: keep_running.c
$(CC) -o bin/keep_running keep_running.c $(CC) -o bin/keep_running keep_running.c

5
tecs/myc_buf.c
View File

@ -22,6 +22,10 @@ char *StrNGet(StrBuf *buf, char *result, int reslen, int sep) {
if (f==NULL) if (f==NULL)
ERR_MSG("missing '""'"); ERR_MSG("missing '""'");
l=f-b; l=f-b;
if (sep == StrNONE) {
buf->rdpos=f - buf->buf + 1;
buf->seen = 0;
} else {
e=strchr(f+1, sep); e=strchr(f+1, sep);
if (e==NULL) { if (e==NULL) {
buf->rdpos = f - buf->buf + 1 + strlen(f+1); buf->rdpos = f - buf->buf + 1 + strlen(f+1);
@ -30,6 +34,7 @@ char *StrNGet(StrBuf *buf, char *result, int reslen, int sep) {
buf->rdpos = e - buf->buf + 1; buf->rdpos = e - buf->buf + 1;
buf->seen=1; buf->seen=1;
} }
}
} else { } else {
f=strchr(b, sep); f=strchr(b, sep);
if (f==NULL) { if (f==NULL) {

2
tecs/myc_buf.h
View File

@ -25,7 +25,7 @@ int StrPutArray(StrBuf *buf, float val[], int size);
Read from the buffer until separator sep. Read from the buffer until separator sep.
Use the StrGet macro if the result is a fixed size. Use the StrGet macro if the result is a fixed size.
Special case sep=StrNONE: Special case sep=StrNONE:
- StrGet reads until the end of the buffer - StrGet reads until the end of the buffer or until the end of a quoted string
- StrGetInt and StrGetFloat read until the end of a legal number - StrGetInt and StrGetFloat read until the end of a legal number
*/ */
char *StrNGet(StrBuf *buf, char *result, int reslen, int sep); char *StrNGet(StrBuf *buf, char *result, int reslen, int sep);

2
tecs/myc_mem.h
View File

@ -25,6 +25,6 @@
#define NEW_STR(TO,FROM) {ERR_SP(TO=malloc(strlen(FROM)+1)); strcpy(TO,FROM); } #define NEW_STR(TO,FROM) {ERR_SP(TO=malloc(strlen(FROM)+1)); strcpy(TO,FROM); }
#define MALLOC(SIZE) malloc(SIZE) #define MALLOC(SIZE) malloc(SIZE)
#define FREE(PTR) free(PTR) #define FREE(PTR) { free(PTR); PTR=NULL; }
#endif /* _MEM_UTIL_H_ */ #endif /* _MEM_UTIL_H_ */

73
tecs/tecs.c
View File

@ -168,6 +168,8 @@ static char
heUnits[4], /* helium level units */ heUnits[4], /* helium level units */
alarmChannels[N_SENSORS], alarmChannels[N_SENSORS],
alarmHistory[N_SENSORS], alarmHistory[N_SENSORS],
dev[80],
devHelp[10000],
controlChannel[4]="A"; controlChannel[4]="A";
static char static char
@ -543,7 +545,7 @@ int PrepInput(char *label) {
if (i<1) ERR_MSG("missing chans"); if (i<1) ERR_MSG("missing chans");
t+=l; t+=l;
/* interprete settings until '+' appeares */ /* interprete settings until '+' appeares (after whitespace) */
ERR_P(CocReadVars(t, '+')); ERR_P(CocReadVars(t, '+'));
if (loop!=2) loop=1; if (loop!=2) loop=1;
@ -2076,6 +2078,50 @@ EndStatus:
return -1; return -1;
} }
int DevHelpHdl(int mode, void *base, int fd) {
char *t, *n, *d, *en, *ed;
char line[80], nbuf[256];
int l;
static int doit=1;
if (table!=NULL && tim>tableTime+60) { FREE(table); table=NULL; }; /* clear old table */
if (table==NULL) { /* read table */
str_copy(nbuf, binDir);
str_append(nbuf, TABLE_FILE);
ERR_P(table=str_read_file(nbuf));
tableTime=tim;
doit=1;
}
if (doit) {
doit=0;
t=table;
str_copy(devHelp,"\n");
while (t!=NULL) {
t++;
n=strchr(t, '\'');
d=strchr(t, '"');
t=strchr(t, '\n');
if (n!=NULL && d!=NULL && n < d && d < t) {
en=strchr(n+1, '\'');
ed=strchr(d+1, '"');
if (en != NULL && en<d && ed != NULL && ed<t) {
l=en-n;
if (l>12) l=12;
str_ncpy(line, n+1, l);
str_npad(line, line, 12);
l=ed-d;
if (l>77) l=77;
str_ncpy(line+12, d+1, l);
str_append(line, "\n");
str_append(devHelp, line);
}
}
}
}
return 0;
OnError: return -1;
}
int RemoteHdl(int mode, void *base, int fd) { int RemoteHdl(int mode, void *base, int fd) {
if (mode==COC_WR) { if (mode==COC_WR) {
return COC_DWR; return COC_DWR;
@ -2118,18 +2164,6 @@ int TmoHdl(int mode, void *base, int fd) {
OnError: return -1; OnError: return -1;
} }
int SerHdl(int mode, void *base, int fd) {
if (mode==COC_WR) {
return COC_DRD;
} else if (mode==COC_DRD) {
SerClose(ser);
noResp=1;
ERR_P(ser=SerOpen(host, msecTmo, IdleHdl));
}
return 0;
OnError: return -1;
}
int LogfileHdl(int mode, void *base, int fd) { int LogfileHdl(int mode, void *base, int fd) {
char buf[256]; char buf[256];
if (mode==COC_WR) { if (mode==COC_WR) {
@ -2237,7 +2271,7 @@ int main(int argc, char *argv[]) {
CocFltFld(SensorT, t0, RD); CocFltFld(SensorT, t0, RD);
CocFltFld(SensorT, t1, RD); CocFltFld(SensorT, t1, RD);
CocFltFld(SensorT, t2, RD); CocFltFld(SensorT, t2, RD);
CocFltFld(SensorT, lim, RD); CocFltFld(SensorT, lim, RW);
CocFltFld(SensorT, scale, RD); CocFltFld(SensorT, scale, RD);
CocFltFld(SensorT, alarm, RW); CocHdl(AlarmHdl); CocFltFld(SensorT, alarm, RW); CocHdl(AlarmHdl);
CocIntFld(SensorT, readStat, RD); CocIntFld(SensorT, readStat, RD);
@ -2297,6 +2331,8 @@ int main(int argc, char *argv[]) {
CocDefStr(status, RD); CocHdl(StatusHdl); CocDefStr(status, RD); CocHdl(StatusHdl);
CocDefStr(pid, RD); CocHdl(PidSumHdl); CocDefStr(pid, RD); CocHdl(PidSumHdl);
CocDefStr(config, RD); CocDefStr(config, RD);
CocDefStr(dev, RD);
CocDefStr(devHelp, RD); CocHdl(DevHelpHdl);
CocDefInt(cod1, RD); CocDefInt(cod1, RD);
CocDefInt(cod2, RD); CocDefInt(cod2, RD);
@ -2342,7 +2378,7 @@ int main(int argc, char *argv[]) {
CocAlias(int,integ); CocAlias(int,integ);
CocDefInt(msecTmo, RW); CocHdl(TmoHdl); CocDefInt(msecTmo, RW); CocHdl(TmoHdl);
CocDefStr(host, RW); CocHdl(SerHdl); CocDefStr(host, RW);
CocDefInt(port, RD); CocDefInt(port, RD);
CocDefInt(use_stdout, RW); CocHdl(LogfileHdl); CocDefInt(use_stdout, RW); CocHdl(LogfileHdl);
CocDefStr(serverId, RW); CocHdl(LogfileHdl); CocDefStr(serverId, RW); CocHdl(LogfileHdl);
@ -2395,7 +2431,7 @@ int main(int argc, char *argv[]) {
logfileOut(LOG_MAIN ,"?"); logfileOut(LOG_MAIN ,"?");
} else { } else {
CocReadVars(inistr, '\0'); CocReadVars(inistr, '\0');
free(inistr); FREE(inistr);
} }
} }
} }
@ -2451,6 +2487,11 @@ int main(int argc, char *argv[]) {
cntError=0; cntError=0;
while (!quit) { while (!quit) {
iret=MainBody(); iret=MainBody();
if (ser!=NULL && 0!=strcmp(host, ser->host)) {
SerClose(ser);
ser=NULL;
noResp=1;
}
if (iret<0 || ser==NULL) { if (iret<0 || ser==NULL) {
cntError++; cntError++;
ser=SerCheck(ser); ser=SerCheck(ser);

25
tecs/tecs_cli.c
View File

@ -68,7 +68,7 @@ int TeccGet3(pTecsClient conn, float *tC, float *tX, float *tP) {
ERR_I(CocPutInt(conn, "readTemp", 1)); ERR_I(CocPutInt(conn, "readTemp", 1));
ERR_I(iret=CocDoIt(conn, response, sizeof(response))); ERR_I(iret=CocDoIt(conn, response, sizeof(response)));
if (iret) ERR_MSG(response); if (iret) ERR_MSG(response);
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
@ -80,7 +80,7 @@ int TeccGet(pTecsClient conn, float *temp) {
ERR_I(CocPutInt(conn, "readTemp", 1)); ERR_I(CocPutInt(conn, "readTemp", 1));
ERR_I(iret=CocDoIt(conn, response, sizeof(response))); ERR_I(iret=CocDoIt(conn, response, sizeof(response)));
if (iret) ERR_MSG(response); if (iret) ERR_MSG(response);
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
@ -91,7 +91,7 @@ int TeccSet(pTecsClient conn, float temp) {
ERR_I(CocPutFloat(conn, "set", temp)); ERR_I(CocPutFloat(conn, "set", temp));
ERR_I(iret=CocDoIt(conn, response, sizeof(response))); ERR_I(iret=CocDoIt(conn, response, sizeof(response)));
if (iret) ERR_MSG(response); if (iret) ERR_MSG(response);
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
@ -153,7 +153,7 @@ int F_FUN(tecs_set_par)(F_CHAR(name), F_CHAR(par), int *show, int name_len, int
if (*show) { if (*show) {
printf("%s", response); printf("%s", response);
} }
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
@ -202,7 +202,7 @@ int F_FUN(tecs_get_mult)(F_CHAR(names), int *time, int *nvalues, float values[],
} }
ERR_I(CocDoIt(conn, response, sizeof(response))); ERR_I(CocDoIt(conn, response, sizeof(response)));
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
@ -211,7 +211,7 @@ int F_FUN(tecs_init)(F_CHAR(startcmd), int *port, int startcmd_len) {
STR_TO_C(sbuf, startcmd); STR_TO_C(sbuf, startcmd);
ERR_P(conn=TeccInit(sbuf, *port)); ERR_P(conn=TeccInit(sbuf, *port));
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
@ -221,7 +221,8 @@ int F_FUN(tecs_start)(F_CHAR(startcmd), F_CHAR(host), int *port, int startcmd_le
STR_TO_C(sbuf, startcmd); STR_TO_C(sbuf, startcmd);
STR_TO_C(hbuf, host); STR_TO_C(hbuf, host);
ERR_P(conn=TeccStart(sbuf, hbuf, *port)); ERR_P(conn=TeccStart(sbuf, hbuf, *port));
return(0); if (conn->fd<0) return 1;
return 0;
OnError: return(-1); OnError: return(-1);
} }
@ -231,25 +232,25 @@ int F_FUN(tecs_rights)(int write) {
} else { } else {
ERR_I(CocSendMagic(conn, rdCode)); ERR_I(CocSendMagic(conn, rdCode));
} }
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
int F_FUN(tecs_get)(float *temp) { int F_FUN(tecs_get)(float *temp) {
ERR_I(TeccGet(conn, temp)); ERR_I(TeccGet(conn, temp));
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
int F_FUN(tecs_get3)(float *t1, float *t2, float *t3) { int F_FUN(tecs_get3)(float *t1, float *t2, float *t3) {
ERR_I(TeccGet3(conn, t1, t2, t3)); ERR_I(TeccGet3(conn, t1, t2, t3));
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
int F_FUN(tecs_set)(float *temp) { int F_FUN(tecs_set)(float *temp) {
ERR_I(TeccSet(conn, *temp)); ERR_I(TeccSet(conn, *temp));
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }
@ -274,7 +275,7 @@ int F_FUN(tecs_watch_log)(F_CHAR(list), int list_len) {
char buf[16]; char buf[16];
STR_TO_C(buf, list); STR_TO_C(buf, list);
ERR_I(CocWatchLog(conn, buf)); ERR_I(CocWatchLog(conn, buf));
return(0); return 0;
OnError: return(-1); OnError: return(-1);
} }

3
tecs/tecs_client.f
View File

@ -56,8 +56,7 @@
else else
iret=tecs_start(start, ' ', 9753) iret=tecs_start(start, ' ', 9753)
endif endif
if (iret .ne. 0) goto 90
if (iret .lt. 0) goto 90
if (oneCommand) goto 11 if (oneCommand) goto 11

376
tecs/tecs_plot.f
View File

@ -1,9 +1,10 @@
subroutine tecs_plot(auxpar) subroutine tecs_plot(auxpar)
character(len=*) auxpar character*(*) auxpar
integer dmax, nmax, tmax, amax, nmenu, chartperiod, naux integer dmax, nmax, tmax, amax, nmenu, chartperiod, naux
parameter (dmax=400, nmax=9, tmax=8, amax=3, nmenu=13, chartperiod=5, naux=1) parameter (dmax=400, nmax=9, tmax=8, amax=3, nmenu=13
1 , chartperiod=5, naux=1)
integer minRange, maxRange, oneDay integer minRange, maxRange, oneDay
parameter (minRange=60, maxRange=7*24*3600, oneDay=24*3600) parameter (minRange=60, maxRange=7*24*3600, oneDay=24*3600)
integer zoom, right, live integer zoom, right, live
@ -23,46 +24,53 @@ subroutine tecs_plot(auxpar)
integer retLen(nmax) integer retLen(nmax)
integer sel/0/, sel1, sel2, auxsel/1/ integer sel/0/, sel1, sel2, auxsel/1/
character key*1 character key*1
character text(2,nmenu)*16/ & character text(2,nmenu)*16/
'L' ,'live off' & 1 'L' ,'live off'
,'z' ,'sel. zoom' & 1 ,'z' ,'sel. zoom'
,'+' ,'zoom in' & 1 ,'+' ,'zoom in'
,'-' ,'zoom out' & 1 ,'-' ,'zoom out'
,'x' ,'show all' & 1 ,'x' ,'show all'
,'2d' ,'2 days' & 1 ,'2d' ,'2 days'
,'1h' ,'1 hour' & 1 ,'1h' ,'1 hour'
,'15m' ,'15 min' & 1 ,'15m' ,'15 min'
,'31.7t','goto date' & 1 ,'31.7t','goto date'
,'c' ,'show P/He/Aux' & 1 ,'c' ,'show P/He/Aux'
,'s' ,'select T' & 1 ,'s' ,'select T'
,'f' ,'write file' & 1 ,'f' ,'write file'
,'q' ,'quit'/ 1 ,'q' ,'quit'/
character weekdays(7)*4/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/ character weekdays(7)*4/
character buf*8, device*8, name*40, filnam*128, numb*16, title*64, pars*64 1 'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/
character(len=4) tpar(tmax)/'Te', 'Tr', 'Tm', 'Ts', 'T1', 'T2', 'T3', 'T4'/ character buf*8, device*8, name*40, filnam*128, numb*16
character(len=4) apar(amax)/'P', 'He', 'Aux'/ character title*64, pars*64
character(len=16) parnam(nmax) character*4 tpar(tmax)/'Te','Tr','Tm','Ts','T1','T2','T3','T4'/
character*4 apar(amax)/'P', 'He', 'Aux'/
character*16 parnam(nmax)
logical gap, done logical gap, done
logical saveit logical saveit
integer iret, lund, numl, mon, day integer iret, lund, numl, mon, day
integer pars_len, title_len, text_len, name_len integer pars_len, title_len, text_len, name_len
integer idx(nmax)
character line*132
real x0
logical loop
! functions ! functions
integer sys_gmt_off, myc_now, myc_time, myc_date, get_data, tecs_get_mult, tecs_get_par integer sys_gmt_off, myc_now, myc_time, myc_date, get_data
integer tecs_get_mult, tecs_get_par
data window/0./ data window/0./
if (window==0) window=1800. if (window .eq. 0) window=1800.
saveit=.false. saveit=.false.
mode=live mode=live
call pgopen(' ') call pgopen(' ')
call pgqinf('TYPE', device, l) call pgqinf('TYPE', device, l)
if (device=='NULL') then if (device .eq. 'NULL') then
call pgclos call pgclos
call pgopen('?') call pgopen('?')
call pgqinf('TYPE', device, l) call pgqinf('TYPE', device, l)
if (device=='NULL') then if (device .eq. 'NULL') then
print *,'No PGPLOT-Device defined' print *,'No PGPLOT-Device defined'
goto 9 goto 9
endif endif
@ -70,7 +78,7 @@ subroutine tecs_plot(auxpar)
call pgqcol(i,ncol) call pgqcol(i,ncol)
! print *,i,ncol,' colors ',device ! print *,i,ncol,' colors ',device
if (ncol>=8 .and. device /= 'VT125') then if (ncol .ge. 8 .and. device .ne. 'VT125') then
call pgscr(0, 1.0, 1.0, 1.0) call pgscr(0, 1.0, 1.0, 1.0)
call pgscr(1, 0.0, 0.0, 0.0) call pgscr(1, 0.0, 0.0, 0.0)
call pgscr(2, 1.0, 0.0, 0.0) call pgscr(2, 1.0, 0.0, 0.0)
@ -88,7 +96,7 @@ subroutine tecs_plot(auxpar)
x1=0 x1=0
step=0 step=0
do i=1,amax do i=1,amax
if (auxpar == apar(i)) then if (auxpar .eq. apar(i)) then
auxsel=i auxsel=i
endif endif
enddo enddo
@ -109,18 +117,18 @@ subroutine tecs_plot(auxpar)
pars=pars(1:pars_len)//' '//parnam(nset) pars=pars(1:pars_len)//' '//parnam(nset)
iret=tecs_get_mult(pars, t, nset, yy0) iret=tecs_get_mult(pars, t, nset, yy0)
if (iret < 0) goto 99 if (iret .lt. 0) goto 99
if (window == 0) then if (window .eq. 0) then
last=t last=t
step=maxRange/dmax step=maxRange/dmax
window=maxRange window=maxRange
first=t-min(dmax*step-1,maxRange-step) first=t-min(dmax*step-1,maxRange-step)
else if (mode >= right) then else if (mode .ge. right) then
step=window/(dmax-2)+0.99 step=window/(dmax-2)+0.99
last=t last=t
first=t-min(dmax*step-1,nint(window)) first=t-min(dmax*step-1,nint(window))
else else
if (mode==zoom) then if (mode .eq. zoom) then
x2=(x1+x2+window)/2 x2=(x1+x2+window)/2
x1=x2-window x1=x2-window
endif endif
@ -129,13 +137,13 @@ subroutine tecs_plot(auxpar)
last=x2+tbase last=x2+tbase
first=x1-step+tbase first=x1-step+tbase
endif endif
if (step == 0) step=1 if (step .eq. 0) step=1
if (step>60) then ! normalize step if (step .gt. 60) then ! normalize step
step=(step+59)/60*60 step=(step+59)/60*60
else if (step>30) then else if (step .gt. 30) then
step=60 step=60
elseif (step>20) then elseif (step .gt. 20) then
step=30 step=30
else else
step=(step+4)/5*5 step=(step+4)/5*5
@ -143,11 +151,12 @@ subroutine tecs_plot(auxpar)
first=last-(last-first+step-1)/step*step ! round first first=last-(last-first+step-1)/step*step ! round first
! print *,step,last-first ! print *,step,last-first
tbase=first-mod(first,7*oneDay) tbase=first-mod(first,7*oneDay)
iret=get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, retLen) iret=get_data(pars, first, last, step, tbase
if (iret < 0) goto 99 1 , xd, yd, dmax, nmax, retLen)
if (iret .lt. 0) goto 99
x2 = last - tbase x2 = last - tbase
if (mode >= right) then if (mode .ge. right) then
x1=x2-window x1=x2-window
else else
x1 = first - tbase x1 = first - tbase
@ -155,30 +164,30 @@ subroutine tecs_plot(auxpar)
tim0=t-tbase tim0=t-tbase
do i=1,nset do i=1,nset
leng=retLen(i) leng=retLen(i)
do while (leng > 1 .and. yd(leng,i) == undef) do while (leng .gt. 1 .and. yd(leng,i) .eq. undef)
leng=leng-1 leng=leng-1
enddo enddo
if (leng == 1) leng=0 if (leng .eq. 1) leng=0
retLen(i)=leng retLen(i)=leng
if (mode==live .and. leng>0) then if (mode .eq. live .and. leng .gt. 0) then
xd(leng,i)=tim0 xd(leng,i)=tim0
yd(leng,i)=yy0(i) yd(leng,i)=yy0(i)
endif endif
enddo enddo
if (sel /= 0) then if (sel .ne. 0) then
do while (sel < nset .and. retLen(sel) == 0) do while (sel .lt. nset .and. retLen(sel) .eq. 0)
sel=sel+1 sel=sel+1
enddo enddo
if (sel >= nset) sel = 0 if (sel .ge. nset) sel = 0
endif endif
if (saveit) goto 9 if (saveit) goto 9
if (mode==live) then if (mode .eq. live) then
x2=max(tim0,x2)+min(1800., window*0.5) x2=max(tim0,x2)+min(1800., window*0.5)
endif endif
if (window>50*3600) then if (window .gt. 50*3600) then
ticks=8*3600 ticks=8*3600
elseif (window>25*3600) then elseif (window .gt. 25*3600) then
ticks=4*3600 ticks=4*3600
else else
ticks=0.0 ! automatic ticks=0.0 ! automatic
@ -186,7 +195,7 @@ subroutine tecs_plot(auxpar)
i1=1 i1=1
i2=nset-naux i2=nset-naux
if (sel==0) then if (sel .eq. 0) then
sel1=i1 sel1=i1
sel2=i2 sel2=i2
else else
@ -194,7 +203,7 @@ subroutine tecs_plot(auxpar)
sel2=sel sel2=sel
endif endif
do rl=1,2 do rl=1,2
if (mode==zoom .and. rl==1) then if (mode .eq. zoom .and. rl .eq. 1) then
ymin(1)=y1 ymin(1)=y1
ymax(1)=y2 ymax(1)=y2
else else
@ -204,13 +213,13 @@ subroutine tecs_plot(auxpar)
ylast2=ymax(rl) ylast2=ymax(rl)
do i=sel1,sel2 do i=sel1,sel2
do j=1,retLen(i) do j=1,retLen(i)
if (yd(j,i)/=undef) then if (yd(j,i) .ne. undef) then
ymin(rl)=min(ymin(rl),yd(j,i)) ymin(rl)=min(ymin(rl),yd(j,i))
ymax(rl)=max(ymax(rl),yd(j,i)) ymax(rl)=max(ymax(rl),yd(j,i))
endif endif
enddo enddo
do j=max(1,retLen(i)-4),retLen(i) do j=max(1,retLen(i)-4),retLen(i)
if (yd(j, i)/=undef) then if (yd(j, i) .ne. undef) then
ylast1=min(ylast1,yd(j, i)) ylast1=min(ylast1,yd(j, i))
ylast2=max(ylast2,yd(j, i)) ylast2=max(ylast2,yd(j, i))
endif endif
@ -221,16 +230,16 @@ subroutine tecs_plot(auxpar)
fy=abs(ymax(rl)) fy=abs(ymax(rl))
ymax(rl)=ymax(rl)+max(fy*0.0075,ey*0.01) ymax(rl)=ymax(rl)+max(fy*0.0075,ey*0.01)
ymin(rl)=ymin(rl)-max(fy*0.005,ey*0.01) ymin(rl)=ymin(rl)-max(fy*0.005,ey*0.01)
if (mode==live) then if (mode .eq. live) then
ymin(rl)=min(ymin(rl),max(0.0,ylast1-ey*0.4)) ymin(rl)=min(ymin(rl),max(0.0,ylast1-ey*0.4))
ymax(rl)=max(ymax(rl),ylast2+ey*0.4) ymax(rl)=max(ymax(rl),ylast2+ey*0.4)
endif endif
endif endif
if (ymax(rl) < ymin(rl)) then if (ymax(rl) .lt. ymin(rl)) then
ymax(rl)=1.0 ymax(rl)=1.0
ymin(rl)=0 ymin(rl)=0
elseif (ymax(rl) == ymin(rl)) then elseif (ymax(rl) .eq. ymin(rl)) then
ymax(rl)=ymin(rl)*1.00001+1.0 ymax(rl)=ymin(rl)*1.00001+1.0
ymin(rl)=-1.0e-3 ymin(rl)=-1.0e-3
endif endif
@ -242,8 +251,8 @@ subroutine tecs_plot(auxpar)
l=0 l=0
lastj=1 lastj=1
do j=1,retLen(i) do j=1,retLen(i)
if (yd(j,i)==undef) then if (yd(j,i) .eq. undef) then
if (j>lastj) then if (j .gt. lastj) then
call pgline(j-lastj, xd(lastj,i), yd(lastj,i)) call pgline(j-lastj, xd(lastj,i), yd(lastj,i))
endif endif
lastj=j+1 lastj=j+1
@ -251,27 +260,28 @@ subroutine tecs_plot(auxpar)
l=j l=j
endif endif
enddo enddo
if (retLen(i) > lastj) call pgline(retLen(i)+1-lastj, xd(lastj,i), yd(lastj,i)) if (retLen(i) .gt. lastj)
1 call pgline(retLen(i)+1-lastj, xd(lastj,i), yd(lastj,i))
retLen(i)=l retLen(i)=l
enddo enddo
call pgsci(1) call pgsci(1)
if (rl == 1) then if (rl .eq. 1) then
call pgsch(1.0) call pgsch(1.0)
call pgtbox('ZHXYBINST', ticks, 0, 'BCINMST', 0.0, 0) call pgtbox('ZHXYBINST', ticks, 0, 'BCINMST', 0.0, 0)
call pgtbox('C', 0.0, 0, ' ', 0.0, 0) call pgtbox('C', 0.0, 0, ' ', 0.0, 0)
ey=0.0 ey=0.0
do i=i1,i2 do i=i1,i2
if (retLen(i) > 0) then if (retLen(i) .gt. 0) then
name=parnam(i) name=parnam(i)
if (name=='Tm') then if (name .eq. 'Tm') then
name='Main Sensor' name='Main Sensor'
elseif (name=='Ts') then elseif (name .eq. 'Ts') then
name='Sample Sensor' name='Sample Sensor'
elseif (name=='Tr') then elseif (name .eq. 'Tr') then
name='SetPoint' name='SetPoint'
endif endif
call str_trim(name, name, name_len) call str_trim(name, name, name_len)
if (sel == i) then if (sel .eq. i) then
name=name(1:name_len)//'*' name=name(1:name_len)//'*'
call str_trim(name, name, name_len) call str_trim(name, name, name_len)
endif endif
@ -289,13 +299,14 @@ subroutine tecs_plot(auxpar)
call pgtbox('B', 0.0, 0, ' ', 0.0, 0) call pgtbox('B', 0.0, 0, ' ', 0.0, 0)
call pgsci(color(nset)) call pgsci(color(nset))
call pgsch(1.0) call pgsch(1.0)
if (parnam(nset) == 'P' .or. parnam(nset) == 'p') then if (parnam(nset) .eq. 'P' .or. parnam(nset) .eq. 'p') then
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Power [W]') call pgmtxt ('L', 2.5, 0.5, 0.5, 'Power [W]')
elseif (parnam(nset) == 'He') then elseif (parnam(nset) .eq. 'He') then
title='%' title='%'
iret=tecs_get_par('heUnits', title, 0) iret=tecs_get_par('heUnits', title, 0)
call str_trim(title, title, title_len) call str_trim(title, title, title_len)
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Helium ['//title(1:title_len)//']') call pgmtxt ('L', 2.5, 0.5, 0.5,
1 'Helium ['//title(1:title_len)//']')
else else
call pgmtxt ('L', 2.5, 0.5, 0.5, parnam(nset)) call pgmtxt ('L', 2.5, 0.5, 0.5, parnam(nset))
endif endif
@ -312,7 +323,7 @@ subroutine tecs_plot(auxpar)
call pgsci(1) call pgsci(1)
call pgsclp(0) call pgsclp(0)
if (mode==live) then if (mode .eq. live) then
text(2,1)='live off' text(2,1)='live off'
else else
text(2,1)='live on' text(2,1)='live on'
@ -338,30 +349,31 @@ subroutine tecs_plot(auxpar)
ey=ymin(rl)-row*3.5 ey=ymin(rl)-row*3.5
i=max(0,int((x1+oneDay/2)/oneDay)) i=max(0,int((x1+oneDay/2)/oneDay))
do
ex=(i+0.5)*oneDay ex=(i+0.5)*oneDay
if (ex > x2) EXIT do while (ex .le. x2)
done=.true. done=.true.
write(buf,'(i8.8)') myc_date(nint(ex)+tbase) write(buf,'(i8.8)') myc_date(nint(ex)+tbase)
call pgptxt(ex, ey, 0.0, 0.5, weekdays(mod(i,7)+1)//buf(7:8)//'.'//buf(5:6)) call pgptxt(ex, ey, 0.0, 0.5,
1 weekdays(mod(i,7)+1)//buf(7:8)//'.'//buf(5:6))
ex=ex-12*3600 ex=ex-12*3600
if (ex > x1) then if (ex .gt. x1) then
call pgmove(ex, ey) call pgmove(ex, ey)
call pgdraw(ex, ey+row) call pgdraw(ex, ey+row)
endif endif
ex=ex+oneDay ex=ex+oneDay
if (ex < x2) then if (ex .lt. x2) then
call pgmove(ex, ey) call pgmove(ex, ey)
call pgdraw(ex, ey+row) call pgdraw(ex, ey+row)
endif endif
i=i+1 i=i+1
ex=(i+0.5)*oneDay
enddo enddo
if (.not. done) then if (.not. done) then
n=nint(x2)/oneDay*oneDay n=nint(x2)/oneDay*oneDay
i=nint(x1)-n i=nint(x1)-n
j=nint(x2)-n j=nint(x2)-n
if (i < 0) then if (i .lt. 0) then
if (-i > j) then if (-i .gt. j) then
ex=0.0 ex=0.0
i=nint(x1)+tbase i=nint(x1)+tbase
else else
@ -374,14 +386,14 @@ subroutine tecs_plot(auxpar)
endif endif
thisday=mod(i/oneDay,7)+1 thisday=mod(i/oneDay,7)+1
write(buf,'(i8.8)') myc_date(i) write(buf,'(i8.8)') myc_date(i)
! call pgptxt((x1+x2)/2, ey, 0.0, ex, weekdays(mod(thisday,7)+1)//buf(7:8)//'.'//buf(5:6)) call pgmtxt('B', 3.5, ex, ex,
call pgmtxt('B', 3.5, ex, ex, weekdays(thisday)//buf(7:8)//'.'//buf(5:6)) 1 weekdays(thisday)//buf(7:8)//'.'//buf(5:6))
endif endif
iret=tecs_get_par('device', title, 0) iret=tecs_get_par('device', title, 0)
if (iret < 0) goto 99 if (iret .lt. 0) goto 99
i=index(title, '(') i=index(title, '(')
if (i > 2 ) then if (i .gt. 2 ) then
title=title(1:i-1) title=title(1:i-1)
else else
title='test - no device' title='test - no device'
@ -395,31 +407,33 @@ subroutine tecs_plot(auxpar)
numl=0 numl=0
numb=' ' numb=' '
7 ex=undef 7 ex=undef
if (mode==live) then if (mode .eq. live) then
! if (device(1:1)=='X') then ! if (device(1:1) .eq. 'X') then
! call pgmtxt('T', 0.5, 0.0, 0.0, 'LIVE MODE (click on text window before pressing any further key)') ! call pgmtxt('T', 0.5, 0.0, 0.0, 'LIVE MODE (click on text window before pressing any further key)')
! endif ! endif
! call get_key(key, 0, chartperiod) ! call get_key(key, 0, chartperiod)
i=chartperiod-mod(myc_now(), chartperiod) i=chartperiod-mod(myc_now(), chartperiod)
call get_cursor(ex, ey, key, -i) call get_cursor(ex, ey, key, -i)
do while (key == char(0) .or. key == ' ') ! no key or space key pressed do while (key .eq. char(0) .or. key .eq. ' ') ! no key or space key pressed
iret=tecs_get_mult(pars, t, nset, yy1) iret=tecs_get_mult(pars, t, nset, yy1)
if (iret<0) goto 99 if (iret .lt. 0) goto 99
tim1=t-tbase tim1=t-tbase
if (tim1 > x2) then if (tim1 .gt. x2) then
call pgpage call pgpage
window=x2-x1 window=x2-x1
goto 1 goto 1
endif endif
if (tim1 > tim0) then if (tim1 .gt. tim0) then
i1=1 i1=1
i2=nset-naux i2=nset-naux
do rl=1,2 do rl=1,2
call set_win(rl,x1,x2,ymin(rl),ymax(rl)) call set_win(rl,x1,x2,ymin(rl),ymax(rl))
do i=i1,i2 do i=i1,i2
if (yy0(i) /= undef .and. yy1(i) /= undef) then if (yy0(i) .ne. undef .and. yy1(i) .ne. undef) then
if ((sel==0 .or. sel==i) .and. (yy1(i) < ymin(rl) .or. yy1(i) > ymax(rl))) 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 call pgpage
window=x2-x1 window=x2-x1
goto 1 goto 1
@ -445,22 +459,22 @@ subroutine tecs_plot(auxpar)
rl=1 rl=1
call set_win(rl,x1,x2,ymin(rl),ymax(rl)) call set_win(rl,x1,x2,ymin(rl),ymax(rl))
8 if (key>='a') key=char(ichar(key)-32) 8 if (key .ge. 'a') key=char(ichar(key)-32)
if (key=='-') then if (key .eq. '-') then
window=min(window*2, 8.0*oneDay) window=min(window*2, 8.0*oneDay)
if (mode==zoom) then if (mode .eq. zoom) then
x1=x1-(x2-x1)/2 x1=x1-(x2-x1)/2
x2=x2+(x2-x1)/3 x2=x2+(x2-x1)/3
y1=y1-(y2-y1)/2 y1=y1-(y2-y1)/2
y2=y2+(y2-y1)/3 y2=y2+(y2-y1)/3
endif endif
elseif (key=='X') then elseif (key .eq. 'X') then
window=0 window=0
mode=0 mode=0
elseif (key=='+' .or. key==',') then elseif (key .eq. '+' .or. key .eq. ',') then
window=max(winmin,window/2) window=max(winmin,window/2)
if (mode==zoom) then if (mode .eq. zoom) then
if (ex==undef) then if (ex .eq. undef) then
ex=(x1+x2)/2 ex=(x1+x2)/2
ey=(min(y2,ymax(1))+max(y1,ymin(1)))/2 ey=(min(y2,ymax(1))+max(y1,ymin(1)))/2
end if end if
@ -471,13 +485,15 @@ subroutine tecs_plot(auxpar)
y1=ey-fy/4 y1=ey-fy/4
y2=ey+fy/4 y2=ey+fy/4
endif endif
elseif (key=='Z') then elseif (key .eq. 'Z') then
call pgsci(1) call pgsci(1)
if (ex==undef) then if (ex .eq. undef) then
call pgmtxt('T', 0.5, 0.0, 0.0, 'click on two opposite corners of a selection rectangle') call pgmtxt('T', 0.5, 0.0, 0.0,
1 'click on two opposite corners of a selection rectangle')
call get_cursor(ex, ey, key, 0) call get_cursor(ex, ey, key, 0)
else else
call pgmtxt('T', 0.5, 0.0, 0.0, 'click on second corner of selection rectangle') call pgmtxt('T', 0.5, 0.0, 0.0,
1 'click on second corner of selection rectangle')
endif endif
call pgsci(6) call pgsci(6)
xmin=x1 xmin=x1
@ -495,19 +511,19 @@ subroutine tecs_plot(auxpar)
endif endif
x1=max(xmin,min(ex,fx)) x1=max(xmin,min(ex,fx))
x2=min(xmax,max(ex,fx)) x2=min(xmax,max(ex,fx))
if (x1>=x2) then if (x1 .ge. x2) then
x1=xmin x1=xmin
x2=xmax x2=xmax
endif endif
window=x2-x1 window=x2-x1
y1=max(ymin(1),min(ey,fy)) y1=max(ymin(1),min(ey,fy))
y2=min(ymax(1),max(ey,fy)) y2=min(ymax(1),max(ey,fy))
if (y1>=y2) then if (y1 .ge. y2) then
y1=ymin(1) y1=ymin(1)
y2=ymax(1) y2=ymax(1)
endif endif
mode=zoom mode=zoom
elseif (key >= '0' .and. key <= '9' .or. key == '.') then ! number elseif (key .ge. '0' .and. key .le. '9' .or. key .eq. '.') then ! number
if (numl .lt. len(numb)) then if (numl .lt. len(numb)) then
numl=numl+1 numl=numl+1
numb(numl:numl)=key numb(numl:numl)=key
@ -516,31 +532,32 @@ subroutine tecs_plot(auxpar)
call pgmtxt('T', 2.0, menuwid, 0.0, numb(1:numl)) call pgmtxt('T', 2.0, menuwid, 0.0, numb(1:numl))
endif endif
! call get_cursor(ex, ey, key, -chartperiod) ! call get_cursor(ex, ey, key, -chartperiod)
! if (key/=char(0)) goto 8 ! if (key .ne. char(0)) goto 8
if (mode==zoom) mode=0 if (mode .eq. zoom) mode=0
goto 7 goto 7
elseif (key == 'D') then elseif (key .eq. 'D') then
ex=1 ex=1
read(numb, *, iostat=i) ex read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(oneDay*ex))) window=min(maxRange,max(minRange, nint(oneDay*ex)))
if (mode < right) mode=right if (mode .lt. right) mode=right
x1=0 x1=0
elseif (key == 'H') then elseif (key .eq. 'H') then
ex=1 ex=1
read(numb, *, iostat=i) ex read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(3600*ex))) window=min(maxRange,max(minRange, nint(3600*ex)))
if (mode < right) mode=right if (mode .lt. right) mode=right
x1=0 x1=0
elseif (key == 'M') then elseif (key .eq. 'M') then
ex=1 ex=1
read(numb, *, iostat=i) ex read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(60*ex))) window=min(maxRange,max(minRange, nint(60*ex)))
if (mode < right) mode=right if (mode .lt. right) mode=right
x1=0 x1=0
elseif (key == 'T' .or. numl>0 .and. (key==char(13) .or. key==char(10))) then elseif (key .eq. 'T' .or. numl .gt. 0 .and.
1 (key .eq. char(13) .or. key .eq. char(10))) then
j=index(numb,'.') j=index(numb,'.')
day=0 day=0
if (j > 1 .and. j < numl) then if (j .gt. 1 .and. j .lt. numl) then
read(numb(1:j-1), *, iostat=i) day read(numb(1:j-1), *, iostat=i) day
mon=0 mon=0
read(numb(j+1:numl), *, iostat=i) mon read(numb(j+1:numl), *, iostat=i) mon
@ -553,24 +570,25 @@ subroutine tecs_plot(auxpar)
x2=oneDay x2=oneDay
window=x2 window=x2
mode=0 mode=0
elseif (key == 'L') then elseif (key .eq. 'L') then
if (mode == live) then if (mode .eq. live) then
mode=right mode=right
else else
mode=live mode=live
endif endif
elseif (key == 'F') then elseif (key .eq. 'F') then
saveit=.true. saveit=.true.
elseif (key=='Q' .or. key==char(13) .or. key==char(10)) then elseif (key .eq. 'Q' .or. key .eq. char(13)
1 .or. key .eq. char(10)) then
goto 9 goto 9
elseif (key == 'S') then elseif (key .eq. 'S') then
sel=sel+1 sel=sel+1
if (sel > tmax) sel=0 if (sel .gt. tmax) sel=0
if (mode==zoom) mode=0 if (mode .eq. zoom) mode=0
elseif (key == 'C') then elseif (key .eq. 'C') then
auxsel=auxsel+1 auxsel=auxsel+1
if (auxsel > amax) auxsel=1 if (auxsel .gt. amax) auxsel=1
elseif (mode==live) then elseif (mode .eq. live) then
goto 7 goto 7
endif endif
numl=0 numl=0
@ -586,43 +604,62 @@ subroutine tecs_plot(auxpar)
lund=41 lund=41
print '(x,a,$)', 'Filename: ' print '(x,a,$)', 'Filename: '
read(*,'(a)') filnam read(*,'(a)') filnam
open(lund, file=filnam, status='unknown') ! , carriagecontrol='list') open(lund, file=filnam, status='unknown')
l=0 line='time [h]'
i2=0 call str_trim(line, line, l)
do i1=1,nset do j=1,nset
if (i1 > nset-naux) then idx(j)=0
j=i1 do i=1,retlen(j)
else if (yd(i,j) .ne. undef) then
j=nset-i1+(1-naux) idx(j)=1
endif
gap=.false.
do i=1,retLen(j)
if (yd(i,j)==undef) then
if (gap) then
write(lund, '(f9.4,2a)') xd(i,j)/3600., char(9), ' '
gap=.false.
endif
else
if (i2/=i1) then
if (l > 0) write(lund, *)
call str_trim(parnam(j), parnam(j), text_len)
write(lund, *) ' time [h]',char(9), ' ',parnam(j)(1:text_len)
l=l+1 l=l+1
i2=i1 line(l:l)=char(9)
endif call str_trim(line(l+1:), parnam(j), text_len)
write(lund, '(f9.4,a,f9.4)') xd(i,j)/3600., char(9), max(-999.,min(9999.,yd(i,j))) l=l+max(9,text_len)
l=l+1 goto 109
gap=.true.
endif endif
enddo enddo
109 continue
enddo
write(lund, '(a)') line(1:l)
n=1
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))
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
l=l+1
line(l:l)=char(9)
if (idx(j) .le. retlen(j)) then
if (xd(idx(j),j) .lt. x0+1) then
write(line(l+1:), '(f9.4)')
1 max(-999.,min(9999.,yd(idx(j),j)))
l=l+9
idx(j)=idx(j)+1
endif
endif
endif
enddo
write(lund, '(a)') line(1:l)
n=n+1
endif
enddo enddo
close(lund) close(lund)
print *, l, ' lines written to ',filnam(1:48) print *, n, ' lines written to ',filnam(1:48)
endif endif
end subroutine end
subroutine get_cursor(x, y, key, mode) subroutine get_cursor(x, y, key, mode)
character*1 key character*1 key
@ -632,45 +669,50 @@ subroutine get_cursor(x, y, key, mode)
integer l integer l
character res*32 character res*32
if (with_timeout<0) then if (with_timeout .lt. 0) then
with_timeout=0 with_timeout=0
call pgqinf('VERSION', res, l) call pgqinf('VERSION', res, l)
if (res(l:l)=='+') then if (res(l:l) .eq. '+') then
call pgqinf('TYPE', res, l) call pgqinf('TYPE', res, l)
if (res(1:1)=='X') then if (res(1:1) .eq. 'X') then
with_timeout=1 with_timeout=1
end if end if
end if end if
end if end if
if (with_timeout>0 .or. mode>=0) then if (with_timeout .gt. 0 .or. mode .ge. 0) then
call pgband(mode, 0, x, y, x, y, key) call pgband(mode, 0, x, y, x, y, key)
else else
call sys_get_key(key, -mode) call sys_get_key(key, -mode)
endif endif
end subroutine end
subroutine purge_keys subroutine purge_keys
character key*1 character key*1
key=' ' key=' '
do while (key/=char(0)) do while (key .ne. char(0))
call sys_get_key(key, 0) call sys_get_key(key, 0)
end do end do
end subroutine end
subroutine set_win(rl, x1, x2, y1, y2) subroutine set_win(rl, x1, x2, y1, y2)
integer rl integer rl
real x1, x2, y1, y2 real x1, x2, y1, y2
if (rl == 1) then if (rl .eq. 1) then
call pgsvp(0.07,0.93,0.3,0.9) call pgsvp(0.07,0.93,0.3,0.9)
else else
call pgsvp(0.07,0.93,0.01,0.20) call pgsvp(0.07,0.93,0.01,0.20)
endif endif
call pgswin(x1,x2,y1,y2) call pgswin(x1,x2,y1,y2)
end subroutine end
integer function get_data(pars, first, last, step, tbase
1 , xd, yd, dmax, nmax, retlen)
integer function get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, retlen)
character pars*(*) character pars*(*)
integer first, last, step, tbase, dmax, nmax, retlen(nmax) integer first, last, step, tbase, dmax, nmax, retlen(nmax)
real*4 xd(dmax,nmax), yd(dmax,nmax) real*4 xd(dmax,nmax), yd(dmax,nmax)
@ -681,18 +723,20 @@ integer function get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, re
integer i,j,rl(maxn),m,k,n,mm integer i,j,rl(maxn),m,k,n,mm
if (nmax > maxn) stop 'get_data: nmax>maxn' if (nmax .gt. maxn) stop 'get_data: nmax>maxn'
if (last-first <= oneDay) then if (last-first .le. oneDay) then
get_data=tecs_get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, retLen) get_data=tecs_get_data(pars, first, last, step, tbase
1 , xd, yd, dmax, nmax, retLen)
else else
do j=1,nmax do j=1,nmax
retlen(j)=0 retlen(j)=0
enddo enddo
m=0 m=0
do i=first/oneDay,last/oneDay do i=first/oneDay,last/oneDay
get_data=tecs_get_data(pars, max(first,i*oneDay), min(last,(i+1)*oneDay-step), step, tbase & get_data=tecs_get_data(pars, max(first,i*oneDay)
, xd(m+1, 1), yd(m+1, 1), dmax, nmax, rl) 1 , min(last,(i+1)*oneDay-step), step, tbase
if (get_data<0) return 1 , xd(m+1, 1), yd(m+1, 1), dmax, nmax, rl)
if (get_data .lt. 0) return
mm=0 mm=0
do j=1,nmax do j=1,nmax
n=retlen(j) n=retlen(j)
@ -708,4 +752,4 @@ integer function get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, re
m=mm m=mm
enddo enddo
endif endif
end function end

6
tecs/tecs_serial.c
View File

@ -20,6 +20,7 @@
#define EOT '\r' #define EOT '\r'
typedef struct { typedef struct {
char host[64];
int type; /* = ASYNSRV_TYPE */ int type; /* = ASYNSRV_TYPE */
struct AsynSrv__info asyn_info; /* Contains skt, host, port & chan */ struct AsynSrv__info asyn_info; /* Contains skt, host, port & chan */
struct RS__MsgStruct to_host; struct RS__MsgStruct to_host;
@ -27,6 +28,7 @@ typedef struct {
} AsynSrvChan; } AsynSrvChan;
typedef struct { typedef struct {
char host[64];
int type; /* = TERMSRV_TYPE */ int type; /* = TERMSRV_TYPE */
char res[SER_BUF_LEN]; char res[SER_BUF_LEN];
int fd, tmo; int fd, tmo;
@ -88,6 +90,7 @@ SerChannel *SerOpen(const char *hostPort, int msecTmo, int (*idleHdl)(int,int))
logfileOut(LOG_MAIN, "connection to %s:%d/%d opened (%d sec)\n", logfileOut(LOG_MAIN, "connection to %s:%d/%d opened (%d sec)\n",
aser->asyn_info.host, aser->asyn_info.port, aser->asyn_info.chan, aser->asyn_info.host, aser->asyn_info.port, aser->asyn_info.chan,
t2-t1); t2-t1);
str_copy(aser->host, hostPort);
return((SerChannel *)aser); return((SerChannel *)aser);
} else { } else {
NEW(tser, TermSrvChan); tser->type=TERMSRV_TYPE; NEW(tser, TermSrvChan); tser->type=TERMSRV_TYPE;
@ -103,6 +106,7 @@ SerChannel *SerOpen(const char *hostPort, int msecTmo, int (*idleHdl)(int,int))
time(&t2); time(&t2);
ecnt=0; ecnt=0;
logfileOut(LOG_MAIN, "connected to %s (%d sec)\n", hostPort, t2-t1); logfileOut(LOG_MAIN, "connected to %s (%d sec)\n", hostPort, t2-t1);
str_copy(tser->host, hostPort);
return ((SerChannel *)tser); return ((SerChannel *)tser);
} }
OnError: OnError:
@ -137,7 +141,7 @@ void SerClose(SerChannel *serch) {
if (serch->type==ASYNSRV_TYPE) { if (serch->type==ASYNSRV_TYPE) {
aser=(AsynSrvChan *)serch; aser=(AsynSrvChan *)serch;
AsynSrv_Close(&aser->asyn_info, 0); AsynSrv_Close(&aser->asyn_info, 1);
} else if (serch->type==TERMSRV_TYPE) { } else if (serch->type==TERMSRV_TYPE) {
tser=(TermSrvChan *)serch; tser=(TermSrvChan *)serch;
close(tser->fd); close(tser->fd);

1
tecs/tecs_serial.h
View File

@ -4,6 +4,7 @@
#define SER_BUF_LEN 320 #define SER_BUF_LEN 320
typedef struct { typedef struct {
char host[64];
/* private */ /* private */
int type; int type;
} SerChannel; } SerChannel;