diff --git a/tecs/coc_client.c b/tecs/coc_client.c index b2963465..4533e418 100644 --- a/tecs/coc_client.c +++ b/tecs/coc_client.c @@ -92,6 +92,18 @@ int CocSendMagic(CocConn *conn, char *magic) { /*-------------------------------------------------------------------------*/ +int CocCheck(CocConn *conn) { + if (conn->fd<0) return(1); + ERR_SI(send(conn->fd, "quit", 5, 0)); + ERR_I(CocRecv(conn->fd, conn->resbuf)); + return(0); + OnError: + if (ErrCode==ECONNRESET || ErrCode==EPIPE) return(1); + return(-1); +} + +/*-------------------------------------------------------------------------*/ + int CocTryCmd(CocConn *conn) { if (conn->fd<0) { ERR_I(CocOpen(conn)); diff --git a/tecs/coc_client.h b/tecs/coc_client.h index aa4bdd73..0ad08e47 100644 --- a/tecs/coc_client.h +++ b/tecs/coc_client.h @@ -32,7 +32,12 @@ int CocCmd(CocConn *conn, const char *rwList); see COC_UTIL.H for the definiton of variables */ - +int CocCheck(CocConn *conn); +/* + returns 1, if not yet open + returns 0, if connection o.k. + retruns -1 (error message), if connection died +*/ int CocSet(CocConn *conn, const char *name, const char *value); /* set one variable diff --git a/tecs/coc_logfile.c b/tecs/coc_logfile.c index 503e6b8f..71a46cbb 100644 --- a/tecs/coc_logfile.c +++ b/tecs/coc_logfile.c @@ -44,6 +44,7 @@ void logfileOpen(int first) { if (logfileStd) { fil=stdout; str_copy(filnam, ""); + return; } assert(fil==NULL); if (first) { @@ -76,6 +77,10 @@ void logfileOpen(int first) { } #endif ErrSetOutFile(fil); + if (first) { + fprintf(fil, "%04d-%02d-%02d opened logfile\n" + , tim->tm_year+1900, tim->tm_mon+1, tim->tm_mday); + } } void logfileStatusBuffer(char *buffer, int bufsize) { @@ -182,7 +187,7 @@ void logfileWrite0(int mask) { next++; if (*next & logMask) { if (*s=='@') { /* write out time */ - lastStamp=-2; + lastStamp-=2; /* force output */ logfileStamp(s+1); } else { logfileStamp("\n"); /* write stamp before write something */ diff --git a/tecs/coc_util.c b/tecs/coc_util.c index 9311cc21..6b873ea6 100644 --- a/tecs/coc_util.c +++ b/tecs/coc_util.c @@ -171,6 +171,8 @@ void CocDefVarS(const char *name, const char *tname, void *var, int type) { p->strucType=CocDefVar(tname, NULL, COC_TYPE, &CocRD); } +char err_name[64]; + int CocGetVar(CocVar *varList, Str_Buf *buf, const char *name, int secure) { CocVar *var; void *adr; @@ -199,7 +201,7 @@ int CocGetVar(CocVar *varList, Str_Buf *buf, const char *name, int secure) { (*var->flag)++; } return(0); - OnError: return(-1); + OnError: str_copy(err_name, name); ErrTxt(err_name,0); return(-1); } int CocPutVar(CocVar *varList, Str_Buf *buf, const char *name, int secure) { @@ -231,7 +233,7 @@ int CocPutVar(CocVar *varList, Str_Buf *buf, const char *name, int secure) { if (var->flag!=NULL) (*var->flag)++; } return(0); - OnError: return(-1); + OnError: str_copy(err_name, name); ErrTxt(err_name,0); return(-1); } void CocFreeVarList(CocVar **varList) { diff --git a/tecs/sys_aunix.f b/tecs/sys_aunix.f new file mode 100644 index 00000000..0bb776af --- /dev/null +++ b/tecs/sys_aunix.f @@ -0,0 +1,245 @@ +!!------------------------------------------------------------------------------ +!! MODULE SYS +!!------------------------------------------------------------------------------ +!! 10.9.97 M. Zolliker +!! +!! System dependent subroutines for ALPHA UNIX +!!------------------------------------------------------------------------------ +!! + subroutine SYS_GETENV(NAME, VALUE) !! +!! ================================== +!! +!! Get logical name NAME +!! If the logical name is not in any table, VALUE will be blank + + implicit none +!! Arguments: + character*(*) NAME !! logical name + character*(*) VALUE !! result + + integer l + integer lnblnk + + l=lnblnk(name) + call getenv(name(1:l), value) + end + +!!----------------------------------------------------------------------------- +!! + subroutine SYS_DATE(YEAR, MONTH, DAY) !! +!! ------------------------------------- +!! +!! get actual date +!! + integer YEAR, MONTH, DAY !! 4-Digits year, month and day + + integer tarray(9) + external time + integer time + + call ltime(time(), tarray) + day=tarray(4) + month=tarray(5)+1 ! tarray(5): months since january (0-11)! + year=tarray(6)+1900 ! tarray(6): years since 1900, no y2k problem + end + +!!----------------------------------------------------------------------------- +!! + subroutine SYS_REMOTE_HOST(STR, TYPE) !! +!! +!! get remote host name/number +!! +!! type: TN telnet, RT: decnet, XW: X-window +!! + character STR*(*), TYPE*(*) !! + + character host*128 + integer i,j + integer lnblnk + + call sys_getenv('HOST', host) + call sys_getenv('DISPLAY', str) + i=index(str,':') + if (i .gt. 1) then + str=str(1:i-1) + type='XW' + else + call sys_getenv('REMOTEHOST', str) + if (str .ne. ' ') then + type='TN' + else + str=host + type='LO' + endif + endif + +! add domain to short host names + i=index(str, '.') + j=index(host, '.') + if (j .gt. 0 .and. i .eq. 0) then + i=lnblnk(str) + str(i+1:)=host(j:) + endif + end + +!!----------------------------------------------------------------------------- +!! + subroutine SYS_GET_LUN(LUN) !! +!! +!! allocate logical unit number + + integer LUN !! out + + logical*1 act(50:100)/51*.false./ + save act + + integer l + + l=50 + do while (l .lt. 99 .and. act(l)) + l=l+1 + enddo + if (l .eq. 100) stop 'SYS_GET_LUN: no more luns available' + lun=l + act(l)=.true. + return +!! + entry SYS_FREE_LUN(LUN) !! +!! +!! deallocate logical unit number + + if (act(lun)) then + act(lun)=.false. + else + stop 'SYS_FREE_LUN: lun already free' + endif + end + +!!----------------------------------------------------------------------------- +!! + subroutine SYS_RENAME_FILE(OLD, NEW) !! +!! ==================================== +!! + character OLD*(*), NEW*(*) !! (in) old, new filename + + call rename(OLD, NEW) + end + +!!----------------------------------------------------------------------------- +!! + subroutine SYS_DELETE_FILE(NAME) !! +!! ================================ +!! + character NAME*(*) !! (in) filename + + call unlink(NAME) + end + +!!----------------------------------------------------------------------------- +!! + subroutine SYS_HOME(HOME) !! +!! ========================= +!! +!! get home directory (+ dot) + + character HOME*(*) !! (out) filename + + integer l + integer lnblnk + + call sys_getenv('HOME',home) + l=lnblnk(home) + if (l .lt. len(home)-1) then + if (home(l:l) .ne. '/') then + home(l+1:l+1)='/' + l=l+1 + endif + home(l+1:l+1)='.' + l=l+1 + endif + end + +!!------------------------------------------------------------------------------ +!! + subroutine SYS_CHECK_SYSTEM(CODE) !! +!! ================================= +!! + character CODE*(*) !! + + code='ALPHA_UNIX' !! + end + +!!----------------------------------------------------------------------------- +!! + subroutine SYS_GET_CMDPAR(STR, L) !! +!! --------------------------------- +!! + character*(*) STR !! + integer L !! + + integer i + integer lnblnk + + l=0 + str=' ' + do i=1,iargc() + if (l .lt. len(str)) then + call getarg(i, str(l+1:)) + l=lnblnk(str) + l=l+1 + endif + enddo + if (l .gt. 0) then + if (str(1:l) .eq. ' ') l=0 + endif + end + +!!----------------------------------------------------------------------------- +!! + subroutine SYS_GET_KEY(KEY, TMO) !! +!! +!! read for keyboard with timeout, without echo +!! + character KEY*1 !! + integer TMO !! timeout in seconds (<100) + + parameter esc=char(27), csi=char(155), ss3=char(143) + + call sys_get_raw_key(key, tmo) +1 if (key .eq. esc) then + call sys_get_raw_key(key, tmo) + if (key .eq. 'O') then + key=ss3 + goto 1 + elseif (key .eq. '[') then + key=csi + goto 1 + endif + elseif (key .eq. csi) then + call sys_get_raw_key(key, tmo) + do while (key .ge. '0' .and. key .le. '9') + call sys_get_raw_key(key, tmo) + enddo + key=' ' + elseif (key .eq. ss3) then + call sys_get_raw_key(key, tmo) + if (key .eq. 'm') then + key='-' + elseif (key .eq. 'l') then + key='+' + elseif (key .eq. 'n') then + key='.' + elseif (key .eq. 'M') then + key=char(13) + elseif (key .eq. 'S') then + key='*' + elseif (key .eq. 'R') then + key='/' + elseif (key .eq. 'Q') then + key='=' + else + key=' ' + endif + endif + end + diff --git a/tecs/sys_aunix_c.c b/tecs/sys_aunix_c.c new file mode 100644 index 00000000..29df694b --- /dev/null +++ b/tecs/sys_aunix_c.c @@ -0,0 +1,127 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +static char *last_line = NULL; + +char *readline (char *prompt); + +void sys_rd_line_(char *cmd, int *retlen, char *prompt, int clen, int plen) +{ + char *line_read, *p; + int l; + + l = lnblnk_(prompt, clen); + p = malloc((unsigned) l+2); if( p == NULL ) return; + strncpy(p+1,prompt,l); p[0]='\n'; p[l] = '\0'; + if (last_line == NULL) { last_line =malloc(1); last_line[0] = '\0';}; + + line_read = readline(p); + free(p); + + if (line_read) + { + if (*line_read && strcmp(last_line, line_read)!=0) + add_history (line_read); + free (last_line); + strncpy(cmd, line_read, clen); + *retlen=strlen(line_read); + last_line = line_read; + if (*retlen>clen) *retlen=clen; + } else { + *retlen=-1; + } +} + + +void intcatch(int sig) +{ printf("\nuse quit (normally ctrl-\) to interrupt\n"); +} + +int called=0; /* env is valid only if called==1 */ +jmp_buf env; + +void (*inthdl)(int sig); +void (*errhdl)(); + +void sighdl(int sig) +{ if (called) longjmp(env,sig); +} + +void sys_err_hdl_(void errhdl0()) +{ errhdl=errhdl0; }; + +void sys_int_hdl_(void inthdl0(int sig)) +{ inthdl=inthdl0; }; + +void sys_try_(void proc()) +{ int sig, status; + void (*sgh[32]) (int); + + assert(!called); /* nested calls not allowed */ + called=1; + sgh[SIGFPE] =signal(SIGFPE, sighdl); + sgh[SIGINT] =signal(SIGINT, *inthdl); + status=setjmp(env); + if (status==0) /* first return of setjmp */ + { proc(); } + else + { (*errhdl)(); }; + signal(SIGFPE, sgh[SIGFPE]); + signal(SIGINT, intcatch); + called=0; +} + +void sys_abort_() +{ if (called) longjmp(env,-2); +} + + +void sys_exit_hdl_(void hdl()) +{ int res; + res=atexit(hdl); +} + +struct termios atts; + +void sys_get_raw_key_(char *key, int *tmo, int k_len) +{ + struct termios attr; + int ires, ntmo, chr; + + ires=tcgetattr(STDIN_FILENO,&attr); + atts=attr; /* save term. attr. */ + if (ires!=0) {perror("***\n");} + attr.c_lflag &= ~(ICANON) & ~(ECHO); /* canonical mode off, echo off */ + attr.c_cc[VMIN]=0; + ires= tcsetattr(STDIN_FILENO,TCSANOW,&attr); + if (ires!=0) {perror("***\n");} + +/* + ires=fflush(stdin); + ires=fflush(stderr); +*/ + + ntmo=*tmo*100; + chr=fgetc(stdin); + if (chr==EOF) { + while ((chr==EOF) & (ntmo>0)) { + usleep(10000); /* wait 10 ms */ + chr=fgetc(stdin); + ntmo--; + } + } + if (chr==EOF) chr=0; + + *key=chr; + + ires=tcsetattr(STDIN_FILENO,TCSANOW,&atts); /* restore term. attributes */ + if (ires!=0) {perror("***\n");}; +} diff --git a/tecs/tecs.bld b/tecs/tecs.bld new file mode 100644 index 00000000..45d47b24 --- /dev/null +++ b/tecs/tecs.bld @@ -0,0 +1,5 @@ +f90 -c -g strings.f90 +f90 -c -g tecs_plot.f90 +f77 -o tecs -g tecs_client.f tecs_for.f sys_aunix_c.c \ + tecs_plot.o sys_aunix.f strings.o -L. -ltecsl -L/data/lnslib/lib -lpgplot \ + -so_archive -lreadline -ltermcap -lX11 -lXm diff --git a/tecs/tecs.c b/tecs/tecs.c index 94383b9a..f5d965f1 100644 --- a/tecs/tecs.c +++ b/tecs/tecs.c @@ -25,24 +25,36 @@ static char *binDir=NULL; static char *logDir=NULL; typedef struct { - float temp, t1, t2; /* calc, high, low temperature */ - float tMin, tMax, min1, max1, min2, max2; /* minimum and maximum temperatures since ... */ + float t, min, max; /* temperatures */ + int sMin, sMax; /* reading status summary */ + int present; /* sensor is present */ + int readStat; /* reading status */ + char ch[2]; /* channels */ +} SensorT; + +SensorT + sens1, sens2, sens3, sens4, + *sensors[5]={NULL, &sens1, &sens2, &sens3, &sens4 }, + *sensor=&sens1; + +typedef struct { + SensorT *sensor1, *sensor2; + float temp; /* weighted temperature */ + float tMin, tMax; /* minimum and maximum temperatures since ... */ int dirty; /* input config to be reloaded */ int try; /* trial count */ int manual; /* manual device */ int code, code1; /* device code, buffer for device code */ - int nSens; /* number of sensors */ int codChanged; /* code has changed */ int codDefined; /* code is not yet confirmed */ float scale; /* scale for extreme ranges */ - char ch1[2], ch2[2]; /* channels for high/low T */ char device[16]; /* device name */ char tname[16]; } Testpoint; Testpoint /* C standard guarantees initialization to zero */ - cryo, /* data for main sensors (on heat exchanger, or the only sensors) */ - samp, /* data for extra sensors of sample stick */ + cryo={&sens1, &sens2 }, /* data for main sensors (on heat exchanger, or the only sensors) */ + samp={&sens3, &sens4 }, /* data for extra sensors of sample stick */ *tpoints[2]={&cryo, &samp}, *tpoint=&cryo; @@ -68,6 +80,7 @@ static int noResp=2, /* no response */ quit, /* quit server */ controlMode=2, /* 0: control on heater, 1: control on sample, 3: 2nd loop for difference heater-sample */ + int2=30, /* inegration time for controlMode 2 */ remoteMode, /* 1: local, 2: remote */ maxfld, /* last used display field */ busy, /* busy after CRVSAV */ @@ -379,13 +392,15 @@ int configInput(void) { t++; n=1; if (tpoint==&samp) { - samp.nSens=0; + sens3.present=0; + sens4.present=0; i=sscanf(t, "%12s%d%d", nam, &nn, &n); if (i<1) ERR_MSG("missing sensor name"); ext=".s"; dispFld=2; } else { - cryo.nSens=0; + sens1.present=0; + sens2.present=0; tLow=0; tHigh=0; controlMode=0; i=sscanf(t, "%12s%d%d%d%f%d%f%f%f", nam, &n, &nn, &controlMode, &tLimit, &resist, &power, &tLow, &tHigh); @@ -402,12 +417,13 @@ int configInput(void) { } str_append(nam, ext); - ERR_I(retstat=instCurve(nam, tpoint->ch1, dispFld)); + ERR_I(retstat=instCurve(nam, tpoint->sensor1->ch, dispFld)); + tpoint->sensor1->present=1; if (n==2) { str_append(nam, "l"); - ERR_I(retstat=instCurve(nam, tpoint->ch2, dispFld+2)); + ERR_I(retstat=instCurve(nam, tpoint->sensor2->ch, dispFld+2)); + tpoint->sensor2->present=1; } - tpoint->nSens=n; return(0); OnError: return(retstat); } @@ -452,73 +468,84 @@ int loadCache(void) { return(-1); } -float WeightedAverage(int n, float tH, float tL) { +float WeightedAverage(int presentH, int presentL, float tH, float tL) { float p,q; - if (n==0) { - return(0.0); - } else if (n<2) { - return(tH); - } else { - if (tL0) { - str_append(buf, "MDAT?[cryo.ch1]>cryo.min1,cryo.max1;"); - if (cryo.nSens>1) { - str_append(buf, "MDAT?[cryo.ch2]>cryo.min2,cryo.max2;"); - } else { - cryo.t2=0; + l=0; + ls=0; + for (i=1; i<=4; i++) { + sensor=sensors[i]; + sensor->sMin=0; + sensor->sMax=0; + if (sensor->present) { + assert(l<128); + sprintf(buf+l, "MDAT?[sens%d.ch]>sens%d.min,sens%d.max;", i, i, i); + l=strlen(buf); + assert(ls<128); + sprintf(bufs+ls, "MDATST?[sens%d.ch]>sens%d.sMin,sens%d.sMax;", i, i, i); + ls=strlen(bufs); } - } else { - cryo.t1=0; - cryo.t2=0; } - - if (samp.nSens>0) { - str_append(buf, "MDAT?[samp.ch1]>samp.min1,samp.max1;"); - if (samp.nSens>1) { - str_append(buf, "MDAT?[samp.ch2]>samp.min2,samp.max2;"); - } else { - samp.t2=0; - } - } else { - samp.t1=0; - samp.t2=0; - } - - i=strlen(buf); - if (i>0) { + if (ls>0) { + bufs[ls-1]='\0'; /* strip off ';' */ + ERR_P(LscCmd(ser, bufs)); str_append(buf, "MNMXRST"); ERR_P(LscCmd(ser, buf)); } + /* check for reading errors */ + for (i=1; i<=4; i++) { + sensor=sensors[i]; + stat=sensor->sMin | sensor->sMax; + if (stat != sensor->readStat) { + sensor->readStat=stat; + if (stat & 1) logfileOut(LOG_MAIN, "invalid reading %s\n", sensor->ch); + if (stat & 2) logfileOut(LOG_MAIN, "old reading %s\n", sensor->ch); + if (stat & 12) logfileOut(LOG_MAIN, "unknown reading status %s\n", sensor->ch); + if (stat & 16) logfileOut(LOG_MAIN, "temp underrange %s\n", sensor->ch); + if (stat & 32) logfileOut(LOG_MAIN, "temp overrange %s\n", sensor->ch); + if (stat & 64) logfileOut(LOG_MAIN, "units zero %s\n", sensor->ch); + if (stat &128) logfileOut(LOG_MAIN, "units overrange %s\n", sensor->ch); + if (stat==0) logfileOut(LOG_MAIN, "reading o.k. %s\n", sensor->ch); + } + } + logIt=0; for (i=0; i<2; i++) { tpoint=tpoints[i]; - if (tpoint->nSens>0) { - tpoint->tMin = WeightedAverage(tpoint->nSens, tpoint->min1, tpoint->min2) * tpoint->scale; - tpoint->tMax = WeightedAverage(tpoint->nSens, tpoint->max1, tpoint->max2) * tpoint->scale; - } + s1=tpoint->sensor1; + s2=tpoint->sensor2; + tpoint->tMin = WeightedAverage(s1->present, s2->present, s1->min, s2->min) * tpoint->scale; + tpoint->tMax = WeightedAverage(s1->present, s2->present, s1->max, s2->max) * tpoint->scale; } sprintf(buf, "@%.3f < T < %.3f K", cryo.tMin, cryo.tMax); - if (samp.nSens>0) { + if (samp.tMax>0.0) { sprintf(buf1, "(reg), %.3f < T < %.3f K (samp)", samp.tMin, samp.tMax); str_append(buf, buf1); } @@ -542,13 +569,13 @@ int SetTemp(int switchOn) { logfileOut(LOG_MAIN, "set %.3f\n", tempC); } scale=cryo.scale; - ch=cryo.ch1; - if (cryo.nSens>1 && tempC<(tLow+tHigh)/2) ch=cryo.ch2; - if (samp.nSens>0) { + ch=sens1.ch; + if (sens2.present && tempC<(tLow+tHigh)/2) ch=sens2.ch; + if (sens3.present) { if (controlMode==1) { /* control directly on sample sensor */ tShift=0; - ch=samp.ch1; - if (cryo.nSens>1 && tempC<(tLow+tHigh)/2) ch=samp.ch2; + ch=sens3.ch; + if (sens2.present && tempC<(tLow+tHigh)/2) ch=sens4.ch; scale=samp.scale; } else if (controlMode!=2) { tShift=0; @@ -581,42 +608,29 @@ int SetTemp(int switchOn) { int ReadTemp(void) { char buf[256]; - int i; + int i, l; + SensorT *sensor; readTemp=0; - buf[0]='\0'; - if (cryo.nSens>0) { - str_append(buf, "KRDG?[cryo.ch1]>cryo.t1;"); - if (cryo.nSens>1) { - str_append(buf, "KRDG?[cryo.ch2]>cryo.t2;"); + l=0; + for (i=1; i<=4; i++) { + sensor=sensors[i]; + if (sensor->present) { + assert(l<128); + sprintf(buf+l, "KRDG?[sens%d.ch]>sens%d.t;", i, i); + l=strlen(buf); } else { - cryo.t2=0; + sensor->t=0.0; } - } else { - cryo.t1=0; - cryo.t2=0; } - - if (samp.nSens>0) { - str_append(buf, "KRDG?[samp.ch1]>samp.t1;"); - if (samp.nSens>1) { - str_append(buf, "KRDG?[samp.ch2]>samp.t2;"); - } else { - samp.t2=0; - } - } else { - samp.t1=0; - samp.t2=0; - } - - i=strlen(buf); - if (i>0) { - buf[i-1]='\0'; /* strip off ';' */ + if (l>0) { + buf[l-1]='\0'; /* strip off ';' */ ERR_P(LscCmd(ser, buf)); } - cryo.temp=WeightedAverage(cryo.nSens, cryo.t1, cryo.t2)*cryo.scale; - samp.temp=WeightedAverage(samp.nSens, samp.t1, samp.t2)*samp.scale; + + cryo.temp=WeightedAverage(sens1.present, sens2.present, sens1.t, sens2.t)*cryo.scale; + samp.temp=WeightedAverage(sens3.present, sens4.present, sens3.t, sens4.t)*samp.scale; if (samp.temp==0.0) samp.temp=cryo.temp; if (!deviceFlag && !samp.dirty && samp.codDefined && !samp.codChanged @@ -635,7 +649,7 @@ int PeriodicTask(void) { char *next; int i, k; time_t putTim; - float t3[3], p, d, w; + float t3[3], p, d, w, t; ERR_P(LscCmd(ser, "DIOST?>cod1,out1;DOUT 3,29;HTR?>htr;HTRST?>htrst;BUSY?>busy")); if (cryo.codDefined && samp.codDefined) { @@ -644,6 +658,7 @@ int PeriodicTask(void) { } if (htrst!=htrst0) { + ERR_I(LogMinMax(0)); if (htrst<0 || htrst>6) { sprintf(buf, "heater status %d\n", htrst); logfileOut(LOG_MAIN, buf); @@ -715,18 +730,18 @@ int PeriodicTask(void) { if (tim>=logTime) { i=0; - if (cryo.nSens>0) { + if (sens1.present) { t3[0]=cryo.temp; i=1; } else { t3[0]=undef; } - if (samp.nSens>0) { + if (sens3.present) { t3[1]=samp.temp; i=2; } else { - if (cryo.nSens>1) { - t3[1]=cryo.t2; + if (sens2.present) { + t3[1]=sens2.t; i=2; } else { t3[1]=undef; @@ -743,11 +758,14 @@ int PeriodicTask(void) { logTime=(putTim/logPeriod+1)*logPeriod; if (tim>mmTime) ERR_I(LogMinMax(0)); } - if (samp.nSens>0 && cryo.nSens>0 && controlMode==2 && tempC!=0) { - d=(tempH-cryo.temp)/cryo.temp-1.0; /* relative difference */ + if (sens1.present && sens3.present && controlMode==2 && tempC!=0) { + t=sens1.t; + if (sens2.present && tempC<(tLow+tHigh)/2) t=sens2.t; + d=(tempH-t)/t-1.0; /* relative difference */ w=exp(-d*d*230); /* gaussian */ if (w<0.1) tInt=0; /* reset when far from setpoint (more than 10 %) */ - if (tInt<30000/per) tInt+=w; /* increase integral time until 30 sec. */ + if (int2<1) int2=1; + if (tIntw) { p=w/tInt; } else { @@ -847,7 +865,8 @@ int inputSettings(Testpoint *this) { } } if (tpoint->dirty>0) tpoint->try=0; - tpoint->nSens=0; + tpoint->sensor1->present=0; + tpoint->sensor2->present=0; if (!tpoint->manual) { tpoint->device[0]='\0'; concatDevice(); } tpoint->dirty=configInput(); if (tpoint->dirty<0) { @@ -896,52 +915,50 @@ int SetPower(void) { } int Display(void) { - char flds[5], fmt[5], disp[32], buf[256]; - int i,j,k; + char flds[6], fmt[6], buf[256]; + int i,k,l; + SensorT *s; maxfld=0; - for (i=1; i<=4; i++) { flds[i]=' '; fmt[i]=' '; } - for (j=0; j<2; j++) { /* fill in kelvin display fields */ - tpoint=tpoints[j]; - if (tpoint->nSens>0) { - k=1+j; - flds[k]=tpoint->ch1[0]; fmt[k]='1'; if (k>maxfld) maxfld=k; - if (tpoint->nSens>1) { - k=3+j; - flds[k]=tpoint->ch2[0]; fmt[k]='1'; if (k>maxfld) maxfld=k; + k=1; + flds[0]='*'; + flds[5]='\0'; + for (i=1; i<=4; i++) { /* fill in kelvin fields */ + s=sensors[i]; + if (s->present) { + flds[k]=s->ch[0]; + fmt[k]='1'; + if (k>maxfld) maxfld=k; + } else { + flds[k]='\0'; + } + k=k+2; if (k>4) k=2; + } + + for (i=1; i<=4; i++) { /* fill in raw fields */ + s=sensors[i]; + if (s->present) { + k=strlen(flds); /* find next free field */ + if (k<=4) { + if (k>maxfld) maxfld=k; + flds[k]=s->ch[0]; + fmt[k]='3'; } } } - for (j=0; j<2; j++) { /* fill raw display fields */ - tpoint=tpoints[j]; - if (tpoint->nSens>0) { - k=2-j; /* try first right (or left) of the kelvin field */ - if (flds[k]!=' ') k=3+j; /* then the field below */ - if (flds[k]!=' ') k=4-j; /* then below right */ - if (flds[k]==' ') { - if (k>maxfld) maxfld=k; - flds[k]=tpoint->ch1[0]; fmt[k]='3'; - } - if (tpoint->nSens>1) { - k=4-j; /* try right (or left) of the kelvin field */ - if (flds[k]==' ') { - if (k>maxfld) maxfld=k; - flds[k]=tpoint->ch2[0]; fmt[k]='3'; - } - } - } - } + /* fields 5-8 standard raw data */ ERR_P(LscCmd(ser, "DISPFLD 5,A,3;DISPFLD 6,C,3;DISPFLD 7,B,3;DISPFLD 8,D,3")); if (maxfld==0) { /* show raw data */ ERR_P(LscCmd(ser, "DISPFLD 1,A,3;DISPFLD 2,C,3;DISPFLD 3,B,3;DISPFLD 4,D,3;DISPLAY:4")); } else { - buf[0]='\0'; - for (i=1; i<=maxfld; i++) { - if (flds[i]!=' ') { - sprintf(disp, "DISPFLD %d,%c,%c;", i, flds[i], fmt[i]); + l=0; + for (k=1; k<=maxfld; k++) { + if (flds[k]!='\0') { + assert(l<128); + sprintf(buf+l, "DISPFLD %d,%c,%c;", k, flds[k], fmt[k]); + l=strlen(buf); } - str_append(buf, disp); } str_append(buf, "DISPLAY:[maxfld]"); ERR_P(LscCmd(ser, buf)); @@ -952,6 +969,7 @@ int Display(void) { int Settings(void) { char nbuf[256], buf[256], *cfg, *p; + char alarms[3]; cfg=NULL; if (cryo.dirty && cryo.codDefined || samp.dirty && samp.codDefined) { @@ -959,17 +977,30 @@ int Settings(void) { ERR_I(inputSettings(&cryo)); ERR_I(inputSettings(&samp)); - if (cryo.nSens>0) { + ERR_P(LscCmd(ser, "ALARM A:0;ALARM B:0;ALARM C:0;ALARM D:0")); + + alarms[0]='\0'; + alarms[1]='\0'; + alarms[2]='\0'; + if (sens1.present) { ERR_I(SetPower()); - ERR_P(LscCmd(ser, "ALARM [cryo.ch1]:1,1,[tLimit],0,0,1;ALARM [cryo.ch2]:0;RELAY 1:1;BEEP:0")); - if (samp.nSens>0) { - ERR_P(LscCmd(ser, "ALARM [samp.ch1]:1,1,[tLimit],0,0,1;ALARM [samp.ch2]:0")); - } else { - ERR_P(LscCmd(ser, "ALARM [samp.ch1]:0;ALARM [samp.ch2]:0")); + str_copy(buf, "ALARM [sens1.ch]:1,1,[tLimit],0,0,1;RELAY 1:1;BEEP:0"); + alarms[0]=sens1.ch[0]; + if (sens3.present) { + str_append(buf, ";ALARM [sens3.ch]:1,1,[tLimit],0,0,1"); + alarms[1]=sens3.ch[0]; } - } else { - ERR_P(LscCmd(ser, "ALARM [cryo.ch1]:0;ALARM [cryo.ch2]:0;ALARM [samp.ch1]:0;ALARM [samp.ch2]:0")); + ERR_P(LscCmd(ser, buf)); } + + /* switch of unused channels */ + buf[0]='\0'; + if (NULL==strchr(alarms, 'A')) str_append(buf, ";ALARM A:0"); + if (NULL==strchr(alarms, 'B')) str_append(buf, ";ALARM B:0"); + if (NULL==strchr(alarms, 'C')) str_append(buf, ";ALARM C:0"); + if (NULL==strchr(alarms, 'D')) str_append(buf, ";ALARM D:0"); + if (buf[0]!='\0') ERR_P(LscCmd(ser, buf+1)); /* send without leading semicolon */ + ERR_I(Display()); str_copy(nbuf, binDir); @@ -1012,7 +1043,7 @@ int ExecuteRequest(void) { } if (setFlag) { setFlag=0; - if (cryo.nSens>0) { + if (sens1.present) { tInt=0; /* reset integral time */ ERR_I(SetTemp(1)); } @@ -1123,11 +1154,11 @@ int main(int argc, char *argv[]) int port, msecTmo; str_copy(cryo.tname,"main"); - str_copy(cryo.ch1,"A"); - str_copy(cryo.ch2,"B"); + str_copy(sens1.ch,"A"); + str_copy(sens2.ch,"B"); str_copy(samp.tname,"sample stick"); - str_copy(samp.ch1,"C"); - str_copy(samp.ch2,"D"); + str_copy(sens3.ch,"C"); + str_copy(sens4.ch,"D"); cryo.codChanged=1; cryo.scale=1.0; samp.codChanged=1; @@ -1203,18 +1234,23 @@ int main(int argc, char *argv[]) CocDefPtr(tpoint, Testpoint); CocFltFld(Testpoint, temp, CocRD); - CocFltFld(Testpoint, t1, CocRD); - CocFltFld(Testpoint, t2, CocRD); CocFltFld(Testpoint, scale, CocRD); - CocFltFld(Testpoint, min1, CocRD); - CocFltFld(Testpoint, min2, CocRD); - CocFltFld(Testpoint, max1, CocRD); - CocFltFld(Testpoint, max2, CocRD); CocFltFld(Testpoint, tMin, CocRD); CocFltFld(Testpoint, tMax, CocRD); - CocStrFld(Testpoint, ch1, CocRD); - CocStrFld(Testpoint, ch2, CocRD); + CocDefStruct(sens1, SensorT); + CocDefStruct(sens2, SensorT); + CocDefStruct(sens3, SensorT); + CocDefStruct(sens4, SensorT); + CocDefPtr(sensor, SensorT); + + CocFltFld(SensorT, t, CocRD); + CocFltFld(SensorT, min, CocRD); + CocFltFld(SensorT, max, CocRD); + CocIntFld(SensorT, readStat, CocRD); + CocIntFld(SensorT, sMin, CocRD); + CocIntFld(SensorT, sMax, CocRD); + CocStrFld(SensorT, ch, CocRD); CocDefFlt(htr, CocRD); CocDefFlt(power, powerFlag); @@ -1256,6 +1292,7 @@ int main(int argc, char *argv[]) CocDefInt(logPeriod, CocWR); CocDefInt(readTemp, CocWR); CocDefInt(controlMode, CocWR); + CocDefInt(int2, CocWR); CocDefInt(busy, CocRD); CocDefInt(serialNo, CocRD); CocDefInt(configuring, CocRD); @@ -1263,6 +1300,12 @@ int main(int argc, char *argv[]) CocAlias(tempX,cryo.temp); CocAlias(tempP,samp.temp); + CocAlias(tX,cryo.temp); + CocAlias(tS,samp.temp); + CocAlias(t1,sens1.t); + CocAlias(t2,sens2.t); + CocAlias(t3,sens3.t); + CocAlias(t4,sens4.t); CocAlias(set,tempC); CocAlias(int,integ); diff --git a/tecs/tecs_cli.c b/tecs/tecs_cli.c index fa816863..7ee61e7a 100644 --- a/tecs/tecs_cli.c +++ b/tecs/tecs_cli.c @@ -6,7 +6,7 @@ #include "tecs_cli.h" static char device[80], command[80]; -static int quit, readTemp, configuring; +static int readTemp, configuring; static float tempX, tempP, tempC; pTecsClient TeccInit(char *startcmd, int port) { @@ -19,7 +19,6 @@ pTecsClient TeccInit(char *startcmd, int port) { CocDefFlt(tempX, CocRD); CocDefStr(device, CocWR); CocDefInt(configuring, CocRD); - CocDefInt(quit, CocWR); CocDefInt(readTemp, CocWR); CocDefCmd(command); @@ -94,10 +93,22 @@ int TeccSend(pTecsClient conn, char *cmd, char *reply, int replyLen) { } int TeccQuitServer(pTecsClient conn) { - quit=1; - ERR_I(CocCmd(conn, "[quit]")); - return(0); - OnError: return(-1); + int iret, cnt; + + ERR_I(iret=CocCheck(conn)); + if (iret==0) { + ERR_I(CocSet(conn, "quit", "1")); + cnt=50; + while (iret==0 && cnt>0) { + CocDelay(100); + ERR_I(iret=CocCheck(conn)); + cnt--; + } + } + if (iret==1) return(0); + ERR_MSG("Does not quit within 5 seconds"); + OnError: + return(-1); } void TeccClose(pTecsClient conn) { diff --git a/tecs/tecs_client.f b/tecs/tecs_client.f new file mode 100644 index 00000000..946daab4 --- /dev/null +++ b/tecs/tecs_client.f @@ -0,0 +1,202 @@ + program tecs_client + + real*4 temp(4) + character device*32, init*80, line*80, cmd*16, par*80, response*80 + integer i,j,k,iret,l + character file*128, cmdpar*128 + logical oneCommand + +! functions + integer tecs_get_par, tecs_quit_server, tecs_send, tecs_set_par + + call sys_getenv('TECS_INIT', init) + + call sys_get_cmdpar(line, l) + if (l .ne. 0) then + if (line .eq. 'off' .or. line .eq. 'OFF') init=' ' + oneCommand=.true. + else + oneCommand=.false. + endif + + if (init .eq. ' ') then + call tecs_open(0, ' ', iret) + else + call tecs_open(1, init, iret) + endif + + if (iret .lt. 0) goto 91 + if (oneCommand) goto 11 + + print * + print *,'Tecs Client' + print *,'-----------' + print * + print *,' show temperature and device' + print *,'set set temperature' + print *,'send direct command to LSC340' + print *,'device set cryo device' + print *,' show parameter' + print *,' set parameter' + print *,'plot temperature and power chart' + print *,'kill close TecsServer and exit' + print *,'exit,quit exit, but do not close TecsServer' + print *,'help show list of parameters and cryo devices' + print * + + l=0 +1 if (oneCommand) goto 99 + call sys_rd_line(line, l, 'tecs> ') + if (l .lt. 0) goto 99 +11 l=l+1 + line(l:l)=' ' + cmd=' ' + k=0 + do j=1,l + if (line(j:j) .gt. ' ') then + k=k+1 + cmd(k:k)=line(j:j) + if (cmd(k:k) .ge. 'A' .and. cmd(k:k) .le. 'Z') then ! set to lowercase + cmd(k:k)=char(ichar(cmd(k:k))+32) + endif + elseif (k .gt. 0) then ! end of command + goto 2 + endif + enddo + + if (k .eq. 0) then ! empty line + call tecs_get_t(6, temp, iret) + if (iret .ne. 0) goto 1 + iret=tecs_get_par('device', device) + if (iret .lt. 0) goto 19 + print '(x,3(a,f8.3),2a)','tempX=', temp(3),', tempP=',temp(2) + 1 ,', set=',temp(1), ', device=',device + goto 1 + endif + + print *,'command too long' + goto 1 + +2 par=' ' + do i=j,l + if (line(i:i) .gt. ' ') then + par=line(i:l) + goto 3 + endif + enddo + + ! simple query + + if (cmd .eq. 'kill' .or. cmd .eq. 'off') then + iret=tecs_quit_server() + elseif (cmd .eq. 'exit' .or. cmd .eq. 'quit') then + goto 99 + elseif (cmd .eq. 'on') then + l=0 + goto 11 + elseif (cmd .eq. 'plot') then + iret=tecs_get_par('dlogfile', file) + if (iret .lt. 0) goto 19 + call tecs_plot(file) + elseif (cmd .eq. 'help') then + print * + print *,'Writeable parameters:' + print * + print *,'set temperature set-point' + print *,'device temperature device' + print *,'controlMode control on: 0: heat exchanger, ' + 1 ,'1: sample, 2: second loop' + print *,'power heater max. power' + print *,'prop PID gain' + print *,'int PID integration time: 1000/int sec' + print *,'deriv PID derivation term' + print *,'maxShift maximum (set-tempH) for controlMode=2' + print *,'int2 integration time (sec) for controlMode=2' + print * + print *,'Read only parameters:' + print * + print *,'tX heat exchanger temperature' + print *,'tP sample temperature' + print *,'tempH set-point on regulation' + print *,'tLimit temperature limit' + print *,'htr heater current percentage' + print *,'resist heater resistance' + print *,'logfile name of the logfile' + print *,'remoteMode 1: local, 2: remote ' + 1 ,'(switch on with device command)' + print * + print *,'t1 regulation temperature (hi-T sensor)' + print *,'t2 regulation temperature (low-T sensor)' + print *,'t3 sample temperature (hi-T sensor)' + print *,'t4 sample temperature (low-T sensor)' + print * + print *,'Temperature devices:' + print * + print *,'ill1, ill2, ill3 (cryofurnace), ill4 (focus-cryo), ' + 1 ,'ill5 (maxi)' + print *,'cti1, cti2, cti3, cti4, cti5 (maxi), cti6 (focus), apd' + print *,'ccr4k (4K closed cycle), hef4c (TriCS 4circle cryo)' + print *,'sup4t (supra.magnet 4T)' + print *,'rdrn (LTF dilution, 20kOhm), rdrn2 (2kOhm)' + print * + elseif (cmd .eq. 'log') then + iret=tecs_get_par('logfile', file) + if (iret .lt. 0) goto 19 + call show_log(50, file) + else + iret=tecs_get_par(cmd, response) + if (iret .lt. 0) goto 19 + print '(7x,3a)',cmd(1:k),'=',response + endif + goto 1 + +3 if (cmd .eq. 'send') then + iret=tecs_send(par, response) + if (iret .lt. 0) goto 19 + print '(7x,2a)','response: ',response + elseif (cmd .eq. 'log') then + i=50 + read(par, *, err=31) i +31 iret=tecs_get_par('logfile', file) + if (iret .lt. 0) goto 19 + call show_log(i, file) + else + iret=tecs_set_par(cmd, par) + if (iret .lt. 0) goto 19 + print '(7x,3a)',cmd(1:k),':=',par + endif + goto 1 + +19 call tecs_write_error(6) + goto 1 + +91 if (iret .lt. 0) then + call tecs_write_error(6) + endif +99 end + + + subroutine show_log(lines, file) + + integer lines + + integer i,l + character str*132, file*(*) + + print * + print * + open(1, name=file, status='old', readonly, shared, err=39) + i=0 +31 read(1,'(a)',end=32) + i=i+1 + goto 31 +32 rewind(1) + do i=1,i-lines + read(1,*,end=39) + enddo +33 read(1,'(q,a)',end=39) l,str + print *,str(1:min(len(str),max(1,l))) + goto 33 +39 continue + close(1) + end diff --git a/tecs/tecs_for.f b/tecs/tecs_for.f new file mode 100644 index 00000000..b018a09e --- /dev/null +++ b/tecs/tecs_for.f @@ -0,0 +1,208 @@ + SUBROUTINE TECS_FOR ! File TAS_SRC:[TECS]TECS_FOR.FOR +c =================== +c +cdec$ ident 'V01D' +c------------------------------------------------------------------------------ +c Fortran-Interface to the TECS Client +c +c M. Zolliker, March 2000 +c Updates: +c V01A 21-Mar-2000 DM. Integrate into TASMAD +c 05-Apr-2000 M.Z. modifed error handling/changed arguments in TeccGet3 +c 01-May-2000 M.Z. renamed source, TECS_OPEN is now in a separate, system dependend file +c V01C 11-May-2000 DM. Split into modules. +c V01D 12-May-2000 M.Z. Changed error handling, no longer automatic call to TECS_OPEN +c------------------------------------------------------------------------------ +c +c For a description of the public interface: +c on VMS: search tecs_for.for "!'''!" (''' may be omitted) +c on Unix: grep !"!" tecs_for.for +c +c Public routines in this Module: +c +c subroutine TECS_OPEN (LUN, INIT, IRET) - open connection to tecs, if not yet open +c subroutine TECS_GET_T (IOLUN, TEMP, IRET) - read the temperature, wait if tecs is configuring +c subroutine TECS_WRITE_ERROR (IOLUN) - write out last occured error in TECS_x routines +c +c For internal use only: +c +c subroutine TECS_FOR - dummy entry point to get module name +c in library to match the file name. +c subroutine TECS_ERR_ROUTINE (LUN, TEXT) - (for internal use only) +c +!!------------------------------------------------------------------------------ +!! C Routines with Fortran interface (see TECS_CLI.C): +!! +!! integer function TECS_SET (TEMP) - set temperature target +!! integer function TECS_GET (TEMP) - get sample temperature +!! integer function TECS_QUIT_SERVER () - force server to quit +!! integer function TECS_GET_PAR (NAME, PAR) - get parameter +!! integer function TECS_SET_PAR (NAME, PAR) - set parameter +!! integer function TECS_SEND (CMND, REPLY) - send command to LakeShore +!! subroutine TECS_CLOSE - close connection to tecs +!! +!! real TEMP +!! character*(*) NAME, PAR, CMND, REPLY +!! +!! integer return values are error codes (negative means error, like in most C system routines) +!! +! +! C routines only for internal use in TECS_FOR.FOR: +! +! integer function TECS_INIT(STARTCMD, PORT) - open server connection +! logical function TECS_IS_OPEN () - check if tecs is open +! integer function TECS_GET3(SET_T, REG_T, SAM_T) - read 3 temperatures +! integer function TECS_WAIT() - wait for end of configuration +! +! character*(*) STARTCMD +! integer PORT +! real SET_T,REG_T,SAM_T +c------------------------------------------------------------------------------ + implicit none + stop 'TECS_FOR: do not call module header' + end +!!------------------------------------------------------------------------------ +!! Fortran routines in this file: +!! + SUBROUTINE TECS_OPEN(LUN, INIT, IRET) !! +!! ===================================== +!! +!! Open connection to the Tecs Server, if not yet done. +!! (a) LUN==0: INIT is the start command which should contain "-p " +!! (b) LUN/=0: INIT is the file specification where to read port number and start command +!! +c------------------------------------------------------------------------------ + implicit none + +c-------------------------------------------------------------- +c Define the dummy arguments + integer LUN !! logical number for reading init file + character*(*) INIT !! file specification or start command + integer IRET !! iret<0 means error +c-------------------------------------------------------------- + integer ios, port, i + character*128 startcmd + +! functions: + integer tecs_init + logical tecs_is_open +c-------------------------------------------------------------- + + if (tecs_is_open()) then + iret=1 ! already open + return + endif + + port=0 + + if (lun .eq. 0) then + +c extract the port number from the start command + + i=index(init, '-p ') + if (i .eq. 0) i=index(init, '-P ') + if (i .ne. 0) then + read(init,*,iostat=ios) port + endif + + if (port .eq. 0) port=9753 + iret=tecs_init(init, port) + + else + +c if INIT exists, read it to get the port number and the start command + + startcmd=' ' + + open (lun, file=init, status='old', readonly, iostat=ios) + if (ios .eq. 0) read (lun, *, iostat=ios) port + if (ios .eq. 0) read (lun, *, iostat=ios) ! skip options line + if (ios .eq. 0) read (lun, '(a)', iostat=ios) startcmd + close(lun) + if (ios .ne. 0) then + iret=-2 + call err_msg('TECS_OPEN: init file not found') + return + endif + if (port .eq. 0) port=9753 + iret=tecs_init(startcmd, port) + + endif + end + + SUBROUTINE TECS_GET_T (IOLUN, TEMP, IRET) !! +!! ============================================ +!! +!! Get temperatures and wait if TECS is configuring +!! + implicit none + +c Define the dummy arguments + + integer IOLUN !! unit to write informational messages + real*4 TEMP(4) !! TASMAD temperature array: set-temp, regulation, sample, aux-temp + integer IRET !! IRET=0: o.k., IRET<0: error +c------------------------------------------------------------------------------ + integer tecs_get3, tecs_wait + external tecs_get3, tecs_wait +c------------------------------------------------------------------------------ + iret=tecs_get3(temp(1), temp(3), temp(2)) ! temp(2) and temp(3) are exchanged in MSHOWT + if (iret .lt. 0) then + call err_txt('tecs_get_3'//char(10)//'tecs_get_t') + return + endif + if (iret .gt. 0) then + write(iolun, *) 'configuring temperature controller ...' + iret=tecs_wait() + if (iret .lt. 0) then + call err_txt('tecs_wait'//char(10)//'tecs_get_t') + return + endif + write(iolun, *) '... done' + iret=tecs_get3(temp(1), temp(3), temp(2)) ! temp(2) and temp(3) are exchanged in MSHOWT + if (iret .lt. 0) then + call err_txt('tecs_get3(2)'//char(10)//'tecs_get_t') + return + endif + endif + temp(4)=0.0 ! no auxilliary sensor + end + + subroutine TECS_WRITE_ERROR(IOLUN) !! +!! ================================== +!! +!! write out error message of last error and stack info +!! + implicit none + + integer IOLUN !! logical unit for output + + external tecs_err_routine + + call ErrSetOutRtn(tecs_err_routine, iolun) + call err_show('Error in TECS') + end + + + SUBROUTINE TECS_ERR_ROUTINE (LUN, TEXT) +! ======================================= +! +! routine called from C +! + implicit none +c-------------------------------------------------------------- +c Define the dummy arguments + byte text(128) + integer lun +c-------------------------------------------------------------- + integer i, j +c-------------------------------------------------------------- + do i=1,128 + if (text(i) .eq. 0) then + write(lun, '(x,128a1)') (text(j), j=1,i-1) + return + endif + enddo +! no terminating ASCII NUL found + write(lun, *) 'error in TECS_ERR_ROUTINE: illegal error text' + end diff --git a/tecs/tecs_plot.f90 b/tecs/tecs_plot.f90 new file mode 100644 index 00000000..9bc6e7cc --- /dev/null +++ b/tecs/tecs_plot.f90 @@ -0,0 +1,403 @@ +subroutine tecs_plot(file) + + character(len=*) file + + integer, parameter :: dmax=500, nset=3, nmenu=9, chartfreq=2 + real, parameter :: winmin=60., undef=-65535.0 + + real*4 x1,x2,xmin,xmax,ymin(2),ymax(2),window + real*4 xd(dmax),yd(dmax,nset) + real*4 ylast1,ylast2,y1,y2 + real*4 ex,ey,fx,fy,hmenu,wmenu,ymenu,ticks + real*4 xbox(8), ybox(8) + integer l,j,i,t0,t1,ntot,i1,i2,rl,n,startday,thisday + integer first,last,tbase,lastj + integer color(3)/2,4,3/ + character key*1 + character text(nmenu)*12/ & + 'live off','sel. zoom','zoom in','zoom out','show all','n days','n hours','n min','quit'/ + character keys*(nmenu)/'LZ+-XDHMQ'/ + character weekdays(7)*3/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/ + character buf*8 + external tplot_close + logical live, xwin, zoom, right + integer iret, numb + + integer dlog_open_r, dlog_get, dlog_close_r + + data window/1800./ + + zoom=.false. + right=.true. + call pgopen(" ") + call pgqinf('TYPE', buf, l) + xwin=(buf(1:1)=='X') + live=.not. xwin ! live switched off by default on X-Windows + + call pgask(.false.) + l=0 + iret=dlog_open_r(file, first, last, tbase) + if (iret<0) then + call err_txt('dlog_open_r') + goto 99 + endif + xmax=0 + +1 if (right .or. window==0 .or. live) then + ntot=dlog_get(dmax, nset, tbase, -window*1.1, 0.0, undef, xd, yd) + if (ntot<=0) then + if (ntot<0) then + call err_txt('dlog_get') + goto 99 + endif + x2=last-tbase + else + x2=maxval(xd(1:ntot)) + endif + if (live) then + x1=max(x2-window,xd(1)) + x2=max(x1+window,x2+min(window*0.2,max(window*0.01,300.))) + elseif (window==0) then + x1=minval(xd(1:ntot)) + window=x2-x1 + else + x1=x2-window + endif + else + if (.not. zoom) then + x1=x2-window + if (window==0) then ! maximal + x1=0 + x2=1e20 + endif + endif + ntot=dlog_get(dmax, nset, tbase, x1-window*0.1, x2+window*0.1, undef, xd, yd) + endif + if (ntot<0) then + call err_txt('dlog_get') + goto 99 + endif + if (ntot>0) then + xmin=minval(xd(1:ntot)) + xmax=maxval(xd(1:ntot)) + else + xmin=x1 + xmax=x2 + endif + + call pgsvp(0.07,0.93,0.1,0.9) ! define window size + + if (xmax<=xmin) then + xmax=xmin+1 +! l=0 +! print *,'no points found' +! print * +! goto 9 + endif + call pgsch(1.0) + i1=1 + i2=2 + do rl=1,2 + if (zoom) then + ymin(1)=y1 + ymax(1)=y2 + else + ymin(rl)=1e30 + ymax(rl)=-1e30 + ylast1=ymin(rl) + ylast2=ymax(rl) + do i=i1,i2 + do j=1,ntot + if (xd(j) >= x1 .and. xd(j) <= x2 .and. 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,ntot-4),ntot + 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)) + if (rl==1) then + ymax(rl)=ymax(rl)+ey*0.25 + ymin(rl)=ymin(rl)-ey*0.01 + else + ymax(rl)=ymax(rl)+ey*0.01 + ymin(rl)=ymin(rl)-ey*4 + endif + if (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 + ymin(rl)=0 + elseif (ymax(rl) .eq. ymin(rl)) then + ymax(rl)=ymin(rl)+1.0 + ymin(rl)=0 + endif + + zoom=.false. + + call pgswin(x1,x2,ymin(rl),ymax(rl)) + + do i=i1,i2 + call pgsci(color(i)) + n=0 + lastj=1 + do j=1,ntot + if (yd(j,i)==undef) then + if (j>lastj) call pgline(j-lastj, xd(lastj), yd(lastj,i)) + lastj=j+1 + endif + enddo + if (ntot .gt. lastj) call pgline(ntot+1-lastj, xd(lastj), yd(lastj,i)) + enddo + i1=3 + i2=3 + enddo + rl=2 + call pgsci(1) +! call pgtbox(' ', 0.0, 0, 'CIMST', 0.0, 0) + ey=ymax(rl)-(ymax(rl)-ymin(rl))*0.20 + call pgsch(0.7) + call pgaxis('N', x1, ey, x1, ymax(rl), ey, ymax(rl), 0, 0, 0.5, 0.0, 0.0, -1.0, 0.0) + rl=1 + call pgswin(x1,x2,ymin(rl),ymax(rl)) + ey=ymax(rl)-(ymax(rl)-ymin(rl))*0.21 + call pgsch(1.0) + call pgaxis('N', x1, ymin(rl), x1, ey, ymin(rl), ey, 0, 0, 0.5, 0.0, 0.5, -1.0, 0.0) + if (window>50*3600) then + ticks=8*3600 + elseif (window>25*3600) then + ticks=4*3600 + else + ticks=0.0 ! automatic + endif + call pgtbox('ZHXYBCINST', ticks, 0, 'CIMST', 0.0, 0) + call pgmtxt ('L', 2.5, 0.4, 0.5, 'T [K]') + call pgsci(color(1)) + call pgmtxt ('L', 2.5, 0.2, 0.5, 'Main Sensor') + call pgsci(color(2)) + call pgmtxt ('L', 2.5, 0.6, 0.5, 'Sample Sensor') + call pgsci(color(3)) + call pgmtxt ('L', 2.5, 0.9, 0.5, 'Power [W]') + call pgsci(1) + call pgsclp(0) + hmenu=(ymax(rl)-ymin(rl))/15. + ymenu=ymax(rl)+hmenu*0.5 + wmenu=(x2-x1)/(nmenu+2) + if (live) then + text(1)='live off' + else + text(1)='live on' + endif + call pgsch(0.7) + do i=1,nmenu + xbox(1)=x1+(i-0.7)*wmenu + ybox(1)=ymenu+hmenu + xbox(2)=xbox(1) + ybox(2)=ymenu+hmenu*0.5 + xbox(3)=x1+(i-0.95)*wmenu + ybox(3)=ybox(2) + xbox(4)=xbox(3) + ybox(4)=ybox(1) + xbox(5)=xbox(1) + ybox(5)=ybox(1) + call pgline(5, xbox, ybox) + call pgptxt(x1+(i-0.9)*wmenu, ymenu+0.65*hmenu, 0.0, 0.0, keys(i:i)) + call pgptxt(x1+(i-0.9)*wmenu, ymenu+0.15*hmenu, 0.0, 0.0, text(i)) + enddo + call pgmtxt('T', 3.5, 1.0, 1.0, 'any digit to enter n') + call pgmtxt('T', 2.0, 0.9, 1.0, 'n=') + thisday=(x1+x2)/2/(24*3600) + ey=ymin(rl)-hmenu*1.5 + i=max(0,int((x1+12*3600)/(24*3600))) + do + ex=(i+0.5)*24*3600 + if (ex>x2) EXIT + thisday=0 + call pgptxt(ex, ey, 0.0, 0.5, weekdays(mod(i,7)+1)) + ex=ex-12*3600 + if (ex .gt. x1) then + call pgmove(ex, ey) + call pgdraw(ex, ey+hmenu/2) + endif + ex=ex+24*3600 + if (ex .lt. x2) then + call pgmove(ex, ey) + call pgdraw(ex, ey+hmenu/2) + endif + i=i+1 + enddo + if (thisday>0) then + call pgptxt((x1+x2)/2, ey, 0.0, 0.5, weekdays(mod(thisday,7)+1)) + endif + call pgsclp(1) + + call get_key(key, 0, 0) ! purge buffer + + numb=0 +7 if (live) then + if (xwin) then + call pgmtxt('T', 1.0, 1.0, 1.0, 'LIVE MODE (click on text window before pressing any further key)') + endif + call get_key(key, 0, chartfreq) + do while (key .eq. char(0)) ! no key pressed + ntot=dlog_get(dmax, nset, tbase, xmax-0.5, 1e10, undef, xd, yd) + if (ntot<0) then + call err_txt('dlog_open_r 2') + goto 99 + endif + if (ntot .gt. 1) then + i1=1 + i2=2 + do rl=1,2 + call pgswin(x1,x2,ymin(rl),ymax(rl)) + do i=i1,i2 + call pgsci(color(i)) + n=0 + lastj=1 + do j=1,ntot + if (yd(j,i)==undef) then + if (j>lastj) call pgline(j-lastj, xd(lastj), yd(lastj,i)) + lastj=j+1 + elseif (xd(j)>x2 .or. yd(j,i)ymax(rl)) then + call pgpage + goto 1 + endif + enddo + if (ntot .gt. lastj) call pgline(ntot+1-lastj, xd(lastj), yd(lastj,i)) + enddo + i1=3 + i2=3 + enddo + xmax=max(xmax,xd(ntot)) + endif + call get_key(key, 0, chartfreq) + enddo + else + call pgcurs(ex, ey, key) + call must_purge + endif + rl=1 + call pgswin(x1,x2,ymin(rl),ymax(rl)) + +8 if (key>='a') key=char(ichar(key)-32) + if (ey>ymenu) then + i=max(0,min(nmenu,int((ex-x1)/wmenu+1))) + key=keys(i:i) + ex=(x1+x2)/2 + endif + if (key=='-') then + window=min(window*2, 8*24*3600.) + elseif (key=='X') then + window=0 + live=.false. + elseif (key=='+' .or. key==',') then + window=max(winmin,window/2) + elseif (key=='Z') then + call pgsci(1) + if (live) then + call pgmtxt('T', 1.0, 0.0, 0.0, 'click on two opposite corners of a selection rectangle') + call pgcurs(ex, ey, key) + else + call pgmtxt('T', 1.0, 0.3, 0.0, 'click on second corner of selection rectangle') + endif + call pgsci(5) + xmin=x1 + xmax=x2 + call pgmove(xmin, ey) + call pgdraw(xmax, ey) + call pgmove(ex, ymin(rl)) + call pgdraw(ex, ymax(rl)) + call pgcurs(fx, fy, key) + call must_purge + 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 + zoom=.true. + live=.false. + right=.false. + elseif (key .ge. '0' .and. key .le. '9') then + numb=numb*10+(ichar(key)-ichar('0')) + if (numb>0) then + write(buf, '(i8)') numb + l=1 + do while (buf(l:l)==' ') + l=l+1 + enddo + call pgsci(1) + call pgmtxt('T', 2.0, 0.9, 0.0, buf(l:)) + endif + call get_key(key, 2, 10) + if (key/=char(0)) goto 8 + goto 7 + elseif (key .eq. 'D') then + window=min(7*24*3600,24*3600*max(1,numb)) + right=.true. + elseif (key .eq. 'H') then + window=min(7*24*3600,3600*max(1,numb)) + right=.true. + elseif (key .eq. 'M') then + window=min(7*24*3600,60*max(1,numb)) + right=.true. + elseif (key .eq. 'L') then + live=.not. live + if (live) then + right=.true. + x2=xmax + endif + elseif (key=='Q' .or. key==char(13)) then + goto 9 + elseif (live) then + goto 7 + endif + numb=0 + call pgpage + goto 1 +99 call tecs_write_error(6) +9 continue + call tplot_close + call get_key(key, 0, 0) ! purge type-ahead-buffer + print * +end subroutine + +subroutine get_key(key, tmo1, tmo2) + integer tmo1, tmo2 + character key*1 + logical purge/.false./ + + key=char(0) + if (purge) then + purge=.false. + call sys_get_key(key, tmo1) + if (key/=char(0) .and. key/=char(13)) return + endif + if (tmo2>0) call sys_get_key(key, tmo2) + return + +entry must_purge + purge=.true. +end subroutine + +subroutine tplot_close + call pgclos + call dlog_close_r +end subroutine