program tecs_client 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,port integer maxfiles real wait parameter (maxfiles=10) integer nfiles/0/, mfiles/0/, idx, luns(0:maxfiles-1) character cmdpar*128 character prompt*32/'tecs[] '/ integer promptlen/7/ logical oneCommand character logarg*4/'25'/ character defcmd*8/'status'/ integer rwacs/0/ ! functions integer tecs_get_par, tecs_quit_server, tecs_set_par, tecs_watch_log integer tecs_get, tecs_rights, show_log, instr_host, tecs_start call sys_loadenv call sys_getenv('CHOOSER_GDEV', line) if (line .ne. ' ') then call sys_setenv('PGPLOT_DEV', '/'//line) endif call sys_get_cmdpar(line, l) if (l .ne. 0) then oneCommand=.true. if (l .eq. 1 .and. 1 line(1:1) .gt. '0' .and. line(1:1) .le. '9') then port=9750+(ichar(line(1:1))-ichar('0')) inst=line host=' ' oneCommand=.false. else rwacs=instr_host('tecs', line, inst, host, port) endif else ! call sys_getenv('HOST', line) rwacs=instr_host('tecs', line, inst, host, port) oneCommand=.false. endif 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 iret=tecs_start(start, ' ', 9753) endif if (iret .ne. 0) goto 90 if (oneCommand) goto 11 line='tecs' line(52-i:64)='connected to '//inst(1:i) print '(x,64(''-''))' print '(x,a)',line(1:64) print '(x,64(''-''))' print '(33x,a)','type help for a list of commands' print * if (rwacs .ne. 0) then iret=tecs_rights(1) endif l=0 1 if (oneCommand) goto 99 if (nfiles .gt. 0) then read(luns(idx), '(a)', err=22,end=22) line call str_trim(line, line, l) print '(x,2a)', prompt(1:promptlen),line(1:max(1,l)) else call sys_rd_line(line, l, prompt(1:promptlen)) if (l .lt. 0) goto 99 endif if (line(1:1) .eq. '@') then nfiles=nfiles+1 idx=mod(nfiles, maxfiles) if (nfiles .gt. mfiles+maxfiles) then ! close files which are too much nested close(luns(idx)) mfiles=nfiles-maxfiles else call sys_get_lun(luns(idx)) endif call sys_open(luns(idx), line(2:), 'R', i) if (i .ne. 0) then print *,'error opening ',line(2:) close(luns(idx)) call sys_free_lun(luns(idx)) nfiles=nfiles-1 idx=mod(nfiles, maxfiles) endif goto 1 endif 11 l=l+1 line(l:l)=' ' cmd=' ' k=0 do j=1,l if (k .gt. 0 .and. line(j:j) .eq. '=') line(j:j)=' ' 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 par=' ' do i=j,l if (line(i:i) .gt. ' ') then par=line(i:l) goto 3 ! command with parameter endif enddo goto 2 ! parameterless command endif enddo if (k .ne. 0) then print *,'command too long' goto 1 endif ! empty command 12 cmd=defcmd 2 continue ! parameterless command defcmd='status' if (cmd .eq. 'kill') then iret=tecs_quit_server(1) if (iret .lt. 0) goto 19 if (iret .gt. 0) then print *,'tecs server is not running' endif else if (cmd .eq. 'restart') then iret=tecs_quit_server(0) if (iret .lt. 0) goto 19 if (iret .gt. 0) then print *,'tecs server is not running' endif else if (cmd .eq. 'remote') then iret=tecs_set_par('remoteMode', '2', 2) if (iret .lt. 0) goto 19 else if (cmd .eq. 'reset') then iret=tecs_set_par('relay', '0', 2) if (iret .lt. 0) goto 19 elseif (cmd .eq. 'rwacs') then iret=tecs_rights(1) if (iret .lt. 0) goto 19 elseif (cmd .eq. 'exit' .or. cmd .eq. 'quit') then goto 99 elseif (cmd .eq. 'status') then iret=tecs_get_par('status', response, 1) if (iret .lt. 0) goto 19 elseif (cmd .eq. 'on' .or. cmd .eq. 'off') then l=0 goto 11 elseif (cmd .eq. 'plot') then call tecs_plot(' ') elseif (cmd .eq. 'help') then print * print *,'tecs client commands (can not be used from SICS)' print * print *,' show summary' print *,'plot chart for temperature' print *,'log show last n lines of logfile' print *,'remote set to remote mode' print *,'reset reset alarms' print *,'kill shut down TecsServer' print *,'restart restart TecsServer' print *,'exit, quit exit tecs client' print * print *,'commands/parameters:' print * print *,' From tecs: show parameter' print *,' set parameter' print * print *,' From SICS: tt show parameter' print *,' tt set parameter' print * print *,'changeable 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 *,'maxPower heater max. power' print *,'ramp ramp in K/min. (0: no ramp)' 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 *,'tLimit temperature limit' ! print *,'remoteMode 1: local, 2: remote' print *,'send direct command to LSC340' print * print *,'read only parameters:' print * print *,'Tm main temperature' print *,'Ts sample temperature' print *,'Tr set-point on regulation' print *,'helium helium level' print *,'htr heater current percentage' print *,'resist heater resistance' print *,'logfile name of the logfile' print * print *,'Ta,Tb,Tc,Td values of channels A,B,C,D' print * print *,'devhelp list available temperature devices' print * elseif (cmd .eq. 'log') then if (line(1:l) .eq. ' ') then print '(x,a)' 1 ,char(27)//'[A'//char(13)//char(27)//'[K'//char(27)//'[2A' endif if (show_log(logarg) .le. 0) then logarg='25' print *,'-------- end of logfile --------' goto 12 endif defcmd='log' logarg=' ' elseif (cmd .eq. 'watch') then iret=tecs_watch_log('M') if (iret .lt. 0) goto 19 else iret=tecs_get_par(cmd, response, 2) if (iret .lt. 0) goto 19 if (oneCommand .and. response .eq. ' ') goto 92 endif goto 1 3 continue ! command with parameter defcmd='status' if (cmd .eq. 'log') then if (show_log(par) .gt. 0) then defcmd='log' endif logarg=' ' elseif (cmd .eq. 'plot') then call str_lowcase(par, par) call str_upcase(par(1:1), par(1:1)) call tecs_plot(par) elseif (cmd .eq. 'watch') then iret=tecs_watch_log(par) if (iret .lt. 0) goto 19 elseif (cmd .eq. 'wait') then read(par, *, err=17,end=17) wait call sys_wait(wait*60.0) 17 continue 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 22 continue ! end of file close(luns(idx)) call sys_free_lun(luns(idx)) nfiles=nfiles-1 if (nfiles .lt. mfiles) then print *,'too many files nested' mfiles=0 nfiles=0 endif idx=mod(nfiles,maxfiles) 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 99 end integer function show_log(lines) character*(*) lines integer i,l character str*8192 ! functions integer tecs_get_par, tecs_set_par if (lines .ne. ' ') then l=tecs_set_par('logstart', lines, 0) print *,'line: ',lines print * endif 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