added test client
This commit is contained in:
cvs
8
tecs/get_lun.for
Normal file
8
tecs/get_lun.for
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
subroutine lib$get_lun(lun)
|
||||||
|
integer lun
|
||||||
|
lun=33
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine lib$free_lun(lun)
|
||||||
|
integer lun
|
||||||
|
end
|
||||||
190
tecs/tecs_tas.for
Normal file
190
tecs/tecs_tas.for
Normal file
@ -0,0 +1,190 @@
|
|||||||
|
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
|
||||||
|
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)
|
||||||
|
!! ========================
|
||||||
|
|
||||||
|
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'
|
||||||
|
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
|
||||||
|
character startcmd*80/' '/
|
||||||
|
|
||||||
|
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)
|
||||||
|
call lib$get_lun (lun)
|
||||||
|
open (lun, file='mad_tecs:tecs.init', status='old',
|
||||||
|
+ readonly, iostat=ios)
|
||||||
|
if (ios .eq. 0) read (lun, *, iostat=ios) port
|
||||||
|
if (ios .eq. 0) read (lun, '(a)', iostat=ios) startcmd
|
||||||
|
close(lun)
|
||||||
|
call lib$free_lun(lun)
|
||||||
|
|
||||||
|
if (ios .ne. 0) port = 9753 ! Otherwise, use default
|
||||||
|
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
|
||||||
40
tecs/test.for
Normal file
40
tecs/test.for
Normal file
@ -0,0 +1,40 @@
|
|||||||
|
program test
|
||||||
|
|
||||||
|
real*4 temp(4)
|
||||||
|
character device*32, cmd*80, response*80
|
||||||
|
integer i
|
||||||
|
|
||||||
|
call tecs_init(6)
|
||||||
|
print *
|
||||||
|
print *,'s <temp> set temperature'
|
||||||
|
print *,'device <device> set cryo device'
|
||||||
|
print *,'<command> direct command to LSC340'
|
||||||
|
print *,'"empty line" show temperature and device'
|
||||||
|
1 read(*,'(a)',end=9) cmd
|
||||||
|
if (cmd(1:2) .eq. 's') then
|
||||||
|
read(cmd(3:),*) temp(1)
|
||||||
|
call tecs_set_temp(6, temp(1))
|
||||||
|
elseif (cmd(1:2) .eq. 'c') then
|
||||||
|
call tecs_send_cmd(6, cmd(3:), response)
|
||||||
|
print *,response
|
||||||
|
elseif (cmd(1:2) .eq. 'q') then
|
||||||
|
call tecs_quit(6)
|
||||||
|
goto 9
|
||||||
|
elseif (cmd .ne. ' ') then
|
||||||
|
i=index(cmd,' ')
|
||||||
|
if (i .gt. 1) then
|
||||||
|
if (cmd(i+1:) .eq. ' ') then
|
||||||
|
call tecs_get_par(6, cmd(1:i-1), response)
|
||||||
|
print *,response
|
||||||
|
else
|
||||||
|
call tecs_set_par(6, cmd(1:i-1), cmd(i+1:))
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
call tecs_get_temp(6, temp)
|
||||||
|
print *,' x ', temp(2),' p ',temp(3),' set ',temp(1)
|
||||||
|
call tecs_get_par(6, 'device', device)
|
||||||
|
print *,'device=',device
|
||||||
|
endif
|
||||||
|
goto 1
|
||||||
|
9 end
|
||||||
Reference in New Issue
Block a user