- Rearranged directory structure for forking out ANSTO
- Refactored site specific stuff into a site module - PSI specific stuff is now in the PSI directory. - The old version has been tagged with pre-ansto
This commit is contained in:
cvs
364
tecs/tecs_client.f
Normal file
364
tecs/tecs_client.f
Normal file
@@ -0,0 +1,364 @@
|
||||
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/6/
|
||||
logical oneCommand
|
||||
character logarg*4/'25'/
|
||||
character defcmd*8/'status'/
|
||||
|
||||
! 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
|
||||
if (line(1:l) .eq. 'off' .or. line(1:l) .eq. 'OFF') then
|
||||
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.
|
||||
port=instr_host(line, inst, host, user, pcod)
|
||||
else
|
||||
oneCommand=.false.
|
||||
port=0
|
||||
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
|
||||
|
||||
print *
|
||||
print *,'Tecs Client'
|
||||
print *,'-----------'
|
||||
print *
|
||||
print *,'set <temp> set temperature'
|
||||
print *,'send <command> direct command to LSC340'
|
||||
print *,'device <device> set cryo device'
|
||||
print *,'<parameter> show parameter'
|
||||
print *,'<parameter> <value> set parameter'
|
||||
print *
|
||||
print *,'<empty line> show summary'
|
||||
print *,'plot <var> chart for temperature and <var>'
|
||||
1 ,' var = P (default), He, Aux'
|
||||
print *,'log <n> 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 *,'help show list of parameters and cryo devices'
|
||||
print *
|
||||
|
||||
l=0
|
||||
1 if (oneCommand) goto 99
|
||||
if (nfiles .gt. 0) then
|
||||
read(luns(idx), '(q,a)', err=22,end=22) l, line
|
||||
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 *,'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 *,'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 *,'remoteMode 1: local, 2: remote'
|
||||
print *
|
||||
print *,'Read only parameters:'
|
||||
print *
|
||||
print *,'Tm main temperature'
|
||||
print *,'Ts sample temperature'
|
||||
print *,'Tr set-point on regulation'
|
||||
print *,'tLimit temperature limit'
|
||||
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
|
||||
Reference in New Issue
Block a user