	SUBROUTINE ASKTT( OUTBUF, INBUF, NCHAR, TIMEOUT, ISTAT, DEVICE)
C  Jim Walker, Aug 1987 for VAX/VMS.
C  Asks one question of the user with the terminal in half duplex
C  so other subprocesses can't get in the way.
C	OUTBUF - character string holding the question
C	INBUF - character string getting the answer
C	NCHAR - length of data put into INBUF.
C	TIMEOUT - number of seconds to wait before giving up. (should be >2)
C	ISTAT returns QIO error code or -1 for timeout error.
C	ISTAT = -2 for ^Z, -3 for ^Y.
C	ISTAT = -4 Device is not a terminal.
C	DEVICE - character string holding the device name, usually 'TT:'
C
	IMPLICIT NONE
	CHARACTER*(*) OUTBUF, INBUF, DEVICE
	INTEGER*4 SYS$QIOW, SYS$ASSIGN, SYS$DASSGN, ISTAT2
	INTEGER*4 LIB$DISABLE_CTRL, LIB$ENABLE_CTRL, LIB$GETDVI

	INTEGER*4 CHARBUF(3), SAVEBUF, TIMEOUT, ISTAT, NCHAR, SAVECTRL
	INTEGER*2 ITTCHAN, IOSB(4)
	EXTERNAL CTRLYAST
	INCLUDE '($DCDEF)'
	INCLUDE '($DVIDEF)'
	INCLUDE '($IODEF)'
	INCLUDE '($LIBCLIDEF)'
	INCLUDE '($SSDEF)'
	INCLUDE '($TTDEF)'
	INCLUDE '($TT2DEF)'
C
	ISTAT = SYS$ASSIGN(DEVICE,ITTCHAN,,)
D	TYPE*,'ASSIGN ISTAT=',ISTAT
	IF(ISTAT.EQ.SS$_NOSUCHDEV) THEN
		ISTAT = -4
		GOTO 9000
	ENDIF
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
C
C Make sure device is a terminal
C
	ISTAT = LIB$GETDVI( DVI$_DEVCLASS, , DEVICE, ISTAT2,,)
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
	IF(ISTAT2.NE.DC$_TERM) THEN
		ISTAT = -4
		GOTO 9000
	ENDIF
C
C Get current terminal characteristics.
C
	ISTAT = SYS$QIOW ( , %VAL(ITTCHAN), %VAL(IO$_SENSEMODE),
	1 IOSB, , , CHARBUF, %VAL(12), , , , )
D	TYPE*,' SENSEMODE ISTAT=', ISTAT, IOSB
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
	IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
C  Set up the ^Y AST.
C
	ISTAT = LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY, SAVECTRL)
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
D	TYPE*,'LIB$ENABLE ', ISTAT,SAVECTRL,LIB$M_CLI_CTRLY
C
	ISTAT = SYS$QIOW ( , %VAL(ITTCHAN), 
	1 %VAL(IO$_SETMODE + IO$M_CTRLYAST ),
	1 IOSB, , , CTRLYAST, , , , ,)
D	TYPE*,' SET ^Y ISTAT=', ISTAT, IOSB
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
	IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
C $ SET TERMINAL/HALFDUPLEX
C
	SAVEBUF=CHARBUF(2)
      	CHARBUF(2) = IBSET( CHARBUF(2), TT$V_HALFDUP )
	ISTAT = SYS$QIOW ( , %VAL(ITTCHAN), %VAL(IO$_SETMODE),
	1 IOSB, , , CHARBUF, %VAL(12), , , ,)
D	TYPE*,' SET HALF DUP ISTAT=', ISTAT, IOSB
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
	IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
C  Ask the question, get the answer.
	ISTAT = SYS$QIOW( , %VAL(ITTCHAN),
	1	%VAL( IO$_READPROMPT + IO$M_TIMED ),
	2	IOSB, , ,
	3	%REF(INBUF), %VAL(LEN(INBUF)), %VAL(TIMEOUT), , 
	4	%REF(OUTBUF), %VAL(LEN(OUTBUF)) )
D	TYPE*,'READ ISTAT=',ISTAT,IOSB,INBUF(1:10)
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
C
C  Tell main program how long the data was.
	NCHAR = IOSB(2)
C
C  If we timed out, set ISTAT = -1 and tell user to never mind.
	IF(IOSB(1).EQ.SS$_TIMEOUT) THEN
	   IF(IOSB(1).EQ.SS$_TIMEOUT) ISTAT = -1
	    ISTAT2 = SYS$QIOW( , %VAL(ITTCHAN),
	1	%VAL( IO$_WRITEVBLK ),
	2	IOSB, , ,
	3	%REF(' Never mind.'//CHAR(13)//CHAR(10)), 
	4	%VAL(14), , , , )
D	    TYPE*,'WRITE ISTAT2=',ISTAT2,IOSB,INBUF(1:10)
	    IF(.NOT. ISTAT2) CALL LIB$SIGNAL ( %VAL(ISTAT2) )
	    IF(.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
	ELSEIF(IOSB(3).EQ.26.AND.IOSB(1).EQ.1) THEN
		ISTAT = -2
	ELSEIF(IOSB(1).EQ.SS$_CONTROLY) THEN
		ISTAT = -3
	ELSEIF(.NOT. IOSB(1)) THEN
C  Signal non timeout errors from readprompt qio.
		CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
	ENDIF
C
C  Set the terminal back the way it was.
	CHARBUF(2)=SAVEBUF
	ISTAT2 = SYS$QIOW ( , %VAL(ITTCHAN), %VAL(IO$_SETMODE),
	1 IOSB, , , CHARBUF, %VAL(12), , , ,)
D	TYPE*,' RESETMODE ISTAT2=', ISTAT2, IOSB
	IF (.NOT. ISTAT2) CALL LIB$SIGNAL ( %VAL(ISTAT2) )
	IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
	ISTAT2 = LIB$ENABLE_CTRL(SAVECTRL, )
	IF (.NOT. ISTAT2) CALL LIB$SIGNAL ( %VAL(ISTAT2) )
D	TYPE*,' LIB$ENABLE ', ISTAT2, SAVECTRL,LIB$M_CLI_CTRLY
C
C  Deassign the channel from the terminal.
9000	ISTAT2=SYS$DASSGN(%VAL(ITTCHAN))
D	TYPE*,'DEASSIGN ISTAT2=',ISTAT2
	RETURN
	END
C
	SUBROUTINE CTRLYAST
	RETURN
D	END
C
D	PROGRAM TEST
C
D	CHARACTER*80 INBUF
D	INTEGER*4 NCHAR, ISTAT
D	CALL ASKTT( 'Talk to me: ', INBUF, NCHAR, 10, ISTAT, 'TT:')
D	TYPE*,' ISTAT=',ISTAT,' NCHAR=',NCHAR
D	TYPE*,' DATA="',INBUF(1:NCHAR),'"'
	END
	SUBROUTINE ECHO( OUTBUF, NCHAR, ISTAT)
C  Jim Walker, Aug 1987 for Diffrac-500 with a Radix Databox.
C  This is for a VAX talking to a RADIX DATABOX
C  Send NCHAR characters in OUTBUF to the terminal on ICHAN 
C  and wait up to 5 seconds for each to come back.
C  ISTAT returns QIO error code or -2 for unexpected character returned
C  or -1 for timeout error.
C
	IMPLICIT NONE
	INCLUDE 'INTERFACE.COM'
	CHARACTER*(*) OUTBUF
	CHARACTER*1 INBUF
	INTEGER*4 SYS$QIOW, ISTAT, NCHAR, I
	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'
	PARAMETER TIMEOUT=5	! use at least 2 seconds.
C
      DO 10, I=1,NCHAR
	ISTAT = SYS$QIOW( , %VAL(ICHAN),
	1	%VAL( IO$_READPROMPT + IO$M_NOECHO + IO$M_TIMED ),
	2	IOSB, , ,
	3	%REF(INBUF), %VAL(1), %VAL(TIMEOUT), , 
	4	%REF(OUTBUF(I:I)), %VAL(1) )
C
	IF(.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
	IF(ISTAT) ISTAT=IOSB(1)
	IF(IOSB(1).EQ.SS$_TIMEOUT) ISTAT = -1
	IF(IOSB(1).NE.SS$_NORMAL) GOTO 99
	IF(INBUF.NE.OUTBUF(I:I)) GOTO 98
10    CONTINUE
      GOTO 99
98	ISTAT = -2
99	IF(DEBUG) TYPE*,'ECHO ISTAT=',ISTAT
	RETURN
	END
C
C  Jim Walker, Aug 1987 for Diffrac-500 with a Radix Databox.
C  Move to the specified 2-theta angle.
C
	SUBROUTINE GOSTAR(ANGLE)
	REAL*4 ANGLE
	CALL GO(ANGLE)
	RETURN
	END
C
	SUBROUTINE GO(ANGLE)
C
	INCLUDE '[102,2]INP.COM/NOLIST'	
	INCLUDE '[102,2]ERRBLK.COM/NOLIST'	
	INCLUDE '[102,2]RAWDES.COM/NOLIST'	
	INCLUDE 'INTERFACE.COM'
	REAL*4 ANGLE
	INTEGER*4 ISTAT, ITIME, I, NCHAR
	PARAMETER CR=CHAR(13)
	CHARACTER BUFFER*255
C
	IERR(5) = 0
C
C  Setup command: Calibrate mode, Goto angle.
	WRITE(BUFFER,4) 13, ANGLE
4	FORMAT('C',a1,'G',F8.4)
C
C  Put in leading zeros so the interface doesn't get mad.
	DO 7,I=4,8
	   IF(BUFFER(I:I).EQ.' ') BUFFER(I:I)='0'
7	CONTINUE
C
C  Send command to interface.
	CALL NULL(BUFFER, 14, ISTAT)
	IF(ISTAT.NE.1) GOTO 9000
	CALL ECHO(CHAR(13), 1, ISTAT)
	IF(ISTAT.NE.-2) GOTO 9000
C
C  Wait for completion
	ITIME = INT( ABS( CURANG-ANGLE)) * 2 + 2
10	CALL READ(BUFFER, NCHAR, ISTAT, ITIME)
	IF(ISTAT.EQ.-1 .OR. ISTAT.EQ.-2) GOTO 10
	IF(ISTAT.NE.1) GOTO 9000
	CURANG=ANGLE
C
C  Get back to monitor mode
	CALL NULL('E'//CHAR(13), 2, ISTAT)
	IF(ISTAT.NE.1) GOTO 9000
	GOTO 9999
C
C  Error return
9000	IERR(5)=127	! interface error
	IERR(4)=ISTAT
	CALL ERRMSG('GOSTAR',RAWFIL,1,BUFFER)
C
9999	RETURN
	END
	SUBROUTINE DEVATA
C  Open a channel and initialize the interface.
C  Jim Walker, Aug 1987 with Sept 1987 changes.
C  Look for SETUP to find the lines to change
C  to fix interface parameters.
C
	INCLUDE '[102,2]INP.COM/NOLIST'	
	INCLUDE '[102,2]ERRBLK.COM/NOLIST'	! IERR
	INCLUDE '[102,2]RAWDES.COM/NOLIST'	! SAMPLE ID
	INCLUDE '[102,2]XRYDES.COM/NOLIST'	! DIFTE1
	INCLUDE 'INTERFACE.COM'
	COMMON /RADIXC/ INBUF
	CHARACTER*255 INBUF
	INTEGER*4 SYS$ASSIGN, ISTAT, I, J, NCHAR, IRETRY, ITIME
	CHARACTER*255 BUFFER
	PARAMETER CR=CHAR(13)
C
C  Debug mode on or off.  Normally debug mode is off.  Turn it on
C  by saying RADIX$DEBUG:==YES on the $ prompt before getting into D500.
C  Turn it off again by saying RADIX$DEBUG:==NO
	DEBUG = .FALSE.
	CALL LIB$GET_SYMBOL('RADIX$DEBUG',BUFFER,,)
	IF(BUFFER(1:1).EQ.'Y') 	DEBUG=.TRUE.
C
C  Display first 10 points.
	IDSPLY = 10
C
	IERR(1) = 0
	IERR(2) = 0
	IERR(3) = 0
	IERR(4) = 0
	IERR(5) = 0
C
C  Assign a channel to the device.
	IF(ICHAN.EQ.0) THEN
		ISTAT=SYS$ASSIGN(DIFTE1,ICHAN,,)
		IF(.NOT.ISTAT) THEN
			IERR(5)=353
			IF(DEBUG) CALL LIB$SIGNAL(%VAL(ISTAT))
			GOTO 9001
		ENDIF
		IF(DEBUG) TYPE*,'ICHAN=', ICHAN
	ENDIF
C
C  FIND OUT WHAT STATE THE INTERFACE IS IN
C
	IRETRY=0
	GOTO 110
C
C  This bit tries again up to ten times.
100	IRETRY=IRETRY+1
	IF(IRETRY.GT.10) GOTO 9998
	IF(DEBUG) TYPE*,' TRYING TO GET INTERFACE TO SHUT UP ',IRETRY
C
C  First send an X-ON and carriage return to try and wake it up.
	CALL ECHO(CHAR(17), 1, ISTAT)
	CALL ECHO(CHAR(13), 1, ISTAT)
C
C  Read noise until it times out, or the interface settles down
C  to printing its counts per second.
105	CALL READ(BUFFER, NCHAR, ISTAT, 2)
C  Counts per second display has backspace characters in it.
	IF(INDEX(BUFFER(1:NCHAR),CHAR(8)).NE.0) THEN
		IF(DEBUG) TYPE*,' FOUND A BACKSPACE CHARACTER '
		GOTO 110
	ENDIF
C  If we ended with carriage return go get some more.
	IF(ISTAT.GT.1 .OR. ISTAT.EQ.-2 .OR. ISTAT.EQ.-3) GOTO 105
C
C  Ask for Help.
110	CALL NULL('?', 1, ISTAT)
C
C  Find the beginning of the text.
	DO 200, I=1,IOSB(2)
		IF(INBUF(I:I).GE.'A' .AND. INBUF(I:I).LE.'Z') GOTO 210
200	CONTINUE
C
C Nothing in INBUF, try again.
	IF(DEBUG) TYPE*, 'INBUF=[',INBUF(1:IOSB(2)),']'
	GOTO 100
C
210	CONTINUE
C
C  Based on where we are, get into calibrate mode.
	IF(INBUF(I:I+4).EQ.'CALIB') GOTO 250 ! already in calibrate mode
	IF(INBUF(I:I+6).EQ.'MONITOR') GOTO 220
C  Valid memory needs to be cleared then we are in calibrate mode.
	IF(INBUF(I:I).EQ.'V') THEN
		IF(DEBUG) TYPE*,' CLEARING MEMORY ON POWERUP'
		CALL ECHO('C',1,ISTAT)
		GOTO 100
C  Edit or Option mode.
	ELSEIF(INBUF(I:I+3).EQ.'EDIT' .OR. INBUF(I:I+5).EQ.'OPTION') THEN
		CALL NULL('E'//cr, 2, ISTAT)
	ELSEIF(INBUF(I:I+8).EQ.'EXECUTION') THEN
		CALL NULL('T'//cr, 2, ISTAT)
	ELSE
		IF(DEBUG) TYPE*,'UNRECOGNIZED RESPONSE ',INBUF(I:I+8)
		GOTO 100
	ENDIF
C  Get into calibrate mode.
220	CALL NULL('C'//cr, 2, ISTAT)
C
C  SET UP THE INTERFACE
C
C  Set up the standard things.  
C
250	WRITE(BUFFER,254) 13,13,13,13,13,13,13,9,13,13
C
C  CHANGE THESE LINES TO CHANGE THE SETUPS ON THE INTERFACE.
C
254	FORMAT('NE',a1,	! Enable null prompts to computer
	1 'C0',a1,	! First turn off continuous c.p.s. report
	6 'S200',a1,	! number of steps per degree.
	2 'B0.5',a1,	! Backlash angle (after steps / degree)
	3 'D3',a1,	! Display 3 decimal places
	4 'F960',a1,	! Factor time= 960 hz
	5 'LT',a1,	! Count for constant time
	6 a1,'300',a1	! integrate speed = 300 hz
	7 'M700',a1,'~')	! Motor frequency (Hz)
C
	I = INDEX(BUFFER,'~')-1
	CALL NULL(BUFFER, I, ISTAT)
	IF(ISTAT.GT.1) GOTO 9000
C
C  INITIALIZE THE CURRENT ANGLE.
C
C  Get the default angle.
	INBUF=' '
	CALL NULL('A'//CR, 2, ISTAT)
	IF(ISTAT.NE.1) GOTO 9000
C  Set up the question.
	J=INDEX(INBUF,')')
	ITIME = -1
	IF(J.EQ.0) THEN
		INBUF(8:)='  (respond within one minute)'
		J=INDEX(INBUF,')')
		ITIME = 60
	ENDIF
	DO 96,NCHAR=LEN(RAWFIL),1,-1
	  IF(RAWFIL(NCHAR:NCHAR).NE.' ') GOTO 98
96	CONTINUE
	NCHAR=1
98	WRITE(BUFFER, 97) 13,10,7,RAWFIL(1:NCHAR),DNUM,DVER,
	1	13,10, DIFDES, 13,10, INBUF(1:J)
97	FORMAT(3A1,'Starting run ',A,' on unit ',I2,3A1, A,2A1
	1 ' Enter current 2-theta [D: ',A,'] : ')
C  Ask for the new current angle
	CALL ASKTT( BUFFER(1:3+INDEX(BUFFER,']')), INBUF, NCHAR,
	1	ITIME, ISTAT, 'TT:')
C
C  Can't display counts if TT: doesn't exist.
C  Do it anyway; DPMSTA will open FOR$TYPE for us.
CC	IF(ISTAT.EQ.-4) IDSPLY = 0
C  Timeout or Nosuchdev is acceptable, don't set angle.
	IF(ISTAT.EQ.-1 .or. ISTAT.EQ.-4) GOTO 900
C  Any other error us inacceptable.
	IF(ISTAT.NE.1) GOTO 9998
C
C  Add the command to whats in the buffer.
	BUFFER(1:1)='A'
	BUFFER(2:NCHAR+1) = INBUF(1:NCHAR)
	BUFFER(NCHAR+2:NCHAR+2)=CR
C
C  Send the command
	CALL NULL(BUFFER, NCHAR+2, ISTAT)
	IF(ISTAT.NE.1) GOTO 9998
C
C  Leave interface in Monitor Mode
900	CALL NULL('E'//CR,2,ISTAT)
	IF(ISTAT.NE.1) GOTO 9000
	GOTO 9999
C
9998	IERR(5) = 118	! Error in angle syncronization.
	GOTO 9001
C
9000	IERR(5)=139	! error attaching daco
9001	IERR(4)=ISTAT
	IF(IERR(5).NE.0) CALL ERRMSG('DEVATA',RAWFIL,1,BUFFER)
C
9999	RETURN
	END
	SUBROUTINE IFINTE( DANG, COUNTS, TIME)
C
C  Jim Walker, Aug 1987 for Diffrac-500 with a Radix Databox.
C  Integrate from the current position to the specified 2-theta angle.
C
	INCLUDE '[102,2]INP.COM/NOLIST'	
	INCLUDE '[102,2]IOBLK.COM/NOLIST'
	INCLUDE '[102,2]ERRBLK.COM/NOLIST'	
	INCLUDE '[102,2]RAWDES.COM/NOLIST'	
	INCLUDE 'INTERFACE.COM'
	REAL*4 DANG, COUNTS, TIME
	INTEGER*4 ISTAT, ITIME, NCHAR, I, J, K, ISTAT2
	PARAMETER CR=CHAR(13)
	CHARACTER BUFFER*255
C
	IERR(5)=0
D	ISTAT2=0
C
C  Setup command: Calibrate mode, Integrate to angle.
	WRITE(BUFFER,4) 13, CURANG+DANG
4	FORMAT('C',a1,'I',F8.4)
C
C  Put in leading zeros so the interface doesn't get mad.
	DO 7,I=4,8
	   IF(BUFFER(I:I).EQ.' ') BUFFER(I:I)='0'
7	CONTINUE
C
C  Send command to interface.
D	ISTAT2=1
	CALL NULL(BUFFER, 11, ISTAT)
	IF(ISTAT.NE.1) GOTO 9000
C
C  Carriage return will start it running.
D	ISTAT2=2
	TIME = SECNDS(0.0)
	CALL ECHO(CHAR(13), 1, ISTAT)
	IF(ISTAT.NE.-2) GOTO 9000
C
C  Wait for completion (shouldn't take any longer than 2 sec per degree)
	ITIME = INT( ABS(DANG)) * 2 + 2
10	CALL READ(BUFFER, NCHAR, ISTAT, ITIME)
D	ISTAT2=3
	IF(ISTAT.EQ.-1) GOTO 10
	IF(ISTAT.NE.-2) GOTO 9000
	TIME = SECNDS( TIME )
C
C  Read total counts.
D	ISTAT2=4
	CALL READ(BUFFER, NCHAR, ISTAT, 99)
	IF(ISTAT.NE.-2) GOTO 9000
C  Find beginning of counts
	DO 74, J=J,NCHAR
	IF(BUFFER(J:J).GE.'0' .AND. BUFFER(J:J).LE.'9') GOTO 75
74	CONTINUE
C  Didn't find anything, bail out.
D	ISTAT2=5
	GOTO 9000
C  Find end of counts
75	DO 76, K=J,NCHAR
	IF(BUFFER(K:K).LT.'0' .OR. BUFFER(K:K).GT.'9') GOTO 77
76	CONTINUE
C  Didn't find anything, bail out (this can't happen)
D	ISTAT2=6
	GOTO 9000
77	BUFFER(K:K)='.'
	READ(BUFFER(J:K), '(G)') COUNTS
C
C  Echo the data to the terminal if required.
	IF(IDSPLY.GT.0) THEN
	   IDSPLY = IDSPLY - 1
	   IF(IDIF.EQ.0) IDIF=6
	   WRITE(IDIF,79) CURANG, CURANG+DANG, COUNTS/TIME
79	   FORMAT(' Range =',2F8.3,'   Counts/sec =',F10.2)
C  If we are done typing, close the listing device
	   IF(IDSPLY.EQ.0 .AND. IDIF.NE.6) CLOSE(UNIT=IDIF)
	ENDIF
C
C  Read rest of junk.
D	ISTAT2=7
	CALL READ(BUFFER, NCHAR, ISTAT, 99)
C	IF(ISTAT.NE.1) GOTO 9000
C
C  Remember where we are now.
	CURANG=CURANG+DANG
C
C  Get back to monitor mode
D	ISTAT2=8
	CALL NULL('E'//CHAR(13), 2, ISTAT)
	IF(ISTAT.NE.1) GOTO 9000
	GOTO 9999
C
C  Error return
9000	IERR(5)=127	! interface error
D	IF(ISTAT.LT.0 .AND. ISTAT.GT.-99) ISTAT=ISTAT-100*ISTAT2
	IERR(4)=ISTAT
	CALL ERRMSG('IFINTE',RAWFIL,1,BUFFER)
C
9999	RETURN
	END
C***********************************************************************
	SUBROUTINE IFTIME(AIN, AOUT)
	REAL*4 AOUT, AIN
	PARAMETER UNIT=0.1
	AOUT=MAX(1,IFIX(AIN/UNIT+0.5))*UNIT
	RETURN
D	END
D	PROGRAM TEST
D1	TYPE*,'COUNT TIME?'
D	READ*,AIN
D	CALL IFTIME(AIN,AOUT)
D	TYPE*,AOUT
D	GOTO 1
	END
	SUBROUTINE NULL( OUTBUF, NCHAR, ISTAT)
C  Jim Walker, Aug 1987.
C  This is for a VAX talking to a RADIX DATABOX.
C  Send NCHAR characters in OUTBUF to the terminal on ICHAN 
C  and wait up to 2 seconds for verification.
C  Blanks are skipped.
C  ISTAT returns QIO error code or -2 for Bell character recieved.
C  ISTAT = 1 when terminator is null (databox ready for input)
C  ISTAT = -1 for timeout error
C  Terminators for read will be Null and Bell (^@ and ^G)
C
	IMPLICIT NONE
C  Interface specific common blocks.
	INCLUDE 'INTERFACE.COM'
	CHARACTER*(*) OUTBUF
	COMMON /RADIXC/ INBUF
	CHARACTER*255 INBUF
C
	PARAMETER TIMEOUT=2	! use at least 2 seconds
	INTEGER*4 SYS$QIOW, ISTAT, NCHAR, I, J, MASK(2)
	DATA MASK/0,129/	! Terminator mask.
C
C  Get a parameter definitions for system codes.
	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'
C
C  Send the characters one at a time.
      DO 30, I=1,NCHAR
	IF(OUTBUF(I:I).EQ.' ') GOTO 30
C
C  Send the character and wait for a Null.
	ISTAT = SYS$QIOW( , %VAL(ICHAN),
	1	%VAL( IO$_READPROMPT+IO$M_NOECHO+IO$M_TIMED+IO$M_PURGE ),
	2	IOSB, , ,
	3	%REF(INBUF), %VAL(255), %VAL(TIMEOUT), MASK, 
	4	%REF(OUTBUF(I:I)), %VAL(1) )
C
C  If there was a "directive error" then signal it and bail out.
	IF(.NOT.ISTAT) THEN
		CALL LIB$SIGNAL(%VAL(ISTAT))
		GOTO 99
	ENDIF
C
C  Now we only worry about I/O errors.
	IF(ISTAT) ISTAT=IOSB(1)
C
C  If we timed out, check input buffer to see if character was echoed.
	IF(IOSB(1).EQ.SS$_TIMEOUT) THEN
		DO 10, J=1,IOSB(2)
C  Character was echoed, continue normally.
		IF(INBUF(J:J).EQ.OUTBUF(I:I)) THEN
			ISTAT = 1
			GOTO 20
			ENDIF
10		CONTINUE
C
C  Character not found, bail out with ISTAT = -1
		ISTAT = -1
		GOTO 99
	ENDIF
C
C  If there was an input error then bail out.
	IF(.NOT.IOSB(1)) THEN
		CALL LIB$SIGNAL(%VAL(IOSB(1)))
		GOTO 99
	ENDIF
C
C  In debug mode print data recieved from interface.
20	IF(DEBUG) THEN
	   IF(IOSB(1).EQ.SS$_TIMEOUT) TYPE*,' Soft timeout'
	   TYPE *,'"',(INBUF(J:J),J=1,IOSB(2)),'"'
14	   FORMAT(' ',72A1,'-')
	ENDIF
C
C  If Bell character was recieved than bail out with ISTAT=-2.
	IF(IOSB(1).EQ.SS$_NORMAL .AND. IOSB(3).EQ.7) THEN
	   ISTAT = -2
	   GOTO 99
	ENDIF
C
C  Go through main loop again unless we are done.
30    CONTINUE
C
C All done here, go back to main program.
C
99    IF(DEBUG) TYPE*,'NULL ISTAT=',ISTAT
      RETURN
      END
	SUBROUTINE READ( INBUF, NCHAR, ISTAT, TIMEOUT)
C  Programmer: Jim Walker, Aug 1987.
C  This is for a VAX listening to a RADIX DATABOX.
C  Reads characters the terminal on ICHAN into INBUF
C  and waits up to TIMEOUT seconds for a terminator.
C  NCHAR returns number of characters.
C  ISTAT returns QIO error code or -2 if line ended with return.
C  ISTAT = -1 for timeout error or -3 for data overrun
C  ISTAT = 1 if terminator was Null (interface ready for input).
C  Terminators for read will be Null and Return (^@ and ^M)
C
	IMPLICIT NONE
	CHARACTER*(*) INBUF
	INTEGER*4 SYS$QIOW, ISTAT, NCHAR, I, J, MASK(2), TIMEOUT
	DATA MASK/0,8193/	! Terminator mask.
	INCLUDE 'INTERFACE.COM'
	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'
C
C  Read the data and wait for a Null or Return.
	ISTAT = SYS$QIOW( , %VAL(ICHAN),
	1	%VAL( IO$_READVBLK+IO$M_NOECHO+IO$M_TIMED ),
	2	IOSB, , ,
	3	%REF(INBUF), %VAL(LEN(INBUF)), %VAL(TIMEOUT), MASK, 
	4	,  )
C
C  If there was a "directive error" then signal it and bail out.
	IF(.NOT.ISTAT) THEN
		IF(DEBUG) CALL LIB$SIGNAL(%VAL(ISTAT))
		GOTO 99
	ENDIF
C
C  Now we only worry about I/O errors.
	IF(ISTAT) ISTAT=IOSB(1)
C
C  If there was an input error other than timeout then bail out.
	IF(IOSB(1).EQ.SS$_TIMEOUT) THEN
		ISTAT = -1
	ELSEIF(IOSB(1).EQ.SS$_DATAOVERUN) THEN
		ISTAT = -3
	ELSEIF(.NOT.IOSB(1)) THEN
		IF(DEBUG) CALL LIB$SIGNAL(%VAL(IOSB(1)))
		GOTO 99
C
C  If Return character was recieved than exit with ISTAT=-2.
	ELSEIF(IOSB(3).EQ.13) THEN
	   ISTAT = -2
	ENDIF
C
C  In debug mode print data recieved from interface.
	IF(DEBUG) THEN
	   IF(IOSB(1).EQ.SS$_TIMEOUT) TYPE*,' Timeout'
	   TYPE *,'"',(INBUF(J:J),J=1,IOSB(2)),'"'
14	   FORMAT(' ',72A1,'-')
	ENDIF
C
C All done here, go back to main program.
C
99    NCHAR=IOSB(2)
      IF(DEBUG) TYPE*,' READ ISTAT=',ISTAT,' NCHAR=',NCHAR
      RETURN
      END
	SUBROUTINE STSCAN(ARRAY,FIRST,IDS,NSTEP,TIME,STEP,IFMT,MTHSYN)
C	Jim Walker AUG 1987 for Diffrac-500 on Radix Databox.
C	This routine emulates a Siemes subroutine.
C	References: ECHO, GOSTAR, INTRPT, NULL, READ, IFTIME
C
C	First call needs all arguments.  Subsequent calls should
C	be CALL STACAN(ARRAY,.FALSE.,IERR(4),,,,,)
C++
C++     NSTEP : number of step for this measurement
C++     TIME  : duration of one single step in seconds
C++     STEP  : 2 theta - magnitude of one single step
C++     IFMT  : # of data items per record (must be in the range 1 - 12[10])
C      MTHSYN : Ignored
C++
C++     IDS   : directive status
C++     IDS = +1 for one line of data transferred without error
C++     IDS = +2 if the last line of data has been transferred without error
C
C	IDS = -2 illegal or unexpected answer from uP
C	IDS = -10 if no valid data record is received in the allotted time
C	IDS = -350 or -360 if interrupted.
C
C+++ Extra stuff for radix interface.
	INCLUDE '[102,2]INP.COM/NOLIST'	
	INCLUDE '[102,2]IOBLK.COM/NOLIST'	
	INCLUDE '[102,2]ERRBLK.COM/NOLIST'	
	INCLUDE 'INTERFACE.COM'
	COMMON /RADIXC/ INBUF
	CHARACTER*255 INBUF
	INTEGER*2 I,J,K, MTHSYN
	INTEGER*4 NSTEPR, ISTAT, NCHAR
	REAL*4 EANG
	CHARACTER*80 BUFFER
C---
	COMMON /ALFRED/ ANGLE, NSTEPR, NSTEPL, CTIME, DANG, IDIM
	REAL*4 ARRAY(1), TIME, STEP, ANGLE, CTIME, DANG
	INTEGER*2 NSTEP1, NSTEPL, IDIM, IDS, NSTEP, IFMT
	LOGICAL FIRST
C
C  First time in save the parameters
	IF(FIRST) THEN
		NSTEPR=NSTEP
		NSTEPL=0
		CALL IFTIME( TIME, CTIME)
		DANG=STEP
		IDIM=IFMT
	ENDIF
C
C  START THE INTERFACE RUNNING ON THIS RANGE.
C
	IF(NSTEPL.EQ.0) THEN
C  Make sure we are where we think we are.
	CALL GOSTAR( CURANG)
	IF(IERR(5).NE.0) GOTO 9000
C  Change this number -----v  to the number of points the interface can hold.
		NSTEPL = ( 4096 / IDIM) * IDIM
		NSTEPL = MIN( NSTEPL, NSTEPR)
		NSTEPR = NSTEPR - NSTEPL
		EANG = (NSTEPL-1) * DANG + CURANG
C
C  Get into Edit mode on range 1
		CALL NULL('E'//CHAR(13), 2, ISTAT)
		IF(ISTAT.NE.1) GOTO 9000
		DO 20, I=1,100
		J=INDEX(INBUF, '# 1')
		IF(J.NE.0) GOTO 22
		   CALL NULL('P', 1, ISTAT)
		   IF(ISTAT.NE.1) GOTO 9000
20		CONTINUE
C
C  Set up range 1, undefine range 2, zero the data memory & goto run mode.
22		WRITE(BUFFER,24) 13, 'I',CURANG,13, 'F',EANG,13,
	1	'S',DANG,13, 'C',INT(CTIME*10.0+0.5),13, 13,13,13,13,13
24		FORMAT('U',a1, 3(a1,F8.4,a1),a1,I5,a1,
	1	'NU',a1,'E',a1,'C',a1,'Z',a1,'YE',a1,'S')
		CALL NULL(BUFFER, 65, ISTAT)
		IF(ISTAT.NE.1) GOTO 9000
C
C  Enter a blank title to get things moving.  This time don't wait
C  for a null.  Echo will only read back 1 char, and set ISTAT=-2
C  because it wasnt a carriage return.
		CALL ECHO(CHAR(13), 1, ISTAT)
		IF(ISTAT.NE.-2) GOTO 9000
C
C  Throw away heading junk.
25		CALL READ(BUFFER, NCHAR, ISTAT, 5)
		IF(ISTAT.LT.-3 .OR. ISTAT.GT.-1) GOTO 9000
		IF(INDEX(BUFFER,'Count').EQ.0 .AND. ISTAT.NE.-1) GOTO 25
	ENDIF
C
C  How many steps for this call?
	NSTEP1 = MIN(IDIM,NSTEPL)
C
C  Stepscan loop.
C
	DO 7, I=1,NSTEP1
C
C  Read a line of data from the interface.
	CALL READ(BUFFER, NCHAR, ISTAT, INT(CTIME)+5 )
	IF(ISTAT.EQ.-1) THEN
		IDS = -10
		GOTO 9999
	ENDIF
	IF(ISTAT.NE.-2) GOTO 9000
C
C  The angle is the number with the decimal point; the counts follow.
	J=INDEX(BUFFER(1:NCHAR),'.')	! Find . in angle
	J=J+INDEX(BUFFER(J:NCHAR),' ')	! Find end of angle
C  Find beginning of counts
	DO 74, J=J,NCHAR
	IF(BUFFER(J:J).GE.'0' .AND. BUFFER(J:J).LE.'9') GOTO 75
74	CONTINUE
C  Didn't find anything, bail out.
	GOTO 9000
C  Find end of counts
75	DO 76, K=J,NCHAR
	IF(BUFFER(K:K).LT.'0' .OR. BUFFER(K:K).GT.'9') GOTO 77
76	CONTINUE
C  Didn't find anything, bail out (this can't happen)
	GOTO 9000
77	READ(BUFFER(J:K-1), '(G8.0)') ARRAY(I)
	TMPRTR = 25.0
C  Find beginning of temperature, if present.
	DO 54, J=K,NCHAR
	IF(BUFFER(J:J).GE.'0' .AND. BUFFER(J:J).LE.'9') GOTO 55
54	CONTINUE
C  Didn't find anything, skip it..
	GOTO 78
C  Find end of temperature.
55	DO 56, K=J,NCHAR
	IF(BUFFER(K:K).EQ.'.') GOTO 56
	IF(BUFFER(K:K).LT.'0' .OR. BUFFER(K:K).GT.'9') GOTO 57
56	CONTINUE
	K = NCHAR+1
57	READ(BUFFER(J:K-1), '(G8.0)') TMPRTR
C
C  Echo the data to the terminal if required.
78	IF(IDSPLY.GT.0) THEN
	   IDSPLY = IDSPLY - 1
	   IF(IDIF.EQ.0) IDIF=6
	   WRITE(IDIF,79)CURANG, ARRAY(I)/CTIME, TMPRTR
79	   FORMAT(' Angle =',F8.3,'   Counts/sec =',F10.2,
     &      '   Temp =',F8.2)
C  If we are done typing, close the listing device
	   IF(IDSPLY.EQ.0 .AND. IDIF.NE.6) CLOSE(UNIT=IDIF)
	ENDIF
C
C  Update where we think the goniometer is.
	CURANG = CURANG + DANG
C
C  Check for interrupt
	CALL INTRPT(IDS)
	IF(IDS.NE.0) THEN
		CALL NULL('T'//CHAR(13), 2, ISTAT)
		GOTO 9999
	ENDIF
C
C  End of stepscan loop.
 7	CONTINUE
C
C  Successful returns
	NSTEPL = NSTEPL - NSTEP1
	IDS = 1				! one line transferred
	IF(NSTEPL.EQ.0) THEN	! all done
	IF(NSTEPR.EQ.0) IDS = 2
C
C  Throw away any remaining junk.
80		CALL READ(BUFFER, NCHAR, ISTAT, 5)
		IF(ISTAT.EQ.-2 .OR. ISTAT.EQ.-3) GOTO 80
	ENDIF
	GOTO 9999
C
C  Error returns
 9000	IDS=-2			! illegal response from interface
	IF(ISTAT.EQ.-1) IDS = -1 ! Timeout
C
 9999	RETURN
	END
