M.Z.

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},
+    { "DMC",   "lnsa05.psi.ch", 9753, "DMC"   , 1},
-    { "TOPSI", "lnsa07.psi.ch", "TOPSI" , 1},
+    { "TOPSI", "lnsa07.psi.ch", 9753, "TOPSI" , 1},
-    { "SANS",  "lnsa10.psi.ch", "SANS"  , 1},
+    { "SANS",  "lnsa10.psi.ch", 9753, "SANS"  , 1},
-    { "HRPT",  "lnsa11.psi.ch", "HRPT"  , 1},
+    { "HRPT",  "lnsa11.psi.ch", 9753, "HRPT"  , 1},
-    { "TRICS", "lnsa18.psi.ch", "TRICS" , 1},
+    { "TRICS", "lnsa18.psi.ch", 9753, "TRICS" , 1},
-    { "AMOR",  "lnsa14.psi.ch", "AMOR"  , 1},
+    { "AMOR",  "lnsa14.psi.ch", 9753, "AMOR"  , 1},
-    { "FOCUS", "lnsa16.psi.ch", "FOCUS" , 1},
+    { "FOCUS", "lnsa16.psi.ch", 9753, "FOCUS" , 1},
-    { "TASP",  "lnsa12.psi.ch", "TASP",   1},
+    { "TASP",  "lnsa12.psi.ch", 9753, "TASP",   1},
-    { "TASP0", "lnsa09.psi.ch", NULL    , 0},
+    { "TASP0", "lnsa09.psi.ch", 9753, NULL    , 0},
-    { "RITA",  "lnsa08.psi.ch", NULL    , 0},
+    { "RITA",  "lnsa08.psi.ch", 9753, NULL    , 0},
-    { "PREP",  "lnsa01.psi.ch", NULL    , 0},
+    { "PREP",  "lnsa01.psi.ch", 9753, NULL    , 0},
-    { "TEST",  "lnsa15.psi.ch", "lnslib", 2}
+    { "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);

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:

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

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 (i<argc) i++; /* skip argument */
       str_append(cmd, "bin/startecs\n");
     } else {
       printf("unknown server %s\n", argv[i]);

tecs/sys_aunix.f

@@ -356,3 +356,14 @@
 	  endif
 	endif
 	end
+
+!-----------------------------------------------------------------------------
+!
+        subroutine sys_open_read(lun, name, ios)
+!
+! open a file as read only (needed to open files with read-only access)
+	integer lun, ios
+	character name*(*)
+
+	open (lun, file=name, status='old', readonly, iostat=ios)
+	end

tecs/sys_aunix_c.c

@@ -14,7 +14,9 @@ static char *last_line = NULL;
 int lnblnk_(char *c, int c_len);
 char *readline(char *prompt);
 void add_history(char *line_read);
+/*
 int usleep(time_t delay);
+*/
 
 void sys_rd_line_(char *cmd, int *retlen, char *prompt, int clen, int plen)
 {

tecs/tecs.c

@@ -1076,7 +1076,7 @@ int SetTemp(int switchOn) {
 
 void CalcMaxPower(void) {
   int i, j, vmax;
-  float pa, pr, pw, dif, p, pl, plim;
+  float pa, pr, pw, quo, p, pl, plim;
 
   iAmp=1; iRange=0;
   if (scalPower==0) scalPower=maxPower;
@@ -1086,34 +1086,32 @@ void CalcMaxPower(void) {
     /* power limited by 50 V output. U*U/R=2500/R */
     if (p>plim) 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 (p<pr) {
-          if (pr/p<dif) { dif=pr/p; pw=pr; iAmp=i; iRange=j; }
+          if (p/pr>quo) { quo=p/pr; pw=pr; iAmp=i; iRange=j; }
-        } else if (p<plim) {
+        } else if (p<plim || pw==0) {
-          if (p/pr<dif) { dif=p/pr; pw=pr; iAmp=i; iRange=j; }
+          if (pr/p>quo) { quo=pr/p; pw=pr; iAmp=i; iRange=j; }
         }
         pr=pr/10;
       }
       pa=pa/4;
     }
     scalPower=pw*powFact;
-    if (scalPower<plim) {
+    assert(scalPower>0);
+    if (scalPower<plim*powFact) {
       maxPower=scalPower;
     } else {
-      maxPower=plim;
+      maxPower=plim*powFact;
     }
+  } else {
+    iRange=0;
   }
 }
 
-#define ABS(x) (x < 0 ? -(x) : (x))    
-
-
 int SetMaxPower(void) {
-  int i, j;
-  float pa, pr, pw, dif, p;
   static float p0;
 
   if (loop == 1) {
@@ -1129,12 +1127,8 @@ int SetMaxPower(void) {
   if (slope!=0 && slope<0.1) slope=0.1;
   fbuf=tLimit/CtlScale();
   if (loop==1) {
-    if(ABS(p0) > .0 && ABS(scalPower) > .0){
+    if (scalPower!=0) prop=sqrt(p0/scalPower)*prop;
-      prop=sqrt(p0/scalPower)*prop;
+    ERR_P(LscCmd(ser, "CLIMIT 1:[fbuf],[slope],0,[iAmp],[iRange];PID [loop],[prop]"));
-    } else {
-      prop = 10.;
-    }
-    ERR_P(LscCmd(ser, "CLIMIT 1:[fbuf],[slope],0,2.0,[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 && i<nScan) {
+      fmt[k]=DisplayFmt(sensors[i+4]);
+      if (fmt[k]!='\0') {
+        flds[k]=sensors[i+4]->ch;
+        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]");

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

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 sys_getenv('TECS_START', start)
-	  call tecs_open(0, '#'//host, iret)
+	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 (cmd .eq. 'kill') then
-	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
 	  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), '
+	  print *,'ill1, ill2, ill3 (as cryostat), ill3f (as cryofurnace),'
-	1        ,'ill5 (maxi)' 
+	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

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