From 643f0d81be05b4f87b19c0143620b7a510d2ba88 Mon Sep 17 00:00:00 2001 From: cvs Date: Mon, 12 Aug 2002 09:07:08 +0000 Subject: [PATCH] M.Z. --- tecs/instr_hosts.c | 31 ++++++------- tecs/makefile | 4 +- tecs/myc_err.c | 2 +- tecs/rstart.c | 1 + tecs/sys_aunix.f | 11 +++++ tecs/sys_aunix_c.c | 2 + tecs/tecs.c | 58 +++++++++++++----------- tecs/tecs_cli.c | 39 +++++++++++++++- tecs/tecs_client.f | 110 ++++++++++++++++++++++++++++++++++----------- tecs/tecs_for.f | 2 +- 10 files changed, 187 insertions(+), 73 deletions(-) diff --git a/tecs/instr_hosts.c b/tecs/instr_hosts.c index cf829be7..b1f48412 100644 --- a/tecs/instr_hosts.c +++ b/tecs/instr_hosts.c @@ -5,20 +5,21 @@ #include "myc_str.h" #include "sys_util.h" -typedef struct { char *instr; char *host; char *user; int cod; } Instrument; +typedef struct { char *instr; char *host; int port; char *user; int cod; } Instrument; static Instrument list[]={ - { "DMC", "lnsa05.psi.ch", "DMC" , 1}, - { "TOPSI", "lnsa07.psi.ch", "TOPSI" , 1}, - { "SANS", "lnsa10.psi.ch", "SANS" , 1}, - { "HRPT", "lnsa11.psi.ch", "HRPT" , 1}, - { "TRICS", "lnsa18.psi.ch", "TRICS" , 1}, - { "AMOR", "lnsa14.psi.ch", "AMOR" , 1}, - { "FOCUS", "lnsa16.psi.ch", "FOCUS" , 1}, - { "TASP", "lnsa12.psi.ch", "TASP", 1}, - { "TASP0", "lnsa09.psi.ch", NULL , 0}, - { "RITA", "lnsa08.psi.ch", NULL , 0}, - { "PREP", "lnsa01.psi.ch", NULL , 0}, - { "TEST", "lnsa15.psi.ch", "lnslib", 2} + { "DMC", "lnsa05.psi.ch", 9753, "DMC" , 1}, + { "TOPSI", "lnsa07.psi.ch", 9753, "TOPSI" , 1}, + { "SANS", "lnsa10.psi.ch", 9753, "SANS" , 1}, + { "HRPT", "lnsa11.psi.ch", 9753, "HRPT" , 1}, + { "TRICS", "lnsa18.psi.ch", 9753, "TRICS" , 1}, + { "AMOR", "lnsa14.psi.ch", 9753, "AMOR" , 1}, + { "FOCUS", "lnsa16.psi.ch", 9753, "FOCUS" , 1}, + { "TASP", "lnsa12.psi.ch", 9753, "TASP", 1}, + { "TASP0", "lnsa09.psi.ch", 9753, NULL , 0}, + { "RITA", "lnsa08.psi.ch", 9753, NULL , 0}, + { "PREP", "lnsa01.psi.ch", 9753, NULL , 0}, + { "AREA", "lnsa01.psi.ch", 9751, NULL , 0}, + { "TEST", "lnsa15.psi.ch", 9753, "lnslib", 2} }; int InstrHost(char *input, char *instr, char *host, char *user, char *pcod @@ -60,7 +61,7 @@ int InstrHost(char *input, char *instr, char *host, char *user, char *pcod str_ncpy(pcod, " ", pcod_len); } } - return 1; + return list[j].port; } @@ -75,7 +76,7 @@ int F_FUN(instr_host)(F_CHAR(input), F_CHAR(instr), F_CHAR(host), F_CHAR(user), STR_TO_C(buf, input); iRet=InstrHost(buf, in, ho, us, pc, sizeof(in), sizeof(ho), sizeof(us), sizeof(pc)); if (iRet>0) { - iRet=STR_TO_F(instr, in); + STR_TO_F(instr, in); STR_TO_F(host, ho); STR_TO_F(user, us); STR_TO_F(pcod, pc); diff --git a/tecs/makefile b/tecs/makefile index ef1c69c8..b4e5d6c1 100644 --- a/tecs/makefile +++ b/tecs/makefile @@ -2,7 +2,7 @@ # Makefile for the TECS Client library and TecsServer # # Markus Zolliker, March 2000 -# may now be used on different system without change M.Z.01.2002 +# may now be used on different systems without change M.Z.01.2002 #-------------------------------------------------------------------------- #------------ for DigitalUnix (add -DFORTIFY to CC_... for fortified version) CC_alpha_osf1=cc -std1 -g -warnprotos -I../ -I. -I../hardsup @@ -30,7 +30,7 @@ LIBR_OBJ= coc_util.o myc_err.o myc_str.o myc_buf.o myc_time.o SERV_OBJ= tecs.o coc_server.o tecs_lsc.o tecs_serial.o coc_logfile.o tecs_data.o $(LIBR_OBJ) CLI_OBJ= tecs_cli.o coc_client.o $(LIBR_OBJ) TCLI_OBJ= $(SYS_FILE).o $(SYS_FILE)_c.o $(CLI_OBJ) -TECLI_OBJ= tecs_client.o tecs_plot.o tecs_for.o sys_util.o str.o instr_hosts.o $(TCLI_OBJ) +TECLI_OBJ= tecs_client.o tecs_plot.o sys_util.o str.o instr_hosts.o $(TCLI_OBJ) .f.o: diff --git a/tecs/myc_err.c b/tecs/myc_err.c index 98790f98..aafd26be 100644 --- a/tecs/myc_err.c +++ b/tecs/myc_err.c @@ -119,7 +119,7 @@ void F_FUN(err_txt)(F_CHAR(text), int text_len) { } void F_FUN(err_msg)(F_CHAR(text), int text_len) { - char buf[256]; + static char buf[256]; STR_TO_C(buf, text); ErrMsg(buf); diff --git a/tecs/rstart.c b/tecs/rstart.c index 1b790e78..c858af6e 100644 --- a/tecs/rstart.c +++ b/tecs/rstart.c @@ -34,6 +34,7 @@ int main(int argc, char *argv[]) { if (0==strcmp(argv[i], "sics")) { str_append(cmd, "bin/startsics\n"); } else if (0==strcmp(argv[i], "tecs")) { + if (iplim) p=plim; pa=resist*4; /* max. maxPower R*I*I (I=2 A) */ - pw=0; dif=1.0e6; + pw=0; quo=0.; for (i=4; i>0; i--) { pr=pa; for (j=5; j>0; j--) { - if (pr>p) { - if (pr/pquo) { quo=p/pr; pw=pr; iAmp=i; iRange=j; } + } else if (pquo) { quo=pr/p; pw=pr; iAmp=i; iRange=j; } } pr=pr/10; } pa=pa/4; } scalPower=pw*powFact; - if (scalPower0); + if (scalPower .0 && ABS(scalPower) > .0){ - prop=sqrt(p0/scalPower)*prop; - } else { - prop = 10.; - } - ERR_P(LscCmd(ser, "CLIMIT 1:[fbuf],[slope],0,2.0,[iRange];PID [loop],[prop]")); + if (scalPower!=0) prop=sqrt(p0/scalPower)*prop; + ERR_P(LscCmd(ser, "CLIMIT 1:[fbuf],[slope],0,[iAmp],[iRange];PID [loop],[prop]")); } else { ERR_P(LscCmd(ser, "CLIMIT 2:[fbuf],[slope],0")); } @@ -1193,7 +1187,7 @@ int LoadFromLsc(void) { int Settings(void) { char buf[256], typ; - char flds[6], fmt[6]; + char *flds[6], fmt[6]; char *cfg, *p; int i,k,l; SensorT *s; @@ -1291,40 +1285,50 @@ int Settings(void) { fmt[k]=DisplayFmt(cryo.sensor1); if (fmt[k]!='\0') { - flds[k]=cryo.sensor1->ch[0]; + flds[k]=cryo.sensor1->ch; k++; } if (samp.sensor1 != cryo.sensor1) { fmt[k]=DisplayFmt(samp.sensor1); if (fmt[k]!='\0') { - flds[k]=samp.sensor1->ch[0]; + flds[k]=samp.sensor1->ch; k++; } } if (cryo.sensor2 != cryo.sensor1) { fmt[k]=DisplayFmt(cryo.sensor2); if (fmt[k]!='\0') { - flds[k]=cryo.sensor2->ch[0]; + flds[k]=cryo.sensor2->ch; k++; } } if (samp.sensor2 != samp.sensor1 && samp.sensor2 != cryo.sensor2) { fmt[k]=DisplayFmt(samp.sensor2); if (fmt[k]!='\0') { - flds[k]=samp.sensor2->ch[0]; + flds[k]=samp.sensor2->ch; k++; } } fmt[k]=DisplayFmt(testSens); if (fmt[k]!='\0' && k<=4) { - flds[k]=testSens->ch[0]; + flds[k]=testSens->ch; k++; } fmt[k]=DisplayFmt(auxSens); if (fmt[k]!='\0' && k<=4) { - flds[k]=auxSens->ch[0]; + flds[k]=auxSens->ch; k++; } + if (nScan>0) { + i=0; + while (k<=4 && ich; + k++; i++; + } + } + } maxfld=k-1; /* fields 5-8 standard raw data */ @@ -1335,7 +1339,7 @@ int Settings(void) { l=0; for (k=1; k<=maxfld; k++) { assert(l<128); - sprintf(buf+l, "DISPFLD %d,%c,%c;", k, flds[k], fmt[k]); + sprintf(buf+l, "DISPFLD %d,%s,%c;", k, flds[k], fmt[k]); l=strlen(buf); } str_append(buf, "DISPLAY:[maxfld]"); diff --git a/tecs/tecs_cli.c b/tecs/tecs_cli.c index 24b0a0c0..96e75418 100644 --- a/tecs/tecs_cli.c +++ b/tecs/tecs_cli.c @@ -10,23 +10,48 @@ #include "tecs_cli.h" #include "tecs_data.h" +int gethostname(char *name, int namelen); + static char response[COC_RES_LEN]; static char *rwCode="rwacs"; static char *rdCode="rdacs"; pTecsClient TeccInit(char *startcmd, int port) { CocConn *conn; + char *code, host[64]; NEW(conn, CocConn); + code=rwCode; if (startcmd[0]=='#') { - ERR_I(CocInitClient(conn, startcmd+1, port, rdCode, 0, "")); + gethostname(host, sizeof(host)); + if (0!=strcmp(startcmd+1, host)) code=rdCode; + ERR_I(CocInitClient(conn, startcmd+1, port, code, 0, "")); } else { - ERR_I(CocInitClient(conn, "", port, rwCode, 0, startcmd)); + ERR_I(CocInitClient(conn, "", port, code, 0, startcmd)); } return((pTecsClient)conn); OnError: return(NULL); } +pTecsClient TeccStart(char *startcmd, char *host, int port) { + CocConn *conn; + char *code, *cmd, thishost[64]; + + NEW(conn, CocConn); + code=rwCode; + cmd=startcmd; + if (host[0]!='\0') { + gethostname(thishost, sizeof(thishost)); + if (0!=strcmp(thishost, host)) { + code=rdCode; + cmd=""; + } + } + ERR_I(CocInitClient(conn, host, port, code, 0, cmd)); + return((pTecsClient)conn); + OnError: return(NULL); +} + int TeccGet3(pTecsClient conn, float *tC, float *tX, float *tP) { int iret; @@ -184,6 +209,16 @@ int F_FUN(tecs_init)(F_CHAR(startcmd), int *port, int startcmd_len) { OnError: return(-1); } +int F_FUN(tecs_start)(F_CHAR(startcmd), F_CHAR(host), int *port, int startcmd_len, int host_len) { + char sbuf[132], hbuf[64]; + + STR_TO_C(sbuf, startcmd); + STR_TO_C(hbuf, host); + ERR_P(conn=TeccStart(sbuf, hbuf, *port)); + return(0); + OnError: return(-1); +} + int F_FUN(tecs_rights)(int write) { if (write) { ERR_I(CocSendMagic(conn, rwCode)); diff --git a/tecs/tecs_client.f b/tecs/tecs_client.f index d832f793..24619e8a 100644 --- a/tecs/tecs_client.f +++ b/tecs/tecs_client.f @@ -1,9 +1,9 @@ program tecs_client real temp - character device*32, init*80, line*80, cmd*16, par*80, response*1024 + character device*32, start*80, line*80, cmd*16, par*80, response*1024 character inst*64, host*64, user*1, pcod*1 - integer i,j,k,iret,l + integer i,j,k,iret,l,port character cmdpar*128 character prompt*32/'tecs>'/ integer promptlen/6/ @@ -13,7 +13,7 @@ ! functions integer tecs_get_par, tecs_quit_server, tecs_set_par, tecs_watch_log - integer tecs_get, tecs_rights, show_log, instr_host + integer tecs_get, tecs_rights, show_log, instr_host, tecs_start call sys_load_env('cho') call sys_getenv('CHOOSER_GDEV', line) @@ -21,37 +21,41 @@ call sys_setenv('PGPLOT_DEV', '/'//line) endif - call sys_getenv('TECS_INIT', init) - call sys_get_cmdpar(line, l) if (l .ne. 0) then if (line(1:l) .eq. 'off' .or. line(1:l) .eq. 'OFF') then - call tecs_open(0, ' ', iret) + iret=tecs_start(' ', ' ', 9753) if (iret .lt. 0) goto 91 iret=tecs_quit_server(0) if (iret .lt. 0) goto 91 goto 99 endif oneCommand=.true. - i=instr_host(line, inst, host, user, pcod) + port=instr_host(line, inst, host, user, pcod) else oneCommand=.false. - i=0 + port=0 endif - if (i .ne. 0) then - call tecs_open(0, '#'//host, iret) + call sys_getenv('TECS_START', start) + if (port .gt. 0) then + if (port .eq. 1) port=9753 + call str_trim(start, start, k) + call str_trim(inst, inst, i) + if (start .ne. ' ') then + start=start(1:k)//' '//inst(1:i) + endif + iret=tecs_start(start, host, port) oneCommand=.false. prompt='tecs/'//inst(1:i)//'> ' promptlen=i+7 - else if (init .eq. ' ') then - call tecs_open(0, line, iret) else - call tecs_open(1, init, iret) + iret=tecs_start(start, ' ', 9753) endif - if (iret .lt. 0) goto 91 + if (iret .lt. 0) goto 90 + if (oneCommand) goto 11 print * @@ -117,14 +121,7 @@ defcmd='status' - i=instr_host(line, inst, host, user, pcod) - if (i .ne. 0) then - call tecs_close - call tecs_open(0, '#'//host, iret) - if (iret .lt. 0) goto 91 - prompt='tecs/'//inst(1:i)//'> ' - promptlen=i+7 - else if (cmd .eq. 'kill') then + if (cmd .eq. 'kill') then iret=tecs_quit_server(1) if (iret .lt. 0) goto 19 if (iret .gt. 0) then @@ -187,11 +184,12 @@ print * print *,'Temperature devices:' print * - print *,'ill1, ill2, ill3 (cryofurnace), ill4 (focus-cryo), ' - 1 ,'ill5 (maxi)' + print *,'ill1, ill2, ill3 (as cryostat), ill3f (as cryofurnace),' + 1 ,'ill4 (focus-cryo), ill5 (maxi), ori3' print *,'cti1, cti2, cti3, cti4, cti5 (maxi), cti6 (focus), apd' print *,'ccr4k (4K closed cycle), hef4c (TriCS 4circle cryo)' - print *,'sup4t (supra.magnet 4T), ft (tantalum furnace)' + print *,'fs (small furnace), ft (tantalum furnace)' + print *,'sup4t (supra.magnet 4T), ma09 (9T)' print *,'rdr11, rdr12 (LTF dilution 1 & 2, 20kOhm)' print * elseif (cmd .eq. 'log') then @@ -212,6 +210,7 @@ else iret=tecs_get_par(cmd, response, 2) if (iret .lt. 0) goto 19 + if (oneCommand .and. response .eq. ' ') goto 92 endif goto 1 @@ -234,16 +233,21 @@ else iret=tecs_set_par(cmd, par, 2) if (iret .lt. 0) goto 19 + if (oneCommand .and. par .eq. ' ') goto 92 endif goto 1 19 if (iret .eq. -2) then call tecs_write_msg(6) + if (oneCommand) goto 90 else call tecs_write_error(6) endif goto 1 +90 call tecs_write_error(6) +92 call exit(40) ! Abort + 91 if (iret .lt. 0) then call tecs_write_error(6) endif @@ -268,3 +272,59 @@ show_log=tecs_get_par('logline', str, 1) 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 err_set_outrtn(tecs_err_routine, iolun) + call err_show('Error in TECS') + end + + + subroutine TECS_WRITE_MSG(IOLUN) !! +!! ================================ +!! +!! write out error message of last error without stack info +!! + implicit none + + integer IOLUN !! logical unit for output + + external tecs_err_routine + + call err_set_outrtn(tecs_err_routine, iolun) + call err_short + 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_for.f b/tecs/tecs_for.f index 23162890..a07f3e32 100644 --- a/tecs/tecs_for.f +++ b/tecs/tecs_for.f @@ -121,7 +121,7 @@ c if INIT exists, read it to get the port number and the start command startcmd=' ' - open (lun, file=init, status='old', iostat=ios) + call sys_open_read(lun, init, 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