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