From 32bef93fc25c052ef86ca811c6fb7ed5ac6acff8 Mon Sep 17 00:00:00 2001 From: cvs Date: Mon, 29 May 2000 09:16:28 +0000 Subject: [PATCH] remove unused sources --- tecs/get_lun.for | 8 -- tecs/tecs_tas.for | 202 ---------------------------------------------- tecs/test.for | 108 ------------------------- 3 files changed, 318 deletions(-) delete mode 100644 tecs/get_lun.for delete mode 100644 tecs/tecs_tas.for delete mode 100644 tecs/test.for diff --git a/tecs/get_lun.for b/tecs/get_lun.for deleted file mode 100644 index ddeb2dcb..00000000 --- a/tecs/get_lun.for +++ /dev/null @@ -1,8 +0,0 @@ - subroutine lib$get_lun(lun) - integer lun - lun=33 - end - - subroutine lib$free_lun(lun) - integer lun - end diff --git a/tecs/tecs_tas.for b/tecs/tecs_tas.for deleted file mode 100644 index 984a5d5b..00000000 --- a/tecs/tecs_tas.for +++ /dev/null @@ -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 diff --git a/tecs/test.for b/tecs/test.for deleted file mode 100644 index e272f21b..00000000 --- a/tecs/test.for +++ /dev/null @@ -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 *,' show temperature and device' - print *,'set set temperature' - print *,'send direct command to LSC340' - print *,'device set cryo device' - print *,' show parameter' - print *,' 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