remove unused sources
This commit is contained in:
cvs
@ -1,8 +0,0 @@
|
||||
subroutine lib$get_lun(lun)
|
||||
integer lun
|
||||
lun=33
|
||||
end
|
||||
|
||||
subroutine lib$free_lun(lun)
|
||||
integer lun
|
||||
end
|
||||
@ -1,202 +0,0 @@
|
||||
SUBROUTINE TECS_TAS ! File TAS_SRC:[TECS]TECS_TAS.FOR
|
||||
c ===================
|
||||
c
|
||||
cdec$ ident 'V01B'
|
||||
c------------------------------------------------------------------------------
|
||||
c Interface to the TECS Client for TASMAD
|
||||
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------------------------------------------------------------------------------
|
||||
c Entry points in this Module:
|
||||
c
|
||||
c TECS_TAS - this is a dummy entry point to get module name in library
|
||||
c to match the file name.
|
||||
c TECS_INIT (ERRLUN) - initialising call.
|
||||
c TECS_GET_TEMP (ERRLUN, TEMP) - read the temperature
|
||||
c TECS_SET_TEMP (ERRLUN, SET_TEMP) - set the temperature
|
||||
c TECS_SET_PAR (ERRLUN, NAME, PAR) - set parameter
|
||||
c TECS_GET_PAR (ERRLUN, NAME, PAR) - get parameter
|
||||
c TECS_SEND_CMD (ERRLUN, CMD, RESPONSE) - send command to TC
|
||||
c TECS_OPEN (CONN, ERRLUN) - Open connection to TECS
|
||||
c TECS_ERR_ROUTINE (LUN, TEXT) - report an error (for internal use only)
|
||||
c------------------------------------------------------------------------------
|
||||
implicit none
|
||||
|
||||
c Define the dummy arguments
|
||||
|
||||
integer ERRLUN !! lun to write error messages
|
||||
real*4 TEMP(4) !! TASMAD temperature array: set-temp, regulation, sample, aux-temp
|
||||
real*4 SET_TEMP !! set temperature
|
||||
character NAME*(*) !! parameter name
|
||||
character PAR*(*) !! parameter
|
||||
character CMD*(*) !! command to send to temperature controller
|
||||
character RESPONSE*(*) !! response from temperature controller
|
||||
c------------------------------------------------------------------------------
|
||||
integer iret, l
|
||||
character startcmd*80
|
||||
common /tecs_init_com/startcmd
|
||||
integer*8 conn/0/
|
||||
save conn ! not needed for initialized variables
|
||||
|
||||
integer tecc_get3, tecc_set, tecc_set_par, tecc_get_par, tecc_send
|
||||
external tecc_get3, tecc_set, tecc_set_par, tecc_get_par, tecc_send
|
||||
integer tecc_quit_server, tecc_wait
|
||||
external tecc_quit_server, tecc_wait
|
||||
c------------------------------------------------------------------------------
|
||||
stop 'TECS_TAS: do not call module header'
|
||||
|
||||
entry TECS_INIT (ERRLUN, CMD)
|
||||
!! =============================
|
||||
|
||||
if (conn .eq. 0) call tecs_open(conn, errlun)
|
||||
return
|
||||
|
||||
entry TECS_GET_TEMP (ERRLUN, TEMP)
|
||||
!! ==================================
|
||||
|
||||
if (conn .eq. 0) then
|
||||
call tecs_open(conn, errlun)
|
||||
if (conn .eq. 0) return
|
||||
endif
|
||||
1 iret=tecc_get3(conn, temp(1), temp(3), temp(2)) ! temp(2) and temp(3) are exchanged in MSHOWT
|
||||
if (iret .lt. 0) goto 9
|
||||
if (iret .gt. 0) then
|
||||
write(errlun, *) 'configuring temperature controller ...'
|
||||
iret=tecc_wait(conn)
|
||||
if (iret .lt. 0) goto 9
|
||||
write(errlun, *) '... done'
|
||||
iret=tecc_get3(conn, temp(1), temp(3), temp(2)) ! temp(2) and temp(3) are exchanged in MSHOWT
|
||||
if (iret .lt. 0) goto 9
|
||||
endif
|
||||
2 temp(4)=0.0 ! no auxilliary sensor
|
||||
return
|
||||
|
||||
entry TECS_SET_TEMP (ERRLUN, SET_TEMP)
|
||||
!! ======================================
|
||||
|
||||
if (conn .eq. 0) then
|
||||
call tecs_open(conn, errlun)
|
||||
if (conn .eq. 0) return
|
||||
endif
|
||||
iret=tecc_set(conn, set_temp)
|
||||
if (iret .lt. 0) goto 9
|
||||
return
|
||||
|
||||
entry TECS_SET_PAR (ERRLUN, NAME, PAR)
|
||||
!! ======================================
|
||||
|
||||
if (conn .eq. 0) then
|
||||
call tecs_open(conn, errlun)
|
||||
if (conn .eq. 0) return
|
||||
endif
|
||||
iret=tecc_set_par(conn, name, par)
|
||||
if (iret .lt. 0) goto 9
|
||||
return
|
||||
|
||||
entry TECS_GET_PAR (ERRLUN, NAME, PAR)
|
||||
!! ======================================
|
||||
|
||||
if (conn .eq. 0) then
|
||||
call tecs_open(conn, errlun)
|
||||
if (conn .eq. 0) return
|
||||
endif
|
||||
iret=tecc_get_par(conn, name, par)
|
||||
if (iret .lt. 0) goto 9
|
||||
par(iret+1:)=' '
|
||||
return
|
||||
|
||||
entry TECS_SEND_CMD (ERRLUN, CMD, RESPONSE)
|
||||
!! ===========================================
|
||||
|
||||
if (conn .eq. 0) then
|
||||
call tecs_open(conn, errlun)
|
||||
if (conn .eq. 0) return
|
||||
endif
|
||||
iret=tecc_send(conn, cmd, response)
|
||||
if (iret .lt. 0) goto 9
|
||||
response(iret+1:)=' '
|
||||
return
|
||||
|
||||
entry TECS_QUIT(ERRLUN)
|
||||
!! =======================
|
||||
if (conn .eq. 0) then
|
||||
call tecs_open(conn, errlun)
|
||||
if (conn .eq. 0) return
|
||||
endif
|
||||
iret=tecc_quit_server(conn)
|
||||
if (iret .lt. 0) goto 9
|
||||
return
|
||||
|
||||
9 call err_show('Error in TECS_TAS')
|
||||
return
|
||||
|
||||
end
|
||||
SUBROUTINE TECS_OPEN (CONN, ERRLUN)
|
||||
! ===================================
|
||||
|
||||
implicit none
|
||||
|
||||
c--------------------------------------------------------------
|
||||
c Define the dummy arguments
|
||||
integer*8 conn
|
||||
integer errlun
|
||||
c--------------------------------------------------------------
|
||||
integer lun, port, ios, i
|
||||
|
||||
character startcmd*80
|
||||
common /tecs_init_com/startcmd
|
||||
data startcmd/' '/
|
||||
|
||||
integer*8 tecc_init
|
||||
external tecc_init, tecs_err_routine
|
||||
c--------------------------------------------------------------
|
||||
c If MAD_TECS:TECS.INIT exists, read it to get the port number and start command
|
||||
|
||||
call ErrSetOutRtn(tecs_err_routine, errlun)
|
||||
port=0
|
||||
if (startcmd .eq. ' ') then
|
||||
call lib$get_lun (lun)
|
||||
open (lun, file='mad_tecs:tecs.init', status='old',
|
||||
+ readonly, iostat=ios)
|
||||
if (ios .eq. 0) read (lun, '(a)', iostat=ios) startcmd
|
||||
close(lun)
|
||||
call lib$free_lun(lun)
|
||||
endif
|
||||
i=index(startcmd, '-p ')
|
||||
if (i .ne. 0) then
|
||||
read(startcmd(i+2:),*,iostat=ios) port
|
||||
endif
|
||||
if (port .eq. 0) port=9753
|
||||
c--------------------------------------------------------------
|
||||
|
||||
conn = tecc_init(startcmd, port)
|
||||
if (conn .eq. 0) then
|
||||
call err_show('Error in TECS_OPEN')
|
||||
endif
|
||||
|
||||
end
|
||||
SUBROUTINE TECS_ERR_ROUTINE (LUN, TEXT)
|
||||
! =======================================
|
||||
c
|
||||
c routine called from C
|
||||
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
|
||||
108
tecs/test.for
108
tecs/test.for
@ -1,108 +0,0 @@
|
||||
program test
|
||||
|
||||
real*4 temp(4)
|
||||
character device*32, line*80, cmd*16, par*80, response*80
|
||||
integer i,j,k
|
||||
|
||||
call tecs_init(6, ' ')
|
||||
|
||||
print *
|
||||
print *,'Tecs Client'
|
||||
print *,'-----------'
|
||||
print *
|
||||
print *,'<empty line> show temperature and device'
|
||||
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 *,'kill close TecsServer and exit'
|
||||
print *,'exit exit, but do not close TecsServer'
|
||||
print *,'help show list of parameters and cryo devices'
|
||||
print *
|
||||
1 print '(x,a,$)','tecs> '
|
||||
read(*,'(a)',end=9) line
|
||||
cmd=' '
|
||||
k=0
|
||||
do j=1,len(line)
|
||||
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_temp(6, temp)
|
||||
call tecs_get_par(6, 'device', device)
|
||||
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,len(line)
|
||||
if (line(i:i) .gt. ' ') then
|
||||
par=line(i:)
|
||||
goto 3
|
||||
endif
|
||||
enddo
|
||||
|
||||
! simple query
|
||||
|
||||
if (cmd .eq. 'kill') then
|
||||
call tecs_quit(6)
|
||||
goto 9
|
||||
elseif (cmd .eq. 'exit') then
|
||||
goto 9
|
||||
elseif (cmd .eq. 'help') then
|
||||
print *
|
||||
print *,'Writeable parameters:'
|
||||
print *
|
||||
print *,'tempC temperature set-point'
|
||||
print *,'device temperature device'
|
||||
print *,'controlMode control on: 0: heat exchanger, '
|
||||
1 ,'1: sample, 2: second loop'
|
||||
print *
|
||||
print *,'Read only parameters:'
|
||||
print *
|
||||
print *,'tempX heat exchanger temperature'
|
||||
print *,'tempP sample temperature'
|
||||
print *,'tempH set-point on regulation'
|
||||
print *,'tLimit temperature limit'
|
||||
print *,'htr heater current percentage'
|
||||
print *,'power heater max. power'
|
||||
print *,'resist heater resistance'
|
||||
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 *
|
||||
else
|
||||
call tecs_get_par(6, cmd, response)
|
||||
print '(7x,3a)',cmd(1:k),'=',response
|
||||
endif
|
||||
goto 1
|
||||
|
||||
3 if (cmd .eq. 'send') then
|
||||
call tecs_send_cmd(6, par, response)
|
||||
print '(7x,2a)','response: ',response
|
||||
else
|
||||
call tecs_set_par(6, cmd, par)
|
||||
print '(7x,3a)',cmd(1:k),':=',par
|
||||
endif
|
||||
goto 1
|
||||
|
||||
9 end
|
||||
Reference in New Issue
Block a user