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');
str=cr+1;
} else {
str+=l;
eql=strchr(buf,'=');
if (eql==NULL) ERR_MSG("syntax error");
*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);
ERR_I(CocGetVar(buf, &sbuf, ' '));
}
}
i=sscanf(str, "%79s%n", buf, &l);
}
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;
ERR_SI(i=recv(fd, &n, 4, 0));
if (i!=4) {
ERR_COD(ECONNRESET);
ERR_COD(ECONNREFUSED);
}
siz=ntohl(n);
if (siz > buf->dsize)

16
tecs/makefile
View File

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

5
tecs/myc_buf.c
View File

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

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 MALLOC(SIZE) malloc(SIZE)
#define FREE(PTR) free(PTR)
#define FREE(PTR) { free(PTR); PTR=NULL; }
#endif /* _MEM_UTIL_H_ */

73
tecs/tecs.c
View File

@ -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 && 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) {
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);

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

3
tecs/tecs_client.f
View File

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

400
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
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
parameter (minRange=60, maxRange=7*24*3600, oneDay=24*3600)
integer zoom, right, live
@ -23,54 +24,61 @@ subroutine tecs_plot(auxpar)
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)
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, tecs_get_mult, tecs_get_par
! 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==0) window=1800.
if (window .eq. 0) window=1800.
saveit=.false.
mode=live
call pgopen(' ')
call pgqinf('TYPE', device, l)
if (device=='NULL') then
if (device .eq. 'NULL') then
call pgclos
call pgopen('?')
call pgqinf('TYPE', device, l)
if (device=='NULL') then
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>=8 .and. device /= 'VT125') then
! 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)
@ -88,7 +96,7 @@ subroutine tecs_plot(auxpar)
x1=0
step=0
do i=1,amax
if (auxpar == apar(i)) then
if (auxpar .eq. apar(i)) then
auxsel=i
endif
enddo
@ -109,18 +117,18 @@ subroutine tecs_plot(auxpar)
pars=pars(1:pars_len)//' '//parnam(nset)
iret=tecs_get_mult(pars, t, nset, yy0)
if (iret < 0) goto 99
if (window == 0) then
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 >= right) then
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==zoom) then
if (mode .eq. zoom) then
x2=(x1+x2+window)/2
x1=x2-window
endif
@ -129,25 +137,26 @@ subroutine tecs_plot(auxpar)
last=x2+tbase
first=x1-step+tbase
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
else if (step>30) then
else if (step .gt. 30) then
step=60
elseif (step>20) then
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
! 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
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 >= right) then
if (mode .ge. right) then
x1=x2-window
else
x1 = first - tbase
@ -155,30 +164,30 @@ subroutine tecs_plot(auxpar)
tim0=t-tbase
do i=1,nset
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
enddo
if (leng == 1) leng=0
if (leng .eq. 1) leng=0
retLen(i)=leng
if (mode==live .and. leng>0) then
if (mode .eq. live .and. leng .gt. 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)
if (sel .ne. 0) then
do while (sel .lt. nset .and. retLen(sel) .eq. 0)
sel=sel+1
enddo
if (sel >= nset) sel = 0
if (sel .ge. nset) sel = 0
endif
if (saveit) goto 9
if (mode==live) then
if (mode .eq. live) then
x2=max(tim0,x2)+min(1800., window*0.5)
endif
if (window>50*3600) then
if (window .gt. 50*3600) then
ticks=8*3600
elseif (window>25*3600) then
elseif (window .gt. 25*3600) then
ticks=4*3600
else
ticks=0.0 ! automatic
@ -186,7 +195,7 @@ subroutine tecs_plot(auxpar)
i1=1
i2=nset-naux
if (sel==0) then
if (sel .eq. 0) then
sel1=i1
sel2=i2
else
@ -194,7 +203,7 @@ subroutine tecs_plot(auxpar)
sel2=sel
endif
do rl=1,2
if (mode==zoom .and. rl==1) then
if (mode .eq. zoom .and. rl .eq. 1) then
ymin(1)=y1
ymax(1)=y2
else
@ -204,13 +213,13 @@ subroutine tecs_plot(auxpar)
ylast2=ymax(rl)
do i=sel1,sel2
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))
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
if (yd(j, i) .ne. undef) then
ylast1=min(ylast1,yd(j, i))
ylast2=max(ylast2,yd(j, i))
endif
@ -221,16 +230,16 @@ subroutine tecs_plot(auxpar)
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
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) < ymin(rl)) then
if (ymax(rl) .lt. ymin(rl)) then
ymax(rl)=1.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
ymin(rl)=-1.0e-3
endif
@ -242,8 +251,8 @@ subroutine tecs_plot(auxpar)
l=0
lastj=1
do j=1,retLen(i)
if (yd(j,i)==undef) then
if (j>lastj) then
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
@ -251,27 +260,28 @@ subroutine tecs_plot(auxpar)
l=j
endif
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
enddo
call pgsci(1)
if (rl == 1) then
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) > 0) then
if (retLen(i) .gt. 0) then
name=parnam(i)
if (name=='Tm') then
if (name .eq. 'Tm') then
name='Main Sensor'
elseif (name=='Ts') then
elseif (name .eq. 'Ts') then
name='Sample Sensor'
elseif (name=='Tr') then
elseif (name .eq. 'Tr') then
name='SetPoint'
endif
call str_trim(name, name, name_len)
if (sel == i) then
if (sel .eq. i) then
name=name(1:name_len)//'*'
call str_trim(name, name, name_len)
endif
@ -289,13 +299,14 @@ subroutine tecs_plot(auxpar)
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
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) == 'He') then
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, 'Helium ['//title(1: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
@ -312,7 +323,7 @@ subroutine tecs_plot(auxpar)
call pgsci(1)
call pgsclp(0)
if (mode==live) then
if (mode .eq. live) then
text(2,1)='live off'
else
text(2,1)='live on'
@ -338,30 +349,31 @@ subroutine tecs_plot(auxpar)
ey=ymin(rl)-row*3.5
i=max(0,int((x1+oneDay/2)/oneDay))
do
ex=(i+0.5)*oneDay
if (ex > x2) EXIT
do while (ex .le. x2)
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))
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 > x1) then
if (ex .gt. x1) then
call pgmove(ex, ey)
call pgdraw(ex, ey+row)
endif
ex=ex+oneDay
if (ex < x2) then
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 < 0) then
if (-i > j) then
if (i .lt. 0) then
if (-i .gt. j) then
ex=0.0
i=nint(x1)+tbase
else
@ -374,14 +386,14 @@ subroutine tecs_plot(auxpar)
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))
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 < 0) goto 99
if (iret .lt. 0) goto 99
i=index(title, '(')
if (i > 2 ) then
if (i .gt. 2 ) then
title=title(1:i-1)
else
title='test - no device'
@ -395,31 +407,33 @@ subroutine tecs_plot(auxpar)
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)
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 == 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)
if (iret<0) goto 99
if (iret .lt. 0) goto 99
tim1=t-tbase
if (tim1 > x2) then
if (tim1 .gt. x2) then
call pgpage
window=x2-x1
goto 1
endif
if (tim1 > tim0) then
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) /= undef .and. yy1(i) /= undef) then
if ((sel==0 .or. sel==i) .and. (yy1(i) < ymin(rl) .or. yy1(i) > ymax(rl))) then
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
@ -445,22 +459,22 @@ subroutine tecs_plot(auxpar)
rl=1
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
8 if (key>='a') key=char(ichar(key)-32)
if (key=='-') then
8 if (key .ge. 'a') key=char(ichar(key)-32)
if (key .eq. '-') then
window=min(window*2, 8.0*oneDay)
if (mode==zoom) then
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=='X') then
elseif (key .eq. 'X') then
window=0
mode=0
elseif (key=='+' .or. key==',') then
elseif (key .eq. '+' .or. key .eq. ',') then
window=max(winmin,window/2)
if (mode==zoom) then
if (ex==undef) then
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
@ -471,13 +485,15 @@ subroutine tecs_plot(auxpar)
y1=ey-fy/4
y2=ey+fy/4
endif
elseif (key=='Z') then
elseif (key .eq. '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')
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, '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
call pgsci(6)
xmin=x1
@ -495,19 +511,19 @@ subroutine tecs_plot(auxpar)
endif
x1=max(xmin,min(ex,fx))
x2=min(xmax,max(ex,fx))
if (x1>=x2) then
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>=y2) then
if (y1 .ge. y2) then
y1=ymin(1)
y2=ymax(1)
endif
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
numl=numl+1
numb(numl:numl)=key
@ -515,32 +531,33 @@ subroutine tecs_plot(auxpar)
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
! call get_cursor(ex, ey, key, -chartperiod)
! if (key .ne. char(0)) goto 8
if (mode .eq. zoom) mode=0
goto 7
elseif (key == 'D') then
elseif (key .eq. 'D') then
ex=1
read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(oneDay*ex)))
if (mode < right) mode=right
if (mode .lt. right) mode=right
x1=0
elseif (key == 'H') then
elseif (key .eq. 'H') then
ex=1
read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(3600*ex)))
if (mode < right) mode=right
if (mode .lt. right) mode=right
x1=0
elseif (key == 'M') then
elseif (key .eq. 'M') then
ex=1
read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(60*ex)))
if (mode < right) mode=right
if (mode .lt. right) mode=right
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,'.')
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
mon=0
read(numb(j+1:numl), *, iostat=i) mon
@ -553,24 +570,25 @@ subroutine tecs_plot(auxpar)
x2=oneDay
window=x2
mode=0
elseif (key == 'L') then
if (mode == live) then
elseif (key .eq. 'L') then
if (mode .eq. live) then
mode=right
else
mode=live
endif
elseif (key == 'F') then
elseif (key .eq. 'F') then
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
elseif (key == 'S') then
elseif (key .eq. 'S') then
sel=sel+1
if (sel > tmax) sel=0
if (mode==zoom) mode=0
elseif (key == 'C') then
if (sel .gt. tmax) sel=0
if (mode .eq. zoom) mode=0
elseif (key .eq. 'C') then
auxsel=auxsel+1
if (auxsel > amax) auxsel=1
elseif (mode==live) then
if (auxsel .gt. amax) auxsel=1
elseif (mode .eq. live) then
goto 7
endif
numl=0
@ -586,45 +604,64 @@ subroutine tecs_plot(auxpar)
lund=41
print '(x,a,$)', 'Filename: '
read(*,'(a)') filnam
open(lund, file=filnam, status='unknown') ! , carriagecontrol='list')
open(lund, file=filnam, status='unknown')
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)
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
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.
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 *, l, ' lines written to ',filnam(1:48)
print *, n, ' lines written to ',filnam(1:48)
endif
end subroutine
end
subroutine get_cursor(x, y, key, mode)
subroutine get_cursor(x, y, key, mode)
character*1 key
real*4 x, y
integer mode
@ -632,45 +669,50 @@ subroutine get_cursor(x, y, key, mode)
integer l
character res*32
if (with_timeout<0) then
if (with_timeout .lt. 0) then
with_timeout=0
call pgqinf('VERSION', res, l)
if (res(l:l)=='+') then
if (res(l:l) .eq. '+') then
call pgqinf('TYPE', res, l)
if (res(1:1)=='X') then
if (res(1:1) .eq. 'X') then
with_timeout=1
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)
else
call sys_get_key(key, -mode)
endif
end subroutine
end
subroutine purge_keys
subroutine purge_keys
character key*1
key=' '
do while (key/=char(0))
do while (key .ne. char(0))
call sys_get_key(key, 0)
end do
end subroutine
end
subroutine set_win(rl, x1, x2, y1, y2)
subroutine set_win(rl, x1, x2, y1, y2)
integer rl
real x1, x2, y1, y2
if (rl == 1) then
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 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*(*)
integer first, last, step, tbase, dmax, nmax, retlen(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
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)
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), min(last,(i+1)*oneDay-step), step, tbase &
, xd(m+1, 1), yd(m+1, 1), dmax, nmax, rl)
if (get_data<0) return
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)
@ -704,8 +748,8 @@ integer function get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, re
retlen(j)=n
mm=max(mm,n)
enddo
! print *,mm-m,' points read'
! print *,mm-m,' points read'
m=mm
enddo
endif
end function
end

6
tecs/tecs_serial.c
View File

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

1
tecs/tecs_serial.h
View File

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