From a14b12b72695253cce9d3b9ab7cb51be7a1f57e1 Mon Sep 17 00:00:00 2001 From: cvs Date: Wed, 16 Oct 2002 11:35:40 +0000 Subject: [PATCH] tecs_plot.f is now ext. f77 --- tecs/coc_server.c | 13 +- tecs/coc_util.c | 2 +- tecs/makefile | 16 +- tecs/myc_buf.c | 17 +- tecs/myc_buf.h | 2 +- tecs/myc_mem.h | 2 +- tecs/tecs.c | 75 ++- tecs/tecs_cli.c | 25 +- tecs/tecs_client.f | 3 +- tecs/tecs_plot.f | 1454 +++++++++++++++++++++++--------------------- tecs/tecs_serial.c | 6 +- tecs/tecs_serial.h | 1 + 12 files changed, 860 insertions(+), 756 deletions(-) diff --git a/tecs/coc_server.c b/tecs/coc_server.c index a56f0c9b..98eb5982 100644 --- a/tecs/coc_server.c +++ b/tecs/coc_server.c @@ -288,12 +288,19 @@ char *CocReadVars(char *str, char stop){ if (cr==NULL) return strchr(str, '\0'); str=cr+1; } else { - str+=l; eql=strchr(buf,'='); if (eql==NULL) ERR_MSG("syntax error"); *eql='\0'; - StrLink(&sbuf, eql+1); - ERR_I(CocGetVar(buf, &sbuf, ' ')); + 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); + ERR_I(CocGetVar(buf, &sbuf, ' ')); + } } i=sscanf(str, "%79s%n", buf, &l); } diff --git a/tecs/coc_util.c b/tecs/coc_util.c index 10835eaf..b90a024b 100644 --- a/tecs/coc_util.c +++ b/tecs/coc_util.c @@ -90,7 +90,7 @@ int CocRecv(int fd, StrBuf *buf, int timeout, int *flag) { n=0; ERR_SI(i=recv(fd, &n, 4, 0)); if (i!=4) { - ERR_COD(ECONNRESET); + ERR_COD(ECONNREFUSED); } siz=ntohl(n); if (siz > buf->dsize) diff --git a/tecs/makefile b/tecs/makefile index d00c9f6f..22db50cb 100644 --- a/tecs/makefile +++ b/tecs/makefile @@ -7,7 +7,6 @@ #------------ for DigitalUnix (add -DFORTIFY to CC_... for fortified version) CC_alpha_osf1=cc -std1 -g -warnprotos -I../ -I. -I../hardsup 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 SYS_FILE_alpha_osf1=sys_aunix #CFLAGS_alpha_osf1= -std1 -g -warnprotos -I../ -I. -I../hardsup -DFORTIFY @@ -15,14 +14,12 @@ SYS_FILE_alpha_osf1=sys_aunix #---------- for Redhat linux CC_i386_linux= gcc -I/usr/local/include -I. -I../ -I../hardsup -DLINUX -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 TECLI_LIB_i386_linux=pgplot/libpgplot.a -L/usr/X11R6/lib -lX11 #------------ CC=$(CC_$(MACHTYPE)_$(OSTYPE)) FOR=$(FOR_$(MACHTYPE)_$(OSTYPE)) -TECS_PLOT=$(TECS_PLOT_$(MACHTYPE)_$(OSTYPE)) TECLI_LIB=$(TECLI_LIB_$(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 -tecs_plot.o: tecs_plot.f - $(TECS_PLOT) +six: bin/six bin/TecsServer: $(SERV_OBJ) - rm bin/TecsServer @@ -60,12 +56,18 @@ bin/TecsClient: $(TECLI_OBJ) 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 - $(CC) -o six six.c term.c sys_select.c libtecsl.a +bin/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 $(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 $(CC) -o bin/keep_running keep_running.c diff --git a/tecs/myc_buf.c b/tecs/myc_buf.c index 192edfa1..98049393 100644 --- a/tecs/myc_buf.c +++ b/tecs/myc_buf.c @@ -22,13 +22,18 @@ char *StrNGet(StrBuf *buf, char *result, int reslen, int sep) { if (f==NULL) ERR_MSG("missing '""'"); l=f-b; - e=strchr(f+1, sep); - if (e==NULL) { - buf->rdpos = f - buf->buf + 1 + strlen(f+1); - buf->seen=0; + if (sep == StrNONE) { + buf->rdpos=f - buf->buf + 1; + buf->seen = 0; } else { - buf->rdpos = e - buf->buf + 1; - buf->seen=1; + e=strchr(f+1, sep); + if (e==NULL) { + buf->rdpos = f - buf->buf + 1 + strlen(f+1); + buf->seen=0; + } else { + buf->rdpos = e - buf->buf + 1; + buf->seen=1; + } } } else { f=strchr(b, sep); diff --git a/tecs/myc_buf.h b/tecs/myc_buf.h index e7f442b2..853022e8 100644 --- a/tecs/myc_buf.h +++ b/tecs/myc_buf.h @@ -25,7 +25,7 @@ int StrPutArray(StrBuf *buf, float val[], int size); Read from the buffer until separator sep. Use the StrGet macro if the result is a fixed size. 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 */ char *StrNGet(StrBuf *buf, char *result, int reslen, int sep); diff --git a/tecs/myc_mem.h b/tecs/myc_mem.h index c9f91b56..c734f2eb 100644 --- a/tecs/myc_mem.h +++ b/tecs/myc_mem.h @@ -25,6 +25,6 @@ #define NEW_STR(TO,FROM) {ERR_SP(TO=malloc(strlen(FROM)+1)); strcpy(TO,FROM); } #define MALLOC(SIZE) malloc(SIZE) -#define FREE(PTR) free(PTR) +#define FREE(PTR) { free(PTR); PTR=NULL; } #endif /* _MEM_UTIL_H_ */ diff --git a/tecs/tecs.c b/tecs/tecs.c index 1b4e9565..5b9e4282 100644 --- a/tecs/tecs.c +++ b/tecs/tecs.c @@ -146,7 +146,7 @@ static int nScan=0, /* number of scanned channels */ alarmListSize=0, lockAlarm, - cntError, + cntError, tableTime; /* last time when table was read */ int tim, rdTim; /* actual time, read Time */ @@ -168,6 +168,8 @@ static char heUnits[4], /* helium level units */ alarmChannels[N_SENSORS], alarmHistory[N_SENSORS], + dev[80], + devHelp[10000], controlChannel[4]="A"; static char @@ -543,7 +545,7 @@ int PrepInput(char *label) { if (i<1) ERR_MSG("missing chans"); t+=l; - /* interprete settings until '+' appeares */ + /* interprete settings until '+' appeares (after whitespace) */ ERR_P(CocReadVars(t, '+')); if (loop!=2) loop=1; @@ -2076,6 +2078,50 @@ EndStatus: 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 && en12) 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) { if (mode==COC_WR) { return COC_DWR; @@ -2118,18 +2164,6 @@ int TmoHdl(int mode, void *base, int fd) { 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) { char buf[256]; if (mode==COC_WR) { @@ -2237,7 +2271,7 @@ int main(int argc, char *argv[]) { CocFltFld(SensorT, t0, RD); CocFltFld(SensorT, t1, RD); CocFltFld(SensorT, t2, RD); - CocFltFld(SensorT, lim, RD); + CocFltFld(SensorT, lim, RW); CocFltFld(SensorT, scale, RD); CocFltFld(SensorT, alarm, RW); CocHdl(AlarmHdl); CocIntFld(SensorT, readStat, RD); @@ -2297,6 +2331,8 @@ int main(int argc, char *argv[]) { CocDefStr(status, RD); CocHdl(StatusHdl); CocDefStr(pid, RD); CocHdl(PidSumHdl); CocDefStr(config, RD); + CocDefStr(dev, RD); + CocDefStr(devHelp, RD); CocHdl(DevHelpHdl); CocDefInt(cod1, RD); CocDefInt(cod2, RD); @@ -2342,7 +2378,7 @@ int main(int argc, char *argv[]) { CocAlias(int,integ); CocDefInt(msecTmo, RW); CocHdl(TmoHdl); - CocDefStr(host, RW); CocHdl(SerHdl); + CocDefStr(host, RW); CocDefInt(port, RD); CocDefInt(use_stdout, RW); CocHdl(LogfileHdl); CocDefStr(serverId, RW); CocHdl(LogfileHdl); @@ -2395,7 +2431,7 @@ int main(int argc, char *argv[]) { logfileOut(LOG_MAIN ,"?"); } else { CocReadVars(inistr, '\0'); - free(inistr); + FREE(inistr); } } } @@ -2451,6 +2487,11 @@ int main(int argc, char *argv[]) { cntError=0; while (!quit) { iret=MainBody(); + if (ser!=NULL && 0!=strcmp(host, ser->host)) { + SerClose(ser); + ser=NULL; + noResp=1; + } if (iret<0 || ser==NULL) { cntError++; ser=SerCheck(ser); diff --git a/tecs/tecs_cli.c b/tecs/tecs_cli.c index 9d44a7aa..b8403ed0 100644 --- a/tecs/tecs_cli.c +++ b/tecs/tecs_cli.c @@ -68,7 +68,7 @@ int TeccGet3(pTecsClient conn, float *tC, float *tX, float *tP) { ERR_I(CocPutInt(conn, "readTemp", 1)); ERR_I(iret=CocDoIt(conn, response, sizeof(response))); if (iret) ERR_MSG(response); - return(0); + return 0; OnError: return(-1); } @@ -80,7 +80,7 @@ int TeccGet(pTecsClient conn, float *temp) { ERR_I(CocPutInt(conn, "readTemp", 1)); ERR_I(iret=CocDoIt(conn, response, sizeof(response))); if (iret) ERR_MSG(response); - return(0); + return 0; OnError: return(-1); } @@ -91,7 +91,7 @@ int TeccSet(pTecsClient conn, float temp) { ERR_I(CocPutFloat(conn, "set", temp)); ERR_I(iret=CocDoIt(conn, response, sizeof(response))); if (iret) ERR_MSG(response); - return(0); + return 0; 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) { printf("%s", response); } - return(0); + return 0; 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))); - return(0); + return 0; 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); ERR_P(conn=TeccInit(sbuf, *port)); - return(0); + return 0; 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(hbuf, host); ERR_P(conn=TeccStart(sbuf, hbuf, *port)); - return(0); + if (conn->fd<0) return 1; + return 0; OnError: return(-1); } @@ -231,25 +232,25 @@ int F_FUN(tecs_rights)(int write) { } else { ERR_I(CocSendMagic(conn, rdCode)); } - return(0); + return 0; OnError: return(-1); } int F_FUN(tecs_get)(float *temp) { ERR_I(TeccGet(conn, temp)); - return(0); + return 0; OnError: return(-1); } int F_FUN(tecs_get3)(float *t1, float *t2, float *t3) { ERR_I(TeccGet3(conn, t1, t2, t3)); - return(0); + return 0; OnError: return(-1); } int F_FUN(tecs_set)(float *temp) { ERR_I(TeccSet(conn, *temp)); - return(0); + return 0; OnError: return(-1); } @@ -274,7 +275,7 @@ int F_FUN(tecs_watch_log)(F_CHAR(list), int list_len) { char buf[16]; STR_TO_C(buf, list); ERR_I(CocWatchLog(conn, buf)); - return(0); + return 0; OnError: return(-1); } diff --git a/tecs/tecs_client.f b/tecs/tecs_client.f index d0dd1224..85a06fdb 100644 --- a/tecs/tecs_client.f +++ b/tecs/tecs_client.f @@ -56,8 +56,7 @@ else iret=tecs_start(start, ' ', 9753) endif - - if (iret .lt. 0) goto 90 + if (iret .ne. 0) goto 90 if (oneCommand) goto 11 diff --git a/tecs/tecs_plot.f b/tecs/tecs_plot.f index f9386a8f..78ea8a61 100644 --- a/tecs/tecs_plot.f +++ b/tecs/tecs_plot.f @@ -1,711 +1,755 @@ -subroutine tecs_plot(auxpar) + subroutine tecs_plot(auxpar) - character(len=*) auxpar + character*(*) auxpar + + integer dmax, nmax, tmax, amax, nmenu, chartperiod, naux + parameter (dmax=400, nmax=9, tmax=8, amax=3, nmenu=13 + 1 , chartperiod=5, naux=1) + integer minRange, maxRange, oneDay + parameter (minRange=60, maxRange=7*24*3600, oneDay=24*3600) + integer zoom, right, live + parameter (zoom=1, right=2, live=3) + 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 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 + integer l,j,i,n,t,leng,i1,i2,rl,startday,thisday + integer ncol, nset, mode + integer first,last,step,tbase,lastj + integer colorList(nmax)/5,3,2,4,6,8,14,15,8/ + integer color(nmax) + integer retLen(nmax) + integer sel/0/, sel1, sel2, auxsel/1/ + 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 ,'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','T1','T2','T3','T4'/ + character*4 apar(amax)/'P', 'He', 'Aux'/ + character*16 parnam(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 + + ! functions + integer sys_gmt_off, myc_now, myc_time, myc_date, get_data + integer tecs_get_mult, tecs_get_par + + data window/0./ + + if (window .eq. 0) window=1800. + saveit=.false. + mode=live + call pgopen(' ') + + call pgqinf('TYPE', device, l) + if (device .eq. 'NULL') then + call pgclos + call pgopen('?') + call pgqinf('TYPE', device, l) + if (device .eq. 'NULL') then + print *,'No PGPLOT-Device defined' + goto 9 + endif + endif + + call pgqcol(i,ncol) + ! print *,i,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) + call pgscr(2, 1.0, 0.0, 0.0) + call pgscr(3, 0.0, 1.0, 0.0) + call pgscr(4, 0.0, 0.0, 1.0) + call pgscr(5, 0.0, 1.0, 1.0) + call pgscr(6, 1.0, 0.0, 1.0) + call pgscr(7, 1.0, 1.0, 0.0) + call pgscr(8, 1.0, 0.5, 0.0) + endif + + call pgask(.false.) + call pgupdt + l=0 + x1=0 + step=0 + do i=1,amax + if (auxpar .eq. apar(i)) then + auxsel=i + endif + enddo + +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 + step=window/(dmax-2)+0.99 + last=t + first=t-min(dmax*step-1,nint(window)) + else + if (mode .eq. zoom) then + x2=(x1+x2+window)/2 + x1=x2-window + endif + if (x1 .gt. x2-minRange) x1=x2-minRange + step=(x2-x1)/(dmax-2)+0.99 + last=x2+tbase + first=x1-step+tbase + endif + if (step .eq. 0) step=1 + + if (step .gt. 60) then ! normalize step + step=(step+59)/60*60 + else if (step .gt. 30) then + step=60 + elseif (step .gt. 20) then + step=30 + else + step=(step+4)/5*5 + endif + 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 + 1 , xd, yd, dmax, nmax, retLen) + if (iret .lt. 0) goto 99 + + x2 = last - tbase + if (mode .ge. right) then + x1=x2-window + else + 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) + 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) + endif + enddo + if (sel .ne. 0) then + do while (sel .lt. nset .and. retLen(sel) .eq. 0) + sel=sel+1 + 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 + else + ticks=0.0 ! automatic + 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 + if (mode .eq. zoom .and. rl .eq. 1) then + ymin(1)=y1 + ymax(1)=y2 + else + ymin(rl)=1e30 + 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 + enddo + + ey=(ymax(rl)-ymin(rl)) + fy=abs(ymax(rl)) + ymax(rl)=ymax(rl)+max(fy*0.0075,ey*0.01) + ymin(rl)=ymin(rl)-max(fy*0.005,ey*0.01) + if (mode .eq. live) then + ymin(rl)=min(ymin(rl),max(0.0,ylast1-ey*0.4)) + ymax(rl)=max(ymax(rl),ylast2+ey*0.4) + endif + endif + + if (ymax(rl) .lt. ymin(rl)) then + 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 + + call set_win(rl,x1,x2,ymin(rl),ymax(rl)) + + 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)) + 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 + call pgsci(1) + if (rl .eq. 1) then + call pgsch(1.0) + call pgtbox('ZHXYBINST', ticks, 0, 'BCINMST', 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) + if (name .eq. 'Tm') then + name='Main Sensor' + elseif (name .eq. 'Ts') then + name='Sample Sensor' + elseif (name .eq. 'Tr') then + name='SetPoint' + endif + call str_trim(name, name, name_len) + if (sel .eq. i) 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 pgmtxt ('L', 2.5, ey, 0.0, name(1:name_len)) + ey=ey+fy+0.04 + endif + 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)) + endif + endif + i1=nset-naux+1 + i2=nset + sel1=i1 + sel2=i2 + enddo + + call pgsch(0.7) + rl=1 + call set_win(rl,x1,x2,ymin(rl),ymax(rl)) + + call pgsci(1) + call pgsclp(0) + if (mode .eq. live) then + text(2,1)='live off' + 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)) + call pgmtxt('T', 2.5, menuwid, 0.0, '|') + call pgmtxt('T', 2.0, menuwid, 0.0, '|'//text(2,i)) + menuwid=menuwid+fx+0.01 + enddo + call pgmtxt('T', 3.0, menuwid, 0.0, '|') + call pgmtxt('T', 2.5, menuwid, 0.0, '|') + call pgmtxt('T', 2.0, menuwid, 0.0, '|') + menuwid=menuwid+0.01 + + call pgsch(0.8) + done=.false. + row=(ymax(rl)-ymin(rl))/30. + ey=ymin(rl)-row*3.5 + i=max(0,int((x1+oneDay/2)/oneDay)) + + ex=(i+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)) + ex=ex-12*3600 + if (ex .gt. x1) then + call pgmove(ex, ey) + call pgdraw(ex, ey+row) + endif + ex=ex+oneDay + if (ex .lt. x2) then + call pgmove(ex, ey) + call pgdraw(ex, ey+row) + endif + i=i+1 + ex=(i+0.5)*oneDay + enddo + if (.not. done) then + n=nint(x2)/oneDay*oneDay + i=nint(x1)-n + j=nint(x2)-n + if (i .lt. 0) then + if (-i .gt. j) then + ex=0.0 + i=nint(x1)+tbase + else + ex=1.0 + i=nint(x2)+tbase + endif + else + ex=0.5 + i=nint(x2)+tbase + endif + thisday=mod(i/oneDay,7)+1 + write(buf,'(i8.8)') myc_date(i) + 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 + title='test - no device' + endif + + call pgmtxt('T', -1.5, 0.02, 0.0, title) + call pgsclp(1) + + call purge_keys ! purge buffer + + numl=0 + numb=' ' +7 ex=undef + if (mode .eq. live) 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)') + ! endif + ! call get_key(key, 0, chartperiod) + i=chartperiod-mod(myc_now(), chartperiod) + call get_cursor(ex, ey, key, -i) + + 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 + tim1=t-tbase + if (tim1 .gt. x2) then + call pgpage + window=x2-x1 + 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 + endif + call pgsci(color(i)) + call pgmove(tim0, yy0(i)) + call pgdraw(tim1, yy1(i)) + 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) + enddo + else + call get_cursor(ex, ey, key, 0) + endif + rl=1 + call set_win(rl,x1,x2,ymin(rl),ymax(rl)) + +8 if (key .ge. 'a') key=char(ichar(key)-32) + if (key .eq. '-') then + window=min(window*2, 8.0*oneDay) + if (mode .eq. zoom) then + x1=x1-(x2-x1)/2 + x2=x2+(x2-x1)/3 + y1=y1-(y2-y1)/2 + y2=y2+(y2-y1)/3 + endif + elseif (key .eq. 'X') then + window=0 + mode=0 + elseif (key .eq. '+' .or. key .eq. ',') then + window=max(winmin,window/2) + if (mode .eq. zoom) then + if (ex .eq. undef) then + ex=(x1+x2)/2 + ey=(min(y2,ymax(1))+max(y1,ymin(1)))/2 + end if + fx=max(winmin,x2-x1) + fy=max(y2-y1,1e-3,y2*1e-5) + x1=ex-fx/4 + x2=ex+fx/4 + y1=ey-fy/4 + y2=ey+fy/4 + endif + elseif (key .eq. 'Z') then + call pgsci(1) + if (ex .eq. undef) then + 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) + else + call pgmtxt('T', 0.5, 0.0, 0.0, + 1 'click on second corner of selection rectangle') + endif + call pgsci(6) + xmin=x1 + xmax=x2 + call pgmove(xmin, ey) + call pgdraw(xmax, ey) + call pgmove(ex, ymin(rl)) + call pgdraw(ex, ymax(rl)) + if (device(1:1) .eq. 'X') then + fx=ex + fy=ey + call get_cursor(fx, fy, key, 2) + else + call get_cursor(fx, fy, key, 0) + endif + x1=max(xmin,min(ex,fx)) + x2=min(xmax,max(ex,fx)) + if (x1 .ge. x2) then + x1=xmin + x2=xmax + endif + window=x2-x1 + y1=max(ymin(1),min(ey,fy)) + y2=min(ymax(1),max(ey,fy)) + if (y1 .ge. y2) then + y1=ymin(1) + y2=ymax(1) + endif + mode=zoom + elseif (key .ge. '0' .and. key .le. '9' .or. key .eq. '.') then ! number + if (numl .lt. len(numb)) then + numl=numl+1 + numb(numl:numl)=key + call pgsci(1) + call pgsch(0.8) + call pgmtxt('T', 2.0, menuwid, 0.0, numb(1:numl)) + endif + ! call get_cursor(ex, ey, key, -chartperiod) + ! if (key .ne. char(0)) goto 8 + if (mode .eq. zoom) mode=0 + goto 7 + elseif (key .eq. 'D') then + ex=1 + read(numb, *, iostat=i) 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 + 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 + window=min(maxRange,max(minRange, nint(60*ex))) + if (mode .lt. right) mode=right + x1=0 + elseif (key .eq. 'T' .or. numl .gt. 0 .and. + 1 (key .eq. char(13) .or. key .eq. char(10))) then + j=index(numb,'.') + day=0 + if (j .gt. 1 .and. j .lt. numl) then + read(numb(1:j-1), *, iostat=i) day + mon=0 + read(numb(j+1:numl), *, iostat=i) mon + tbase = myc_time(day+mon*100) + else + read(numb, *, iostat=i) day + tbase = myc_time(day) + endif + x1=0 + x2=oneDay + window=x2 + mode=0 + elseif (key .eq. 'L') then + if (mode .eq. live) then + mode=right + else + mode=live + endif + elseif (key .eq. 'F') then + saveit=.true. + 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 (mode .eq. live) then + goto 7 + endif + numl=0 + numb=' ' + call pgpage + goto 1 +99 call tecs_write_msg(6) +9 continue + call pgclos + call purge_keys + print * + if (saveit) then + lund=41 + print '(x,a,$)', 'Filename: ' + read(*,'(a)') filnam + open(lund, file=filnam, status='unknown') + + line='time [h]' + 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 + l=l+1 + line(l:l)=char(9) + call str_trim(line(l+1:), parnam(j), text_len) + l=l+max(9,text_len) + goto 109 + endif + 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 + close(lund) + print *, n, ' lines written to ',filnam(1:48) + endif + + end + - integer dmax, nmax, tmax, amax, nmenu, chartperiod, naux - parameter (dmax=400, nmax=9, tmax=8, amax=3, nmenu=13, chartperiod=5, naux=1) - integer minRange, maxRange, oneDay - parameter (minRange=60, maxRange=7*24*3600, oneDay=24*3600) - integer zoom, right, live - parameter (zoom=1, right=2, live=3) - real winmin, undef - parameter (winmin=60., undef=-1.125/1024./1024./1024.) + subroutine get_cursor(x, y, key, mode) + character*1 key + real*4 x, y + integer mode + integer with_timeout/-1/ + integer l + character res*32 + + if (with_timeout .lt. 0) then + with_timeout=0 + call pgqinf('VERSION', res, l) + if (res(l:l) .eq. '+') then + call pgqinf('TYPE', res, l) + if (res(1:1) .eq. 'X') then + with_timeout=1 + end if + end if + end if + if (with_timeout .gt. 0 .or. mode .ge. 0) then + call pgband(mode, 0, x, y, x, y, key) + else + call sys_get_key(key, -mode) + endif + end + - real*4 x1,x2,xmin,xmax,ymin(2),ymax(2),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 - integer l,j,i,n,t,leng,i1,i2,rl,startday,thisday - integer ncol, nset, mode - integer first,last,step,tbase,lastj - integer colorList(nmax)/5,3,2,4,6,8,14,15,8/ - integer color(nmax) - integer retLen(nmax) - integer sel/0/, sel1, sel2, auxsel/1/ - character key*1 - character text(2,nmenu)*16/ & - 'L' ,'live off' & - ,'z' ,'sel. zoom' & - ,'+' ,'zoom in' & - ,'-' ,'zoom out' & - ,'x' ,'show all' & - ,'2d' ,'2 days' & - ,'1h' ,'1 hour' & - ,'15m' ,'15 min' & - ,'31.7t','goto date' & - ,'c' ,'show P/He/Aux' & - ,'s' ,'select T' & - ,'f' ,'write file' & - ,'q' ,'quit'/ - character weekdays(7)*4/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/ - character buf*8, device*8, name*40, filnam*128, numb*16, title*64, pars*64 - character(len=4) tpar(tmax)/'Te', 'Tr', 'Tm', 'Ts', 'T1', 'T2', 'T3', 'T4'/ - character(len=4) apar(amax)/'P', 'He', 'Aux'/ - character(len=16) parnam(nmax) - logical gap, done - logical saveit - integer iret, lund, numl, mon, day - integer pars_len, title_len, text_len, name_len + subroutine purge_keys + character key*1 + key=' ' + do while (key .ne. char(0)) + call sys_get_key(key, 0) + end do + end + -! functions - integer sys_gmt_off, myc_now, myc_time, myc_date, get_data, tecs_get_mult, tecs_get_par + subroutine set_win(rl, x1, x2, y1, y2) + integer rl + real x1, x2, y1, y2 + + if (rl .eq. 1) then + call pgsvp(0.07,0.93,0.3,0.9) + else + call pgsvp(0.07,0.93,0.01,0.20) + endif + + call pgswin(x1,x2,y1,y2) + end - data window/0./ + + integer function get_data(pars, first, last, step, tbase + 1 , xd, yd, dmax, nmax, retlen) - if (window==0) window=1800. - saveit=.false. - mode=live - call pgopen(' ') - - call pgqinf('TYPE', device, l) - if (device=='NULL') then - call pgclos - call pgopen('?') - call pgqinf('TYPE', device, l) - if (device=='NULL') then - print *,'No PGPLOT-Device defined' - goto 9 - endif - endif - - call pgqcol(i,ncol) -! print *,i,ncol,' colors ',device - if (ncol>=8 .and. device /= 'VT125') then - call pgscr(0, 1.0, 1.0, 1.0) - call pgscr(1, 0.0, 0.0, 0.0) - call pgscr(2, 1.0, 0.0, 0.0) - call pgscr(3, 0.0, 1.0, 0.0) - call pgscr(4, 0.0, 0.0, 1.0) - call pgscr(5, 0.0, 1.0, 1.0) - call pgscr(6, 1.0, 0.0, 1.0) - call pgscr(7, 1.0, 1.0, 0.0) - call pgscr(8, 1.0, 0.5, 0.0) - endif - - call pgask(.false.) - call pgupdt - l=0 - x1=0 - step=0 - do i=1,amax - if (auxpar == apar(i)) then - auxsel=i - endif - enddo - -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 < 0) goto 99 - if (window == 0) then - last=t - step=maxRange/dmax - window=maxRange - first=t-min(dmax*step-1,maxRange-step) - else if (mode >= right) then - step=window/(dmax-2)+0.99 - last=t - first=t-min(dmax*step-1,nint(window)) - else - if (mode==zoom) then - x2=(x1+x2+window)/2 - x1=x2-window - endif - if (x1 .gt. x2-minRange) x1=x2-minRange - step=(x2-x1)/(dmax-2)+0.99 - last=x2+tbase - first=x1-step+tbase - endif - if (step == 0) step=1 - - if (step>60) then ! normalize step - step=(step+59)/60*60 - else if (step>30) then - step=60 - elseif (step>20) then - step=30 - else - step=(step+4)/5*5 - endif - 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, xd, yd, dmax, nmax, retLen) - if (iret < 0) goto 99 - - x2 = last - tbase - if (mode >= right) then - x1=x2-window - else - x1 = first - tbase - endif - tim0=t-tbase - do i=1,nset - leng=retLen(i) - do while (leng > 1 .and. yd(leng,i) == undef) - leng=leng-1 - enddo - if (leng == 1) leng=0 - retLen(i)=leng - if (mode==live .and. leng>0) then - xd(leng,i)=tim0 - yd(leng,i)=yy0(i) - endif - enddo - if (sel /= 0) then - do while (sel < nset .and. retLen(sel) == 0) - sel=sel+1 - enddo - if (sel >= nset) sel = 0 - endif - if (saveit) goto 9 - if (mode==live) then - x2=max(tim0,x2)+min(1800., window*0.5) - endif - - if (window>50*3600) then - ticks=8*3600 - elseif (window>25*3600) then - ticks=4*3600 - else - ticks=0.0 ! automatic - endif - - i1=1 - i2=nset-naux - if (sel==0) then - sel1=i1 - sel2=i2 - else - sel1=sel - sel2=sel - endif - do rl=1,2 - if (mode==zoom .and. rl==1) then - ymin(1)=y1 - ymax(1)=y2 - else - ymin(rl)=1e30 - ymax(rl)=-1e30 - ylast1=ymin(rl) - ylast2=ymax(rl) - do i=sel1,sel2 - do j=1,retLen(i) - if (yd(j,i)/=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)/=undef) then - ylast1=min(ylast1,yd(j, i)) - ylast2=max(ylast2,yd(j, i)) - endif - enddo - enddo - - ey=(ymax(rl)-ymin(rl)) - fy=abs(ymax(rl)) - ymax(rl)=ymax(rl)+max(fy*0.0075,ey*0.01) - ymin(rl)=ymin(rl)-max(fy*0.005,ey*0.01) - if (mode==live) then - ymin(rl)=min(ymin(rl),max(0.0,ylast1-ey*0.4)) - ymax(rl)=max(ymax(rl),ylast2+ey*0.4) - endif - endif - - if (ymax(rl) < ymin(rl)) then - ymax(rl)=1.0 - ymin(rl)=0 - elseif (ymax(rl) == ymin(rl)) then - ymax(rl)=ymin(rl)*1.00001+1.0 - ymin(rl)=-1.0e-3 - endif - - call set_win(rl,x1,x2,ymin(rl),ymax(rl)) - - do i=i1,i2 - call pgsci(color(i)) - l=0 - lastj=1 - do j=1,retLen(i) - if (yd(j,i)==undef) then - if (j>lastj) then - call pgline(j-lastj, xd(lastj,i), yd(lastj,i)) - endif - lastj=j+1 - else - l=j - endif - enddo - if (retLen(i) > lastj) call pgline(retLen(i)+1-lastj, xd(lastj,i), yd(lastj,i)) - retLen(i)=l - enddo - call pgsci(1) - if (rl == 1) then - call pgsch(1.0) - call pgtbox('ZHXYBINST', ticks, 0, 'BCINMST', 0.0, 0) - call pgtbox('C', 0.0, 0, ' ', 0.0, 0) - ey=0.0 - do i=i1,i2 - if (retLen(i) > 0) then - name=parnam(i) - if (name=='Tm') then - name='Main Sensor' - elseif (name=='Ts') then - name='Sample Sensor' - elseif (name=='Tr') then - name='SetPoint' - endif - call str_trim(name, name, name_len) - if (sel == i) 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 pgmtxt ('L', 2.5, ey, 0.0, name(1:name_len)) - ey=ey+fy+0.04 - endif - 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) == 'P' .or. parnam(nset) == 'p') then - call pgmtxt ('L', 2.5, 0.5, 0.5, 'Power [W]') - elseif (parnam(nset) == '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, 'Helium ['//title(1:title_len)//']') - else - call pgmtxt ('L', 2.5, 0.5, 0.5, parnam(nset)) - endif - endif - i1=nset-naux+1 - i2=nset - sel1=i1 - sel2=i2 - enddo - - call pgsch(0.7) - rl=1 - call set_win(rl,x1,x2,ymin(rl),ymax(rl)) - - call pgsci(1) - call pgsclp(0) - if (mode==live) then - text(2,1)='live off' - 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)) - call pgmtxt('T', 2.5, menuwid, 0.0, '|') - call pgmtxt('T', 2.0, menuwid, 0.0, '|'//text(2,i)) - menuwid=menuwid+fx+0.01 - enddo - call pgmtxt('T', 3.0, menuwid, 0.0, '|') - call pgmtxt('T', 2.5, menuwid, 0.0, '|') - call pgmtxt('T', 2.0, menuwid, 0.0, '|') - menuwid=menuwid+0.01 - - call pgsch(0.8) - done=.false. - row=(ymax(rl)-ymin(rl))/30. - ey=ymin(rl)-row*3.5 - i=max(0,int((x1+oneDay/2)/oneDay)) - - do - ex=(i+0.5)*oneDay - if (ex > x2) EXIT - done=.true. - 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)) - ex=ex-12*3600 - if (ex > x1) then - call pgmove(ex, ey) - call pgdraw(ex, ey+row) - endif - ex=ex+oneDay - if (ex < x2) then - call pgmove(ex, ey) - call pgdraw(ex, ey+row) - endif - i=i+1 - enddo - if (.not. done) then - n=nint(x2)/oneDay*oneDay - i=nint(x1)-n - j=nint(x2)-n - if (i < 0) then - if (-i > j) then - ex=0.0 - i=nint(x1)+tbase - else - ex=1.0 - i=nint(x2)+tbase - endif - else - ex=0.5 - i=nint(x2)+tbase - endif - thisday=mod(i/oneDay,7)+1 - 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, weekdays(thisday)//buf(7:8)//'.'//buf(5:6)) - endif - - iret=tecs_get_par('device', title, 0) - if (iret < 0) goto 99 - i=index(title, '(') - if (i > 2 ) then - title=title(1:i-1) - else - title='test - no device' - endif - - call pgmtxt('T', -1.5, 0.02, 0.0, title) - call pgsclp(1) - - call purge_keys ! purge buffer - - numl=0 - numb=' ' -7 ex=undef - if (mode==live) then -! if (device(1:1)=='X') then -! 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) - - do while (key == char(0) .or. key == ' ') ! no key or space key pressed - iret=tecs_get_mult(pars, t, nset, yy1) - if (iret<0) goto 99 - tim1=t-tbase - if (tim1 > x2) then - call pgpage - window=x2-x1 - goto 1 - endif - if (tim1 > 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) /= undef .and. yy1(i) /= undef) then - if ((sel==0 .or. sel==i) .and. (yy1(i) < ymin(rl) .or. yy1(i) > ymax(rl))) then - call pgpage - window=x2-x1 - goto 1 - endif - call pgsci(color(i)) - call pgmove(tim0, yy0(i)) - call pgdraw(tim1, yy1(i)) - 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) - enddo - else - call get_cursor(ex, ey, key, 0) - endif - rl=1 - call set_win(rl,x1,x2,ymin(rl),ymax(rl)) - -8 if (key>='a') key=char(ichar(key)-32) - if (key=='-') then - window=min(window*2, 8.0*oneDay) - if (mode==zoom) then - x1=x1-(x2-x1)/2 - x2=x2+(x2-x1)/3 - y1=y1-(y2-y1)/2 - y2=y2+(y2-y1)/3 - endif - elseif (key=='X') then - window=0 - mode=0 - elseif (key=='+' .or. key==',') then - window=max(winmin,window/2) - if (mode==zoom) then - if (ex==undef) then - ex=(x1+x2)/2 - ey=(min(y2,ymax(1))+max(y1,ymin(1)))/2 - end if - fx=max(winmin,x2-x1) - fy=max(y2-y1,1e-3,y2*1e-5) - x1=ex-fx/4 - x2=ex+fx/4 - y1=ey-fy/4 - y2=ey+fy/4 - endif - elseif (key=='Z') then - call pgsci(1) - if (ex==undef) then - call pgmtxt('T', 0.5, 0.0, 0.0, 'click on two opposite corners of a selection rectangle') - call get_cursor(ex, ey, key, 0) - else - call pgmtxt('T', 0.5, 0.0, 0.0, 'click on second corner of selection rectangle') - endif - call pgsci(6) - xmin=x1 - xmax=x2 - call pgmove(xmin, ey) - call pgdraw(xmax, ey) - call pgmove(ex, ymin(rl)) - call pgdraw(ex, ymax(rl)) - if (device(1:1) .eq. 'X') then - fx=ex - fy=ey - call get_cursor(fx, fy, key, 2) - else - call get_cursor(fx, fy, key, 0) - endif - x1=max(xmin,min(ex,fx)) - x2=min(xmax,max(ex,fx)) - if (x1>=x2) then - x1=xmin - x2=xmax - endif - window=x2-x1 - y1=max(ymin(1),min(ey,fy)) - y2=min(ymax(1),max(ey,fy)) - if (y1>=y2) then - y1=ymin(1) - y2=ymax(1) - endif - mode=zoom - elseif (key >= '0' .and. key <= '9' .or. key == '.') then ! number - if (numl .lt. len(numb)) then - numl=numl+1 - numb(numl:numl)=key - call pgsci(1) - call pgsch(0.8) - call pgmtxt('T', 2.0, menuwid, 0.0, numb(1:numl)) - endif -! call get_cursor(ex, ey, key, -chartperiod) -! if (key/=char(0)) goto 8 - if (mode==zoom) mode=0 - goto 7 - elseif (key == 'D') then - ex=1 - read(numb, *, iostat=i) ex - window=min(maxRange,max(minRange, nint(oneDay*ex))) - if (mode < right) mode=right - x1=0 - elseif (key == 'H') then - ex=1 - read(numb, *, iostat=i) ex - window=min(maxRange,max(minRange, nint(3600*ex))) - if (mode < right) mode=right - x1=0 - elseif (key == 'M') then - ex=1 - read(numb, *, iostat=i) ex - window=min(maxRange,max(minRange, nint(60*ex))) - if (mode < right) mode=right - x1=0 - elseif (key == 'T' .or. numl>0 .and. (key==char(13) .or. key==char(10))) then - j=index(numb,'.') - day=0 - if (j > 1 .and. j < numl) then - read(numb(1:j-1), *, iostat=i) day - mon=0 - read(numb(j+1:numl), *, iostat=i) mon - tbase = myc_time(day+mon*100) - else - read(numb, *, iostat=i) day - tbase = myc_time(day) - endif - x1=0 - x2=oneDay - window=x2 - mode=0 - elseif (key == 'L') then - if (mode == live) then - mode=right - else - mode=live - endif - elseif (key == 'F') then - saveit=.true. - elseif (key=='Q' .or. key==char(13) .or. key==char(10)) then - goto 9 - elseif (key == 'S') then - sel=sel+1 - if (sel > tmax) sel=0 - if (mode==zoom) mode=0 - elseif (key == 'C') then - auxsel=auxsel+1 - if (auxsel > amax) auxsel=1 - elseif (mode==live) then - goto 7 - endif - numl=0 - numb=' ' - call pgpage - goto 1 -99 call tecs_write_msg(6) -9 continue - call pgclos - call purge_keys - print * - if (saveit) then - lund=41 - print '(x,a,$)', 'Filename: ' - read(*,'(a)') filnam - open(lund, file=filnam, status='unknown') ! , carriagecontrol='list') - - l=0 - i2=0 - do i1=1,nset - if (i1 > nset-naux) then - j=i1 - else - j=nset-i1+(1-naux) - 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 - i2=i1 - endif - write(lund, '(f9.4,a,f9.4)') xd(i,j)/3600., char(9), max(-999.,min(9999.,yd(i,j))) - l=l+1 - gap=.true. - endif - enddo - enddo - close(lund) - print *, l, ' lines written to ',filnam(1:48) - endif - -end subroutine - -subroutine get_cursor(x, y, key, mode) - character*1 key - real*4 x, y - integer mode - integer with_timeout/-1/ - integer l - character res*32 - - if (with_timeout<0) then - with_timeout=0 - call pgqinf('VERSION', res, l) - if (res(l:l)=='+') then - call pgqinf('TYPE', res, l) - if (res(1:1)=='X') then - with_timeout=1 - end if - end if - end if - if (with_timeout>0 .or. mode>=0) then - call pgband(mode, 0, x, y, x, y, key) - else - call sys_get_key(key, -mode) - endif -end subroutine - -subroutine purge_keys - character key*1 - key=' ' - do while (key/=char(0)) - call sys_get_key(key, 0) - end do -end subroutine - -subroutine set_win(rl, x1, x2, y1, y2) - integer rl - real x1, x2, y1, y2 - - if (rl == 1) then - call pgsvp(0.07,0.93,0.3,0.9) - else - call pgsvp(0.07,0.93,0.01,0.20) - endif - - call pgswin(x1,x2,y1,y2) -end subroutine - -integer function get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, retlen) - character pars*(*) - integer first, last, step, tbase, dmax, nmax, retlen(nmax) - real*4 xd(dmax,nmax), yd(dmax,nmax) - - integer oneDay, maxn - parameter (oneDay = 24*3600, maxn=9) - integer tecs_get_data - - integer i,j,rl(maxn),m,k,n,mm - - if (nmax > maxn) stop 'get_data: nmax>maxn' - if (last-first <= oneDay) then - get_data=tecs_get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, retLen) - else - do j=1,nmax - retlen(j)=0 - enddo - m=0 - do i=first/oneDay,last/oneDay - get_data=tecs_get_data(pars, max(first,i*oneDay), min(last,(i+1)*oneDay-step), step, tbase & - , xd(m+1, 1), yd(m+1, 1), dmax, nmax, rl) - if (get_data<0) return - mm=0 - do j=1,nmax - 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) - enddo - retlen(j)=n - mm=max(mm,n) - enddo -! print *,mm-m,' points read' - m=mm - enddo - endif -end function + character pars*(*) + integer first, last, step, tbase, dmax, nmax, retlen(nmax) + real*4 xd(dmax,nmax), yd(dmax,nmax) + + integer oneDay, maxn + parameter (oneDay = 24*3600, maxn=9) + integer tecs_get_data + + integer i,j,rl(maxn),m,k,n,mm + + if (nmax .gt. maxn) stop 'get_data: nmax>maxn' + if (last-first .le. oneDay) then + get_data=tecs_get_data(pars, first, last, step, tbase + 1 , xd, yd, dmax, nmax, retLen) + else + do j=1,nmax + retlen(j)=0 + enddo + m=0 + do i=first/oneDay,last/oneDay + get_data=tecs_get_data(pars, max(first,i*oneDay) + 1 , min(last,(i+1)*oneDay-step), step, tbase + 1 , xd(m+1, 1), yd(m+1, 1), dmax, nmax, rl) + if (get_data .lt. 0) return + mm=0 + do j=1,nmax + 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) + enddo + retlen(j)=n + mm=max(mm,n) + enddo + ! print *,mm-m,' points read' + m=mm + enddo + endif + end diff --git a/tecs/tecs_serial.c b/tecs/tecs_serial.c index 8b75ad01..891bceaa 100644 --- a/tecs/tecs_serial.c +++ b/tecs/tecs_serial.c @@ -20,6 +20,7 @@ #define EOT '\r' typedef struct { + char host[64]; int type; /* = ASYNSRV_TYPE */ struct AsynSrv__info asyn_info; /* Contains skt, host, port & chan */ struct RS__MsgStruct to_host; @@ -27,6 +28,7 @@ typedef struct { } AsynSrvChan; typedef struct { + char host[64]; int type; /* = TERMSRV_TYPE */ char res[SER_BUF_LEN]; 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", aser->asyn_info.host, aser->asyn_info.port, aser->asyn_info.chan, t2-t1); + str_copy(aser->host, hostPort); return((SerChannel *)aser); } else { NEW(tser, TermSrvChan); tser->type=TERMSRV_TYPE; @@ -103,6 +106,7 @@ SerChannel *SerOpen(const char *hostPort, int msecTmo, int (*idleHdl)(int,int)) time(&t2); ecnt=0; logfileOut(LOG_MAIN, "connected to %s (%d sec)\n", hostPort, t2-t1); + str_copy(tser->host, hostPort); return ((SerChannel *)tser); } OnError: @@ -137,7 +141,7 @@ void SerClose(SerChannel *serch) { if (serch->type==ASYNSRV_TYPE) { aser=(AsynSrvChan *)serch; - AsynSrv_Close(&aser->asyn_info, 0); + AsynSrv_Close(&aser->asyn_info, 1); } else if (serch->type==TERMSRV_TYPE) { tser=(TermSrvChan *)serch; close(tser->fd); diff --git a/tecs/tecs_serial.h b/tecs/tecs_serial.h index 661b0bf5..8fb801ba 100644 --- a/tecs/tecs_serial.h +++ b/tecs/tecs_serial.h @@ -4,6 +4,7 @@ #define SER_BUF_LEN 320 typedef struct { + char host[64]; /* private */ int type; } SerChannel;