C***********************************************************************
C
C	THE REST OF THE SUBROUTINES ARE SPECIFIC TO THE CANBERRA INTERFACE
C	WE USE AT ALFRED UNIVERSITY.  PIECES OF IT MAY BE USEFUL.
C	THE SYNTAX OF THE CALLS IS DOCUMENTED HERE.
C
C***********************************************************************
C
C	DESCRIPTION OF STANDARD INTERFACE CONTROL ROUTINES
C	Jim Walker, Alfred University, 4-SEP-85.
C
C	By having a standard for interface control subroutines it becomes
C	easier to convert a data collection program from one type of
C	interface to another.  All that is required is linking the same
C	main program with a different interface library.
C
C	All subroutine names and common block names in the interface 
C	control package begin with IF.  You can avoid accidently naming
C	part of the main program the same as one of these subroutines by
C	avoiding names that start with IF.
C
C  INTERFACE CONTROL SUBROUTINES:
C
CCALL IFINIT(IQUIT)   { initialize interface }
C	  Assigns the unit numbers in IF1 and IF2 to the interface,
C	initializes the interface and sets the detector to a known angle.
C	IQUIT is a flag that indicates the unit is initialized (IQUIT.EQ.0)
C	or the user hit control Z when asked the current angle (IQUIT.NE.0)
CCALL IFLOAD(IQUIT)   { load sample }
C	  Loads a sample if an automatic sample changer is in use.
C	If sample is changed manually this moves to a nice angle and waits
C	for the user to press S to start.  If IFINIT hasn't been called
C	yet, this calls it.  IQUIT works the same as with IFINIT.
CCALL IFEXIT { unload sample and shut down unit }
C	  This is similer to IFLOAD.  It allows the user to unload the last
C	sample then moves the detector to 90 degrees.  If IFINIT hasn't been
C	called yet, this subroutine does nothing.
CCALL IFSSCN( BANG, EANG, DANG, SPEED, TIMEL,COUNTL, SUB WRCNT)
C	  This does a step scan.  BANG is the starting angle.
C	EANG is the ending angle if positive, or negative the number of steps.
C	SPEED is the degrees per minute to move between steps.  
C	IF(SPEED.LT.0) then the count time includes the move time.
C	IF(SPEED.EQ.0) the default in SPSTEP is used as the speed.
C	TIMEL and COUNTL are the maximum time and maximun counts to count for.
C	SUB WRCNT is a dummy subroutine that is called after each step.  The
C	results passed in common to WRCNT are the time counted (CTIME), number 
C	of counts (COUNTS), angle counted at (ANGLE), and step number (ISTEP).
CCALL IFINTE( BANG, EANG, SPEED)
C	IF(SPEED.EQ.0) the default in SPINTE is used as the speed.
C	  This integrates from BANG to EANG at SPEED degrees per minute.
C	The time counted and number of counts are passed back in common.
CCALL IFMOVE( TANG, SPEED) { absolute move }
C	  Moves the detector to angle TANG at SPEED degrees per minute.
C	IF(SPEED.EQ.0) the default in SPSLEW (for long moves) or
C	SPSTEP (for short moves) is used as the speed.
C	If(SPEED.LT.0) the movement is toward low angle and IFMOVE goes too
C	far, then backs up to clean up gear backlash.
CCALL IFRMOV( DANG, SPEED) { relative move }
C	  This is equivalent to call IFMOVE( current angle + DANG , SPEED).
CCALL IFCNT( TIMEL, COUNTL) { collect a point }
C	  This counts at the current angle.  TIMEL and COUNTL are the 
C	maximum time and maximun counts to count for.  The results passed 
C	back in common are the time counted (CTIME), number of counts (COUNTS),
C	and angle counted at (ANGLE).
CCALL IFTEMP(ITEMP) { finds temperature }
C	  ITEMP is supposed to be the temp in degrees C times 100.  In
C	Alfred we don't measure the temperature so this always returns
C	2500 for room tempeture.
C
C  DATA CONVERSION SUBROUTINES:
C	  These are functions that convert units that people like to codes
C	that the interface needs to see.  These were written as subroutines 
C	instead of functions because I like to be able to find out which
C	subprograms a routine uses by searching for the word "call".
C	The first argument is input and the result is stored in the last.
C
CCALL IFANGL( degrees, steps)
C	  Converts the detector angle from degrees to a number of steps.
C	The conversion factor is kept in common.  To convert steps back to 
C	degrees, multiply by STPSIZ.  Because the number of steps is always a 
C	whole number, there will never be any roundoff error to worry about.
C	If you insist on doing everything in degrees, you can set STPSIZ=1.0
C	and make IFANGL just do STEPS=DEGREES.
CCALL IFTIME( raw time, rounded time)
C	  This rounds the time you ask for off to the nearest time the
C	counter/timer is capable of using.
CCALL IFSPED( raw speed, rounded speed)
C	  This rounds the speed you want off to the nearest speed the
C	axis positioner is capable of moving.
C
C  OTHER SUBS CALLED BY BUT NOT PART OF INTERFACE LIBRARY:
C	  These are called by the interface control library, but are
C	program dependant rather than interface depandant.
C
CSUBROUTINE IFERR { cleans up and exits on fatal error }
C	  When a routine in the library detects a fatal error, it prints an
C	error message and stores codes in IFSTAT and KICK (documented below) 
C	and then calls IFERR immediatly before returning.  This routine may
C	print any additional messages required by the program, and then stop.
C	This frees the programmer from testing error codes after each call
C	to the IF subroutines.
CSUBROUTINE IFKICK { respond to interrupts }
C	  Some interfaces have a "computer attention" button, and some
C	operating systems have ways to check to see if the user hit a key
C	without waiting if there is no input.  These can be used to allow
C	the user to interrupt a run and get a status report, set debug flags,
C	or simply abort a run.  When the part of the interface library that
C	actually gets input detects an interrupt, it calls IFKICK.  The 
C	type of interrupt is passed in KICK.  IFKICK is responsible for
C	printing the status report, or setting debug flags.
CSUBROUTINE dummy( COUNTS) { last arg of IFSSCN; deals with data. }
C	  This subroutine is passed to IFSSCN as the last argument.
C	It can have any name, and there can be different versions for 
C	different scans.  It is called after each point is measured and
C	is supposed to pull the data out of common (see IFSSCN for variable
C	names)  and store that data where it is supposed to go.
C
C======================================================================
C
C  ERROR HANDLING
C
C	  Errors are handled by the routine that detects the error.
C	Any necessary messages are printed and then subroutine IFERR is
C	called.  IFERR is supposed to print any program dependant messages,
C	such as what inputs should be used to restart the run, and then stop.
C	This frees the programmer from checking error codes after each call.
C	If you want to check error codes, write IFERR so it returns instead
C	of stopping.  Error codes are returned in common in IFSTAT and KICK.
C
C	IFSTAT indicates the interface just did (>0) or tried to do (<0):
C	Positive numbers indicate sucessful completion.  Negative numbers
C	indicate a fatal error.  Routines that can cause each error are
C	in parentheses.
C		 0  not yet initialized (the initial state)
C		 1  just initialized or unloaded sample (IFMOVE or IFEXIT)
C		 2  just loaded (IFLOAD)
C		 3  just moved (IFMOVE, IFRMOVE)
C		 4  counted for requested time (IFCNT)
C		 5  counted to count limit (IFCNT)
C		 6  completed scan (IFSSCN, IFINTE)
C
C	KICK indicates which abnormal event took place.
C	Codes 10 and above indicate the program was interruped by the
C	user.  For example, the user may have pushed the "computer attention
C	button on the interface.  Positive numbers indicate that the program
C	can continue after printing messages.  Negative numbers indicate
C	the program should exit.
C		 0  normal completion
C		 1  I/O error (causes NERR to be incremented.)  
C		 2  bug check (i.e., something that should never happen.)
C		 3  bad parameters in subroutine call
C		+3  a bad parameter was replaced by a default value
C		-4  too many errors; NERR >= LIMERR
C		 9  some error but the programmer didn't bother to say which
C		+10 user paused program and maybe set debug flags
C		-10 user wants to abort program: print info needed to restart.
C		+11 print brief status
C		+12 print extended status
C
C=======================================================================
C
C  COMMON BLOCKS
C
COMMON /IFDATA/ holds information that is used internally by the interface
C   control libray, but is not needed in very many places in the main program.
C	BANGL,   Lowest angle detector can be moved to.      Not in degrees!
C	EANGL,   Highest angle detector can be moved to.      "   "
C	SETANG,  Angle to move to for easy loading of sample. "   "
C	SPINTE,  Default speed for integration  (degrees per minute).
C	SPSLEW,  Default speed used when moving long distences.
C	SPSTEP,  Default speed used for moving short distences.
C	DELAY,   Fudge factor used in calculating how long a run will take.
C		Use DELAY * TIMEL * (EANG-BANG)/DANG as an estimate.    
C	IFTYPE,  Interface type, for future use.  This would allow one set of 
C		subroutines to be written that works on several different 
C		types of interfaces, instead of having a separate library for 
C		each type.
C	IFNAME,  a 6 byte character string holding the name of the unit in use.
C		This is at the end so it can be extended without displacing
C		everything else in the common block.
C
COMMON /IFCMN/ holds information that is used fairly frequently in the
C   main program.
C	STPSIZ,  conversion factor for converting angles into degrees before
C		printing them.
C	CANG,    the current angle of the detector.  Set after each move.
C	ANGLE,   the angle of the last point measured.  Set by IFSSCN
C		and IFCNT.  May or may not be set by IFINTE, depending on
C		whether or not integration is done by summing up a stepscan.
C		Note that IFMOVE does not set set this!
C	COUNTS,  number of counts at last poing or integrated over range.
C	CTIME,   time used to collect above number of counts.
C	ISTEP,   point number in a step scan; can be used as a subscript
C		by the dummy subroutine supplied to IFSSCN.
C	IFSTAT,  interface status (see section on error handling).
C	NERRS,   number of recoverable errors since interface was initialized.
C	LIMERR,  maximum tolerable of recoverable errors before program aborts.
C	KICK     abnormal event code (see section on error handling).
C
C***********************************************************************
C
	SUBROUTINE IFANGL(DEGR, STEPS)
C
C++++    INCLUDE 'COMMON.FTN'
      IMPLICIT INTEGER*2 (I-N)
      COMMON /IFCMN/ 
     & STPSIZ,     CANG,       ANGLE,      COUNTS,     CTIME,       
     & ISTEP,      IFSTAT,     NERRS,      LIMERR,     KICK
C----    INCLUDE 'COMMON.FTN'
CCC	STEPS = AINT( DEGR*STPSIZ + 0.5)
	STEPS = DEGR
	RETURN
	END
C=======================================================================
      SUBROUTINE CKANG(ANGLE,ANGNEW,IPUL1,IPUL2,IBAD)
C
C
C PROGRAMMER: C.L. MALLORY
C             ALFRED UNIVERSITY, ALFRED, NEW YORK  14802
C
C
C CHECKS THE VALUE OF ANGNEW TO BE SURE THAT IT IS AN INTEGRAL
C MULTIPLE OF THE STEP WIDTH GIVEN BY PPD.  IT ALSO GENERATES
C THE INTERFACE VALUES THAT WOULD CORRESPOND TO THE ANGNEW VALUE, SETS
C A FLAG (IBAD) AND PRINTS AN ERROR MESSAGE IF AN ERROR OCCURED.
C
C ARGUMENT DEFINITIONS:
C
C ANGLE - VARIABLE INDICATING THE CURRENT TWO-THETA POSITION.
C ANGNEW - VARIABLE INDICATING THE ANGLE TO BE MOVED TO FROM ANGLE.
C IPUL1 - THE TEN-THOUSANDS OF PULSES TO MOVE THE STEPPER.
C IPUL2 - THE REMAINING PULSES TO MOVE THE STEPPER TO GET TO ANGNEW
C         FROM ANGLE.
C IBAD - FLAG USED TO INDICATE:
C        +1 - ANGNEW WAS OUT OF RANGE OF ALIMLO AND ALIMHI.
C         0 - ANGNEW WAS WITHIN RANGE OF ALIMLO AND ALIMHI.
C
C
C LOCAL VARIABLE DEFINITIONS:
C
C PPD - PULSES PER DEGREE - NUMBER OF PULSES OF THE STEPPER MOTOR
C       NEEDED TO ADVANCE ONE DEGREE TWO-THETA.
C ALIMLO - LOWER TWO-THETA LIMIT OF THE GONIOMETER.
C ALIMHI - UPPER TWO-THETA LIMIT OF THE GONIOMETER.
C
C IF AN ERROR OCCURS ANGNEW IS SET EQUAL TO ANGLE.
C
C EXTERNAL SUBROUTINES REQUIRED:   NONE
C
C INITIALIZE VARIABLES.
C
	IMPLICIT INTEGER*2 (I-N)
      DATA PPD /400./
      DATA ALIMLO /3.5/
      DATA ALIMHI /153.0/
      IBAD = 0
C CHECK ANGNEW FOR A VALUE THAT IS MOD(PPD).
      TEMP = AINT(ANGNEW*PPD+0.5)
      IPUL1 = INT(TEMP/10000.)
      IPUL2 = INT(TEMP-IPUL1*10000.)
C      ANGNEW = FLOAT(IPUL1*10000.+IPUL2)/PPD
      ANGNEW = (IPUL1*10000.+IPUL2)/PPD
C IF ANGNEW IS INSIDE THE RANGE OF ALIMLO-ALIMHI GO ON.
C IF NOT PRINT AN ERROR AND SET RETURN VALUES.
      IF(ANGNEW.GE.ALIMLO.AND.ANGNEW.LE.ALIMHI) GO TO 1
      WRITE(7,3) ANGLE,ANGNEW
      IBAD = 1
      IPUL1 = 0
      IPUL2 = 0
      ANGNEW = ANGLE
      GO TO 2
C GENERATE PULSE VALUES FOR THE MOVE FROM ANGNEW TO ANGLE.
C THE ADDITIONAL 0.5 IS FOR ROUND OFF ERRORS.
1     TEMP = ABS(ANGNEW-ANGLE)*PPD+0.5
      IPUL1 = INT(TEMP/10000.)
      IPUL2 = INT(TEMP-IPUL1*10000.)
2     RETURN
3     FORMAT(X,' -- ERROR --  MOVE FROM',F9.4,' TO',F9.4,
     1 'REQUESTED. OUT OF RANGE.')
      END
C***********************************************************************
C
	SUBROUTINE IFCNT( TIMEL, COUNTL)
C
C++++    INCLUDE 'COMMON.FTN'
C======================================================================
C
C   VARIABLE DECLARATION AND COMMON BLOCKS
C
      IMPLICIT INTEGER*2 (I-N)
C
      COMMON /IO/ 
     & IRD,        ITYP,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
C
      COMMON /IFDATA/
     & BANGL,      EANGL,      SETANG,     
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,      
     & IFTYPE,     IFNAME(6)
	BYTE IFNAME
C
      COMMON /IFCMN/ 
     & STPSIZ,     CANG,       ANGLE,      COUNTS,     CTIME,       
     & ISTEP,      IFSTAT,     NERRS,      LIMERR,     KICK
C
C----    INCLUDE 'COMMON.FTN'
	IF(IBUG.NE.0) WRITE(IBUG,4) TIMEL, COUNTL
4	FORMAT(' >Count for',F6.2,' seconds or',F8.0,' counts.')
	KICK = 0
	IFSTAT = 4
C
	CALL SCATIM( COUNTS, TIMEL, CPS, IBAD)
	IF(IBAD.EQ.0) GOTO 9999
C
	IFSTAT = -4
	KICK = IBAD - 7
	CALL IFERR
C
9999	RETURN
	END
C=======================================================================
      SUBROUTINE SCATIM(COUNTS,TIME,CPS,IBAD)
C
C
C PROGRAMMER: C.L. MALLORY
C             ALFRED UNIVERSITY, ALFRED, NEW YORK  14802
C
C MODIFICATIONS:
C     JAN-85  JIM WALKER CHANGED CHARACTER VARIABLES TO BYTE FOR FORTRAN IV
C
C OPERATES THE SCALER-TIMER ON THE X-RAY INTERFACE.
C WILL COUNTE FOR THE GIVEN AMOUNT OF TIME AND RETRURNS
C THE COUNTS, THE TIME COUNTED FOR, AND THE CPS.
C
C
C ARGUMENT DEFINITIONS:
C
C COUNTS - THE ACCUMULATED COUNTS OVER THE TIME PERIOD 'TIME'.
C TIME - THE TIME (IN SECONDS) OVER WHICH TO COUNT.
C CPS - THE COUNT RATE IN COUNTS PER SECOND.
C IBAD - FLAG INDICATING STATUS OF THE CALL.
C         0 - NORMAL RETURN FROM THE CALL. NO ERRORS.
C        -1 - AN ERROR WAS ENCOUNTERED DURING THE RUN.
C             (EX. THE COMPUTER ATTENTION BUTTON WAS PUSHED.)
C
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE STRING(32),IFINI,IDONE
	DATA IFINI /')'/
C
      IBAD=0
      SUMC=0.0
      SUMT=0.0
C
C GENERATE THE TIME CODE FOR OUR INTERFACE.
      TEMP=TIME*100.
10    I2=INT(ALOG10(TEMP))
      I1=INT(TEMP/(10.**I2))
      TEMP=I1*10**I2
      SUMT=SUMT+TEMP/100.
C
C ISSUE THE DATA COLLECTION COMMAND TO THE INTERFACE.
      WRITE(20,1) I1,I2
      REWIND 20
C
C READ COMPLETION CHARACTER.
	NCHAR = 1
	CALL IFIN(NCHAR,STRING)
	IDONE=STRING(NCHAR)
C
C CHECK FOR AN ERROR.
      IF(IDONE.NE.IFINI) GO TO 30
C
C GET COUNTS FROM COUNTER.
	WRITE(20,3) 41
      REWIND 20
	NCHAR = 9
	CALL IFIN(NCHAR,STRING)
C	WRITE(7,1234)STRING
C1234	FORMAT(' DEBUG - SCATIM: POINT #1. :',32A1,':')
C	DO 1000, I=1,6
C1000	STRING(I) = STRING(I+1)
D	WRITE(7,1238)(STRING(I),ICHAR(STRING(I)),I=1,9)
D1238	FORMAT(32(':',A1,'-',I3),'.')
	IDONE=STRING(NCHAR)
C	READ(STRING,5) COUNTS
	DECODE(6,5,STRING(1)) COUNTS
D	WRITE(7,1236)COUNTS
D1236	FORMAT(' DEBUG - SCATIM: RAW COUNTS= ',F7.0)
C	WRITE(7,1237)IDONE,ICHAR(IDONE),IFINI,ICHAR(IFINI)
C1237	FORMAT(' DEBUG - SCATIM: STRING VALUES',/,32(X,':',A1,':',I3))
	BAD = -2
      IF(IDONE.NE.IFINI) RETURN
	BAD = 0
C
C CHECK FOR AN OVERFLOW CONDITION.
      IF(COUNTS.LT.90000.0) GO TO 20
C
C OVERFLOW OCCURED.  GET TIME OF THE COUNT.
	WRITE(20,3) 42
      REWIND 20
	NCHAR = 9
	CALL IFIN(NCHAR,STRING)
	DECODE(7,4,STRING) TIM
      SUMC=SUMC+COUNTS
      SUMT=SUMT+(TIM-TEMP)/100.
      TEMP=TEMP-TIM
      IF(TEMP.GT.0.0) GO TO 10
C
20    COUNTS=COUNTS+SUMC
      CPS=COUNTS/SUMT
	WRITE(7,1235)CPS
1235	FORMAT(' DEBUG - SCATIM: COUNTS PER SEC.= ',F7.0)
      GO TO 40
C
30    IBAD=-1
40    RETURN
1     FORMAT(' D4195+42',2I1,'*')
2     FORMAT(A1)
3     FORMAT(' R',I2,'*')
4     FORMAT(F6.0,A1)
5	FORMAT(F6.0)
6	FORMAT(A1)
      END
C**********************************************************************
C
	SUBROUTINE IFEXIT
C
C	SHUT DOWN THE DIFFRACTOMETER
C	MOVE TO A CONVIENIENT ANGLE AND WAIT UNTIL SAMPLE IS LOADED.
C
C	If there is an automatic sample changer this is the place to
C	control it.
C
C++++    INCLUDE 'COMMON.FTN'
C======================================================================
C
C   VARIABLE DECLARATION AND COMMON BLOCKS
C
      IMPLICIT INTEGER*2 (I-N)
C
      COMMON /IO/ 
     & IRD,        ITYP,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
C
      COMMON /IFDATA/
     & BANGL,      EANGL,      SETANG,     
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,      
     & IFTYPE,     IFNAME(6)
	BYTE IFNAME
C
      COMMON /IFCMN/ 
     & STPSIZ,     CANG,       ANGLE,      COUNTS,     CTIME,       
     & ISTEP,      IFSTAT,     NERRS,      LIMERR,     KICK
C
C----    INCLUDE 'COMMON.FTN'
C Uses ITYP, IF1, IFSTAT, KICK & SETANG
C Calls IFMOVE.
C
C======================================================================
C
C  Wait for sample to be loaded.
100	WRITE(ITYP,104)
104	FORMAT(' Close shutter and remove sample.')
C
C  Don't shut down interface if it was never initialized.
	IF(IFSTAT.EQ.0) GOTO 9999
C
C  Move to a nice angle.
	CALL IFMOVE( SETANG, 0.0)
C
C  Wait until sample is unloaded
	WRITE(ITYP,114)
114	FORMAT(' Press return when done: ',$)
	READ(IRD,124,END=9999) JUNK
124	FORMAT(A1)
C
C  Move to 90 degrees so the detector won't get bumped.
	CALL IFANGL( 90.0, ANGL)
	CALL IFMOVE( ANGL, 0.0)
C
C  The system will close the unit to the interface.
C
C  Interface status is "no sample loaded"
	IF(IFSTAT.GT.0) IFSTAT = +1
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		RT11 DEVICE DATA INPUT ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE READS DATA FROM THE GIVEN I/O LINE
C	   WITH IMMEDIATE RETURN IF THE DATA IS NOT READY OR A
C	   WAIT UNTIL IT BECOMES AVAILABLE.  ANY LENGTH DATA STRING
C	   MAY BE INPUT.  INPUT CAN BE CAUSED TO TERMINATE ON
C	   A COMPLETION CHARACTER, THE NUMBER OF CHARACTERS OR
C	   AN ERROR CHARACTER.
C
C
C		THE PASSED PARAMETERS ARE DEFINED AS FOLLOWS:
C
C	IUNIT:	DEVICE NUMBER TO WHICH THE DATA IS TO BE SENT
C
C	IODATA:	AN ADJUSTABLE LENGTH ARRAY OF DATA TO BE INPUT
C
C	NUMBER:	THE NUMBER OF CHARACTERS TO INPUT, ALSO USED TO
C		DEFINE THE LENGTH OF THE ARRAY 'IODATA', THEREFORE,
C		THIS VARIABLE MAY NOT BE MODIFIED UNDER FORTRAN IV
C		VERSION 02.
C
C	IFLAG:	ON CALL IT IS A MODE FLAG MEANING:
C
C			0 = DO NOT WAIT FOR A TERMINATING CHARACTER
C			    'LASTCH' OR 'NUMBER' OF CHARACTERS IF 
C			    THEY ARE NOT AVAILABLE
C			1 = WAIT UNTIL NO MORE CHARACTERS ARE
C			    BEING RECIEVED ('NULLMAX' NULLS RECEIVED)
C			    OR 'NUMBER' OF CHARACTERS HAVE BEEN
C			    INPUT, THEN RETURN
C			2 = TERMINATE ON A TERMINATING CHARACTER
C			    OR WHEN 'NUMBER' CHARACTERS HAVE BEEN
C			    RECEIVED
C			3 = RETURN WHEN 'NUMBER' OF CHARACTERS HAVE
C			    BEEN RECEIVED, WAIT AS LONG AS NECESSARY
C
C		FOR ADC IF NUMCHR IS NEGITIVE, DON'T WAIT.
C			IF NUMCHR IS POSITIVE, WAIT.
C
C		ALL CALLS RETURN IMMEDIATELY ON RECEIVING AN
C	   ERROR CHARACTER.
C
C		ON RETURN IT RETURNS AN ERROR VALUE AS FOLLOWS:
C
C			0 = RETURNED BECAUSE 'NUMBER' WAS ZERO
C			1 = NO INPUT AVAILABLE (OR ENDED ON
C			    'NULMAX' WITH NO CHARACTERS INPUT)
C			2 = UNIT NOT ATTACHED
C			3 = NONEXISTENT UNIT NUMBER
C			4 = ERROR CHARACTER RECEIVED
C		    NEG # = NEGITIVE OF THE NUMBER OF CHARACTERS
C			    RECEIVED
C
C
C	FOR FURTHER REFERENCE CONSULT SECTION '3.79 MTIN' IN THE
C   PROGRAMMERS REFERENCE MANUAL.
C
C	>> NOTE <<	THIS ROUTINE CONTAINS CODING SPECIFIC TO
C		    THE IDIOSYNCRASIES OF THE CANBERRA INTERFACE.
C		    SEE THE MARKED SECTION BELOW.
C
C***********************************************************************
C
C	PROGRAMMER:
C
C		DALE C. EARL
C		ALFRED UNIVERSITY
C		ALFRED, NY  14802
C		82/11/09
C
C	MODIFICATIONS:
C	   JAN-85 JIM WALKER REMOVED BLOCK IF FOR FORTRAN IV
C
C***********************************************************************
C
C	SYSTEM:
C
C	RUNS UNDER RSX, FORTRAN IV 
C
C***********************************************************************
C***********************************************************************
C
C	SUBROUTINE IFINP(IUNIT,IODATA,NUMCHR,IFLAG)
C ADC MODIFICATION
	SUBROUTINE IFIN(NUMCHR,IODATA)
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	IMPLICIT INTEGER*2 (I-N)
C
 	DIMENSION IOSB(2), IPARAM(6)
	BYTE IODATA(32)
C
C  CONSTANTS AND TEMPORARY VARIABLES
C
	BYTE ICHR
C
C  TERMINATION CONSTANTS
C
	BYTE LASTCH, ERRCHR, NULL
	DATA LASTCH /')'/
	DATA ERRCHR /'/'/
	DATA NULL /0/
	NULMAX = 10
C
	IZERO  = 0
	IONE   = 1
	ITWO   = 2
	ITHREE = 3
	ITRY   = 0
	IGOT   = 0
	IWAIT  = 0
	IPOINT = 0
	ICOUNT = 0	
C
C	RSX VERSION CALL SET UP.  SEE APPENDIX B-10 OF THE I/O
C	DRIVERS MANUAL.
C
	IREAD = 536
	IKILL = 10
	CALL GETADR (IPARAM(1) , IODATA(1))	
	IPARAM(2) = IABS(NUMCHR)
C  ADC DEFINITIONS
	IUNIT = 20
	IFLAG = 2
	IF (NUMCHR.GE.0) GOTO 510
		NUMCHR = -NUMCHR
		IFLAG = 0
510		CONTINUE
C
C***********************************************************************
C
D	WRITE(5,222)
D222	FORMAT(' >> DEBUG0 <<  IFIN ENTRY.')
C
C***********************************************************************
C
C  SAVE THE WAIT STATE
C
	IWAIT = IFLAG
C
C***********************************************************************
C
C  MAKE SURE WE HAVE NO FALSE ERRORS
C
	IFLAG = IZERO
C
C***********************************************************************
C
C  QUIT IF WE ARE TOLD TO READ ZERO CHARACTERS
C
	IF (NUMCHR.EQ.IZERO) GOTO 9999
C
C***********************************************************************
C			RSX VERSION
C-----------------------------------------------------------------------
C
C	THE RSX VERSION IS SUBSTANTIALLY DIFFERENT FROM THE RT-11 
C  VERSION DUE TO THE MULTI-USER EVIRONMENT.  THIS VERSION 
C  WILL MAKE A CALL AND WAIT FOR A CERTAIN TIME UNTIL EITHER 
C  THE NUMBER OF CHARACERS IS RECIEVED OR THE LOOP HAS FINISHED.
C
C***********************************************************************
C
C	START LOOP AND INITIALIZE THE CHARACTER ARRAY.
C  MAKE A CALL, EITHER WITH OR WITHOUT A WAIT, DEPENDING ON 
C  THE MODE PASSED TO IT
C
	DO 110 I = 1,NUMCHR
110	IODATA(I) = NULL
C
	IF ( IWAIT .NE. 0 ) GOTO 530
C
C  ATTEMPT TO INPUT NUMCHR CHARACTER BUT DON'T WAIT IF THEY AREN'T
C  AVAILABLE.
C
300		CALL QIO (IREAD,IUNIT,1,,IOSB,IPARAM,)
C
C  DELAY FOR A TIME
C
		CALL WAIT(10,1)
C
C  IF READ NOT COMPLETED THEN KILL IT
C
		IF (IOSB(1) .NE. 0 ) GOTO 520
			CALL WTQIO(IKILL,IUNIT,1)
C
CD			WRITE(5,115)
CD115			FORMAT(' >> DEBUG0 <<  IFINP - ',
CD    1			'NO WAIT QIO ABORTED.')
C
520			CONTINUE
C
D		WRITE(5,130) (IODATA(K),K=1,NUMCHR)
D130		FORMAT(' >> DEBUG0 <<  IFINP - NO WAIT, IODATA: ',255A1)
C
530		CONTINUE			! INPUT WITHOUT WAIT
C
C***********************************************************************
C
C  WAIT FOR NUMCHR CHARACTERS UNLESS ERROR CHR RETURNED
C
	IF ( IWAIT .NE. 2 ) GOTO 560
C
C***********************************************************************
C
C  ISSUE A NONWAIT QIO SO WE CAN TEST FOR ERROR CHARACTERS
C
		CALL QIO (IREAD,IUNIT,1,0,IOSB,IPARAM,0)	
D		WRITE(7,531) IOSB, IPARAM(1),IPARAM(2)
D531		FORMAT(' IOSB (2O7)=',2O7,' IPAR=(2O7)',2O7)
C
		ICOUNT = 0
100		CALL WAIT(100,1)
C
C  CHECK TO SEE IF THE NUMBER OF CHARACTERS REQUESTED HAS
C  BEEN RECIEVED (INCLUDING NULLS).  IF THEY HAVE NOT THEN HAS
C  THERE BEEN A TERMINATING CHARACTER.
C
		DO 200 J = ICOUNT + 1,NUMCHR
		ICHR = IODATA(J)
		IF (ICHR.LT.0) ICHR = ICHR + 128
		IF (ICHR .EQ. NULL) GOTO 550
			ICOUNT = J
C
C  IF WE RECIEVE A FINAL CHARACTER THEN KILL THE QIO IF WE HAVEN'T
C  RECEIVED NUMCHR CHARACTERS.
C
			IF (ICHR .NE. LASTCH) GOTO 540
				IF (ICOUNT.LT.NUMCHR)
     1				CALL WTQIO(IKILL,IUNIT,1)
				GOTO 410
540				CONTINUE
			IF (ICHR .EQ. ERRCHR) GOTO 9000
550			CONTINUE
200		CONTINUE
C
C  IF WE DID NOT RECIEVE THE REQUIRED NUMBER OF CHARACTERS REPEAT IT
C
CD		WRITE(5,111) (IODATA(K),K=1,NUMCHR)
		IF (ICOUNT .LT. NUMCHR) GOTO 100
C
410		CONTINUE
D		WRITE(5,111) (IODATA(K),K=1,NUMCHR)
D111		FORMAT(' >> DEBUG0 <<  IFINP - IODATA WITH WAIT ',255A1)
C
560		CONTINUE			! INPUT WITH WAIT
C
C***********************************************************************
C
	IF ((IWAIT.NE.0).AND.(IWAIT.NE.2)) GOTO 9000
C
C	THIS BLOCK REMOVES NULL CHARACTERS AND CLEARS BIT EIGHT
C
CD	WRITE(5,112) 'WITH',(IODATA(K),K=1,NUMCHR)
CD112	FORMAT(' >> DEBUG0 <<  IFINP - IODATA ',A7,' NULLS = ',
CD    1	20(':',A1),':')
CD	WRITE(5,114) (IODATA(K),K=1,NUMCHR)
CD114	FORMAT(X,20I4)
C
	NULFLG = 1
C
	DO 700 I=1,NUMCHR
	IF (IODATA(I).LT.0) IODATA(I) = IODATA(I) + 128
C
	IF (IODATA(I) .EQ. NULL) GOTO 580
		IF (I .EQ. NULFLG) GOTO 570
			IODATA(NULFLG) = IODATA(I)
			IODATA(I) = NULL
570			CONTINUE
		NULFLG = NULFLG + 1
580		CONTINUE
CD	WRITE(5,113) NULFLG, (IODATA(K),K=1,NUMCHR)
CD113	FORMAT(' >> DEBUG0 <<  IFINP - NULFLG, IODATA = ',
CD    1	I3,20(':',A1),':')
700	CONTINUE
C
CD	WRITE(5,112) 'WITHOUT',(IODATA(K),K=1,NUMCHR)
CD	WRITE(5,114) (IODATA(K),K=1,NUMCHR)
C
	IFLAG = -(NULFLG + 1)
	GOTO 9999
C
C***********************************************************************
C
C	INTERFACE ERROR CHARACTER RECIEVED SET IFLAG
C
9000	IFLAG = 4
	CALL WTQIO (IKILL,IUNIT,1)
C
C***********************************************************************
C
C  WELL, I'VE HAD ENOUGH OF THIS.  HOW ABOUT YOU ?
C
C
9999	RETURN
	END
C***********************************************************************
C
	SUBROUTINE IFINIT(IQUIT)
C
C++++    INCLUDE 'COMMON.FTN'
C======================================================================
C
C   VARIABLE DECLARATION AND COMMON BLOCKS
C
      IMPLICIT INTEGER*2 (I-N)
C
      COMMON /IO/ 
     & IRD,        ITYP,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
C
      COMMON /IFDATA/
     & BANGL,      EANGL,      SETANG,     
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,      
     & IFTYPE,     IFNAME(6)
	BYTE IFNAME
C
      COMMON /IFCMN/ 
     & STPSIZ,     CANG,       ANGLE,      COUNTS,     CTIME,       
     & ISTEP,      IFSTAT,     NERRS,      LIMERR,     KICK
C
C----    INCLUDE 'COMMON.FTN'
	DATA BANGL, EANGL /3.5,153./ SETANG /45./
	DATA SPINTE, SPSLEW, SPSTEP / 10., 60., 20./ DELAY /1.0/
	DATA IFTYPE /'C'/ IFNAME /'P','H','L','0',' ',' '/
	DATA STPSIZ /1.0/ ANGLE,COUNTS,CTIME / 3 * 10./
	DATA ISTEP, IFSTAT, NERRS /3 * 0/ LIMERR /20/ KICK /0/
	IQUIT = 0
	CALL INIT(CANG)
	IF(CANG.LT.0.0) IQUIT = 1
	IFSTAT = 1
	KICK = 0
	RETURN
	END
C=======================================================================
	SUBROUTINE INIT(ANGLE)
C
C
C PROGRAMMER: C.L. MALLORY
C             ALFRED UNIVERSITY, ALFRED, NEW YORK  14802
C
C MODIFICATIONS:
C     JAN-85  JIM WALKER CHANGED CHARACTER VARIABLES TO BYTE FOR FORTRAN IV
C
C
C
C INITIALIZES THE X-RAY COMPUTER INTERFACE AND THE AXIS POSITIONER
C FOR THE CURRENT TWO-THETA READING.
C
C ARGUMENT DEFINITION:
C
C ANGLE - RETURNED VALUE FOR THE CURRENT TWO-THETA POSITION OF THE GONIOMETER.
C
C
C LOCAL VARIABLE DEFINITIONS:
C
C IFINI - A COMPLETION CHARACTER IS SENT BY THE INTERFACE TO
C         SIGNIFY THE COMPLETION OF THE DESIRED COMMAND.
C         A ')' SIGNIFIES A SUCESSFUL COMPLETION WHEREAS
C         A '/' SIGNIFIES THAT SOMETHING WENT WRONG AND AN ERROR
C         HAS OCCURED.  A COMPLETION CHARACTER IS NOT SENT AFTER
C         EVERY COMMAND TO THE INTERFACE, CHECK MANUAL FOR DETAILS.
C PPD - THE NUMBER OF MOTOR PULSES REQUIRED TO MOVE THE TWO-THETA
C       VALUE BY ONE DEGREE.
C IPUL1 - TEN-THOUSANDS OF MOTOR PULSES REPRESENTING ANGLE.
C IPUL2 - REMAINING PULSES TO DEFINE ANGLE.
C         ACTUAL READINGS FROM THE AXIS POSITIONER DISPLAY.
C IBAD - FLAG INDICATING:
C        +1 - ANGLE IS OUT OF RANGE OF THE DIFFRACTOMETERS MOVEMENT.
C         0 - ANGLE IS WITHIN RANGE.
C
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE STRING(32),IFINI,IDONE
	DATA IFINI /')'/
	DATA PPD /400./
C GET CURRENT ANGLE OF GOINIOMETER.
1	WRITE(7,2)
	READ(5,3,END=9000) ANGLE
C CHECK ANGLE FOR LEGAL VALUES (EX. INTEGRAL MULTIPLE OF SMALLEST STEP).
D	WRITE(7,810)
D810	FORMAT(' Checking angle')
	CALL CKANG(ANGLE,ANGLE,IPUL1,IPUL2,IBAD)
	IF(IBAD.GT.0) GO TO 1
C GENERATE VALUES TO BE SENT TO THE AXIS POSITIONER.
C REGENERATE ANGLE FROM AXIS POSITIONER READING.
C THESE STEPS ARE NECESSARY TO AVOID ROUND-OFF ERROR IN CALCULATING
C THE ANGLE VALUE.
	A = ANGLE*PPD
	IPUL1 = INT(A/10000.)
	IPUL2 = INT(A-IPUL1*10000.)
C	ANGLE = FLOAT(IPUL1*10000.+IPUL2)/PPD
	ANGLE = (IPUL1*10000.+IPUL2)/PPD
D	WRITE(7,820) ANGLE
D820	FORMAT(' Angle rounded off is',F7.2)
C
C ATTACH THE TERMINAL
	CALL QIO( "1400 , 20)
CD	WRITE(7,830)
CD830	FORMAT(' Terminal is attached.')
C
C ISSUE THE RESET,START AND INITIALIZE AXIS POSITIONER COMMAND
C TO THE INTERFACE UNIT.  I/O LOGICAL UNIT NUMBER 20 WILL BE USED FOR
C THE INTERFACE COMMUNICATIONS IN ALL THESE ROUTINES.  THE REWIND FORCES
C THE RT-11 OPERATING SYSTEM TO TRANSMIT THE BUFFERS IN EITHER
C DIRECTION (I/O) WHEN REQUESTED.
	ENCODE(5,6,STRING) IPUL1, IPUL2
	DO 510, I=1,5
510	IF(STRING(I).EQ.' ') STRING(I)='0'
	WRITE(20,4) (STRING(I),I=1,5)
	REWIND 20
D	WRITE(7,850)
D850	FORMAT(' Initialization code dispatched, waiting completion')
C READ THE COMPLETION CHARACTER FROM THE INTERFACE. IF AN ERROR OCCURED
C GO BACK AND TRY AGAIN.
C	READ(20,5) IDONE
C	REWIND 20
	NCHAR = 1
	CALL IFIN(NCHAR,STRING)
	IDONE=STRING(NCHAR)
D	WRITE(7,860) IDONE,IFINI
D860	FORMAT(' Code returned from interface is ',A1,' Expected ',A1)
	IF(IDONE.NE.IFINI) GO TO 1
	RETURN
2	FORMAT('$ENTER CURRENT TWO-THETA POSITION: ')
3	FORMAT(F10.5)
4	FORMAT(5X,'$!P11??',5A1,'*')
5	FORMAT(A1)
6	FORMAT(I1,I4)
9000	ANGLE = -1.0
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE IFINTE( BANG, EANG, SPEED)
C
C	INTEGRATE OVER THE RANGE BANG TO EANG AT SPEED
C
C	THIS ROUTINE CALLS IFMOVE, IFCNT, IFBCNT, IFECNT & FANG
C
C======================================================================
C
C++++    INCLUDE 'COMMON.FTN'
C======================================================================
C
C   VARIABLE DECLARATION AND COMMON BLOCKS
C
      IMPLICIT INTEGER*2 (I-N)
C
      COMMON /IO/ 
     & IRD,        ITYP,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
C
      COMMON /IFDATA/
     & BANGL,      EANGL,      SETANG,     
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,      
     & IFTYPE,     IFNAME(6)
	BYTE IFNAME
C
      COMMON /IFCMN/ 
     & STPSIZ,     CANG,       ANGLE,      COUNTS,     CTIME,       
     & ISTEP,      IFSTAT,     NERRS,      LIMERR,     KICK
C
C----    INCLUDE 'COMMON.FTN'
C
C======================================================================
C
C   Assume scan will be sucessful.
	KICK = 0
C
C======================================================================
C
C	INTEGRATE OVER A RANGE AND RETURN ONE VALUE FOR COUNTS
C
	IF(IBUG.NE.0) WRITE(IBUG,4) BANG*STPSIZ,EANG*STPSIZ,SPEED
4	FORMAT(' > INTEGRATE FROM',F8.3,' TO',F8.3,' AT',F8.3)
C
C   Clear old time so it won't show up in an error message
3000	TIME = 0.0
C
C   Are we doing something reasonable?
	IF(EANG.LE.BANG) GOTO 9000
C
C   Move to starting angle.
	CALL IFMOVE( BANG, 0.)
	IF(IFSTAT.LT.0) GOTO 9999
C
	DPM = SPEED
	IF(DPM.EQ.0.) DPM = SPINTE
	CALL ISCAN( CANG, EANG, DPM, IBAD, COUNTS, CTIME)
	IF(IBAD.NE.0) GOTO 9200
C
C   All done with integrated count.  
C
	IFSTAT = 6
	GOTO 9999
C
C
C======================================================================
C
C	ABNORMAL RETURNS
C
C   Invalid call parameters: neg # points or neg time.  Return error.
9000	WRITE(IERR,9004) BANG*STPSIZ, EANG*STPSIZ, 
     &    DANG*STPSIZ, TIME
9004	FORMAT(' INVALID CALL IFINTE:',3F9.4,F7.2)
	IFSTAT = -6
	KICK = -1
	CALL IFERR
	GOTO 9999
C
C   Error in integrate scan
9200	WRITE(IERR,9204) BANG*STPSIZ, EANG*STPSIZ
9204	FORMAT(' WHILE TRYING TO TO INTEGRATE SCAN FROM',
     &    F9.4,' TO',F9.4)
	IFSTAT = -6
	KICK = -9
	CALL IFERR
	GOTO 9999
C
C======================================================================
C
C	FINAL RETURN
C
9999	RETURN
	END
C=======================================================================
C
	SUBROUTINE ISCAN(ANGLE,ANGNEW,DPM,IBAD,COUNTS,TIME)
C
C
C PROGRAMMER: C.L. MALLORY
C             ALFRED UNIVERSITY, ALFRED, NEW YORK 14802
C
C MODIFICATIONS:
C    JAN-85  JIM WALKER CHANGED CHARACTER VARIABLES TO BYTE FORTRAN IV
C	SEP-85 J.W. PUT UNIT NUBERS IN COMMON /IO/
C
C PERFORMS AN INTEGRATE SCAN FROM THE CURRENT TWO-THETA TO THE
C NEW ANGLE AT A RATE GIVEN BY DPM.  THE RESULTS OF THE SCAN ARE
C RETURN IN COUNTS AND TIME.  IF AN ERROR OCCURED DURING THE
C SCAN THEN THE VALUE OF THE FLAG IBAD REFLECTS THE CONDITION.
C
C
C ARGUMENT DEFINITIONS:
C
C ANGLE - CURRENT TWO-THETA POSITION OF THE GONIOMETER.
C ANGNEW - THE ANGLE TO MOVE TO FROM ANGLE.
C DPM - SPEED OF THE MOVE IN DEGREES PER MINUTE.
C IBAD - STATUS FLAG INDICATING CALL PERFORMANCE.
C        +1 - ANGNEW WAS OUTSIDE THE RANGE OF ALIMLO - ALIMHI.
C         0 - NORMAL RETURNED VALUE WITH NO ERRORS DETECTED.
C        -1 - ERROR OCCURED IN PROCESSING THE ISCAN COMMAND.
C             (EX. ENCOUNTERING A HARDWARE LIMIT SWITCH.)
C COUNTS - THE ACCUMULATED COUNTS DURING THE INTEGRATE SCAN.
C TIME - THE AMOUNT OF TIME REQUIRED TO PERFORM THE SCAN.
C
C EXTERNAL SUBROUTINES REQUIRED:
C       CKANG,  IFIN,  ISCODE
C
C
	IMPLICIT INTEGER*2 (I-N)
      COMMON /IO/ 
     & IRD,        ITYP,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
	BYTE STRING(32),IFINI,IDONE,IZERO
	DATA IFINI /')'/ IZERO /'0'/
	DATA PPD/400./
C CHECK ANGNEW FOR LEGAL ANGLE VALUE.
	CALL CKANG(ANGLE,ANGNEW,IPUL1,IPUL2,IBAD)
C IF BAD OR IF EQUAL TO ANGLE THEN JUST RETURN.
	IF(IBAD.GT.0.OR.ANGLE.EQ.ANGNEW) GO TO 2
C GENERATE SPEED CODE FOR OUR INTERFACE FROM DPM.
	ISPEED=ISCODE(DPM)
C SET SUM VALUES TO ZERO. REQUIRED IN CASE OF AN OVERFLOW.
	SUMC=0.0
	SUMT=0.0
C GENERATE DIRECTION CODE FOR OUR INTERFACE FROM THE ANGLES.
C IDIR = 1 FOR POSITIVE DIRICTION MOVEMENT AND
C        0 FOR NEGATIVE DIRECTION MOVEMENT.
 1	IDIR=1
	IF(ANGLE.GT.ANGNEW) IDIR=0
C ISSUE THE INTEGRATE SCAN COMMAND TO INTERFACE.
	ENCODE(25,4,STRING) ISPEED,IDIR,IPUL1,IPUL2
 4	FORMAT(' $!W4195+4295*I11',3I1,I4,'*')
C Make sure leading zeros don't turn into spaces.
	DO 10, II=20,25
	 IF(STRING(II).EQ.' ') STRING(II) = IZERO
10	CONTINUE
	WRITE(IF1,14) (STRING(II),II=1,25)
14	FORMAT(X,25A1)
D	IF(IBUG.NE.0) WRITE(IBUG,14) (STRING(II),II=1,25)
	REWIND IF1
C READ COMPLETION CHARACTER.
C	READ(IF1,5) IDONE
C 5	FORMAT(A1)
C	REWIND IF1
	NCHAR = 1
	CALL IFIN(NCHAR,STRING)
D	IF(IBUG.NE.0) WRITE(IBUG,94) NCHAR,(STRING(IX),IX=1,32)
D94	FORMAT(' Answer: NCHAR=',I2,3X,32(':',A1),':')
	IDONE=STRING(NCHAR)
C SUSPEND ALL UNITS ON THE INTERFACE FOR READOUT. NECESSARY BECAUSE
C IF THEY ARE NOT HALTED THEY CONTINUE TO OPERATE UNTIL STOPPED.
C NO COMPLETION CHARACTER IS SENT BACK AFTER THIS INSTRUCTION.
	WRITE(IF1,6)
D	IF(IBUG.NE.0) WRITE(IBUG,6)
 6	FORMAT(' X110*X410*X420*')
	REWIND IF1
C CHECK FOR AN ERROR.
	IF(IDONE.NE.IFINI) GO TO 2
C GET PARAMETERS ABOUT THE LAST CYCLE.
	WRITE(IF1,7)
D	IF(IBUG.NE.0) WRITE(IBUG,7)
 7	FORMAT(' R*')
	REWIND IF1
C	READ(IF1,8) ANGLE,COUNTS,TIME,IDONE
C	REWIND IF1
	NCHAR = 32 ! $$ change back to 21.
	CALL IFIN(NCHAR,STRING)
D	IF(IBUG.NE.0) WRITE(IBUG,94) NCHAR,(STRING(IX),IX=1,32)
C CONVERT STRING TO VALUES
C	READ(STRING,8)ANGLE,COUNTS,TIME,IDONE
	DECODE(21,8,STRING) ANGLE,COUNTS,TIME,IDONE
 8	FORMAT(F5.0,1X,F6.0,1X,F6.2,1X,A1)
	IF(IDONE.NE.IFINI) GO TO 2
	SUMC=SUMC+COUNTS
	SUMT=SUMT+TIME
	ANGLE=ANGLE/PPD
	CALL CKANG(ANGLE,ANGNEW,IPUL1,IPUL2,IBAD)
C	IF(IBAD.NE.IFINI) GO TO 2
	IF(IBAD.NE.0) GO TO 2
C CHECK TO SEE IF SPAN IS COMPLETE.
	IF(IPUL1+IPUL2.NE.0) GO TO 1
C UPDATE THE COUNTS AND TIME.
	COUNTS=SUMC
	TIME=SUMT
	GO TO 3
 2	IBAD=-1
C RESET THE INTERFACE.
 3	WRITE(IF1,9)
D	IF(IBUG.NE.0) WRITE(IBUG,9)
 9	FORMAT('  $!')
	REWIND IF1
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE IFLOAD( IQUIT)
C
C	MOVE TO A CONVIENIENT ANGLE AND WAIT UNTIL SAMPLE IS LOADED.
C	INITIALIZE INTERFACE IF NECESSARY
C
C	Sample will be unloaded by IFEXIT.
C
C	If there is an automatic sample changer this is the place to
C	control it.
C
C++++    INCLUDE 'COMMON.FTN'
C======================================================================
C
C   VARIABLE DECLARATION AND COMMON BLOCKS
C
      IMPLICIT INTEGER*2 (I-N)
C
      COMMON /IO/ 
     & IRD,        ITYP,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
C
      COMMON /ARRAY/
     & CNT(50),    ICOUNT
C
      COMMON /PKCMN/
     & MPEAK,      PANG(20),   PKTIM(20),  BKGTIM(20), 
     & IPKFND(20), LPEAK(20)
	LOGICAL LPEAK
C
      COMMON /RUN/
     & CONC,       SCONC,      NREC,       IPEAK,      NPEAK,
     & IREP,       NREP,       MOUNT,      NMOUNT
C
      COMMON /RUN2/
     & TITLE(20),  USER(5),    NMRUN(40),  NMRAW(40),  IFLAG(4)
	BYTE NMRUN, NMRAW
C
      COMMON /TIME/
     & ITIM(3),    IDAT(3),    ISTIM(5),   IENTIM(5)
C
      COMMON /IFDATA/
     & BANGL,      EANGL,      SETANG,     
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,      
     & IFTYPE,     IFNAME(6)
	BYTE IFNAME
C
      COMMON /IFCMN/ 
     & STPSIZ,     CANG,       ANGLE,      COUNTS,     CTIME,       
     & ISTEP,      IFSTAT,     NERRS,      LIMERR,     KICK
C
C----    INCLUDE 'COMMON.FTN'
C Uses IRD, ITYP, ITIM, IDAT, IFSTAT & SETANG
C Calls IFINIT, IFMOVE & SYTIME
C
C======================================================================
C
C  Initialize interface if necessary.
	IF( IFSTAT.LE.0) CALL IFINIT( IQUIT)
	IF( IFSTAT.LE.0) GOTO 9500
C
C  Move to a nice angle.
	CALL IFMOVE( SETANG, 0.0)
C
C  Wait for sample to be loaded.
100	WRITE(ITYP,104)
104	FORMAT(' Load sample, open shutter then press ',/,
     &   ' S to Start or E,I,D,M,? for other options :',$)
C
C  Read answer.
	READ(IRD,204,END=9500) IANS
204	FORMAT(A1)
C
C  Lots of valid responses (See format statement below)
	IF( IANS.EQ.'S' .OR. IANS.EQ.'s' .OR. 
     &    IANS.EQ.'R' .OR. IANS.EQ.'r') GOTO 1000
	IF( IANS.EQ.'E' .OR. IANS.EQ.'e' .OR. 
     &    IANS.EQ.'X' .OR. IANS.EQ.'x') GOTO 9500
	IF( IANS.EQ.'I' .OR. IANS.EQ.'i') GOTO 2000
	IF( IANS.EQ.'D' .OR. IANS.EQ.'d') GOTO 3000
	IF( IANS.EQ.'M' .OR. IANS.EQ.'m') GOTO 4000
	IF( IANG.EQ.'^') GOTO 5000
C
C  Response wasn't one of the standard so print the valid responses.
	WRITE(ITYP,254)
254	FORMAT(' If you don''t want to push S or E you might try',/,
     &   ' R for Ready (same as S for Start)',/,
     &   ' X to eXit, A to Abort, E to Exit (all the same as ^Z)',/,
     &   ' If you really want to get  fancy you might even try',/,
     &   ' I to Initialize the interface again',/,
     &   ' D for Debug or',/,
     &   ' M for Move.')
	GOTO 100
C
C   Ready to go.
1000	IQUIT = 0
	GOTO 9999
C
C  "I" means initialize the interface again.
2000	CALL IFINIT
	GOTO 100
C
C "D" means set debug flags
3000	CALL DEBUG
	GOTO 100
C
C "M" means move to another angle
4000	WRITE(ITYP,4004)
4004	FORMAT(' Enter angle to move to: (F8.3) ?',$)
	READ(IRD,4014) TANGD
4014	FORMAT(F8.3)
	IF(TANGD.EQ.0.0) GOTO 100
	CALL IFANGL(TANGD, TANG)
	CALL IFMOVE(TANG, 0.0)
	GOTO 100
C
C
5000	WRITE(ITYP,5004)
5004	FORMAT(' OOPS.  Let me explain something.',/,
     &   ' Usually the ^ character is used to represent the control',/,
     &   ' key.  ^Z means hold down CTRL (or CONT) and hit Z.')
C
C   Run aborted
9500	IQUIT = 1
	WRITE(ITYP,9504)
9504	FORMAT(' RUN CANCELED.')
C
C  Note that next call ifmove should look to see if X-rays are on.
9999	IFSTAT = +2
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE IFMOVE( TANG, SPEED)
C
C++++    INCLUDE 'COMMON.FTN'
C======================================================================
C
C   VARIABLE DECLARATION AND COMMON BLOCKS
C
      IMPLICIT INTEGER*2 (I-N)
C
      COMMON /IO/ 
     & IRD,        ITYP,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
C
      COMMON /IFDATA/
     & BANGL,      EANGL,      SETANG,     
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,      
     & IFTYPE,     IFNAME(6)
	BYTE IFNAME
C
      COMMON /IFCMN/ 
     & STPSIZ,     CANG,       ANGLE,      COUNTS,     CTIME,       
     & ISTEP,      IFSTAT,     NERRS,      LIMERR,     KICK
C
C----    INCLUDE 'COMMON.FTN'
C
	KICK = 0
	IFSTAT = 3
C
	IF(IBUG.NE.0) WRITE(IBUG,4) TANG*STPSIZ, RATE
4	FORMAT(' >Move to',F8.4,' at',F8.4,' degrees/minute')
	DPM = SPEED
	IF(DPM.EQ.0.0) DPM = SPSLEW
	IF(TANG.GE.CANG) GOTO 100
C
C  When moving down, overshoot by half a degree then come back
C  to take up gear backlash
	TANG1 = TANG - (0.5 / STPSIZ)
	CALL POSIT(CANG, TANG1, DPM, IBAD)
	IF(IBAD.NE.0) GOTO 9000
C
C  Now move to final angle.
100	CALL POSIT(CANG, TANG, DPM, IBAD)
	IF(IBAD.EQ.0) GOTO 9999
C
9000	IFSTAT = -3
	KICK = -9
	CALL IFERR
C
9999	RETURN
	END
C=======================================================================
      SUBROUTINE POSIT(ANGLE,ANGNEW,DPM,IBAD)
C
C
C PROGRAMMER: C.L. MALLORY
C             ALFRED UNIVERSITY, ALFRED, NEW YORK 14802
C
C MODIFICATIONS:
C     JAN-85  JIM WALKER CHANGED CHARACTER VARIABLES TO BYTE FOR FORTRAN IV
C
C MOVES THE AXIS POSITIONER FROM THE CURRENT TWO-THETA LOCATION (ANGLE)
C TO THE NEW TWO-THETA LOCATION (ANGNEW) AT A SPEED OF DPM DEGREES
C PER MINUTE.  IF AN ERROR WAS ENCOUNTERED THE
C VALUE OF THE FLAG IBAD IS PROPERLY SET.
C
C
C ARGUMENT DEFINITIONS:
C
C ANGLE - CURRENT TWO-THETA POSITION OF THE GONIOMETER.
C ANGNEW - THE ANGLE TO MOVE TO FROM ANGLE.
C DPM - SPEED OF THE MOVE IN DEGREES PER MINUTE.
C IBAD - STATUS FLAG INDICATING CALL PERFORMANCE.
C
C
C EXTERNAL SUBROUTINES REQUIRED:
C        CKANG,  ISCODE,  IFIN
C
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE STRING(32),IFINI,IDONE
      DATA IFINI /')'/
      DATA PPD/400./
C	WRITE(7,1234)
C1234	FORMAT(' DEBUG - POSIT: POINT #1.')
C CHECK ANGNEW FOR LEGAL ANGLE VALUE.
      CALL CKANG(ANGLE,ANGNEW,IPUL1,IPUL2,IBAD)
C IF BAD OR IF EQUAL TO ANGLE THEN JUST RETURN.
      IF(IBAD.GT.0.OR.ANGLE.EQ.ANGNEW) GO TO 2
C GENERATE SPEED CODE FOR OUR INTERFACE FROM DPM.
C	WRITE(7,1235)
C1235	FORMAT(' DEBUG - POSIT: POINT #2.')
      ISPEED = ISCODE(DPM)
C GENERATE DIRECTION CODE FOR OUR INTERFACE FROM THE ANGLES.
C IDIR = 1 FOR POSITIVE DIRICTION MOVEMENT AND
C        0 FOR NEGATIVE DIRECTION MOVEMENT.
      IDIR = 1
      IF(ANGLE.GT.ANGNEW) IDIR = 0
C ISSUE MOVE AXIS POSITIONER TO INTERFACE.
C	WRITE(7,1236)
C1236	FORMAT(' DEBUG - POSIT: POINT #3.')
	IF (IPUL2.GE.10) GOTO 1000
	WRITE(20,9) ISPEED,IDIR,IPUL1,IPUL2
	GOTO 2000
1000	IF (IPUL2.GE.100) GOTO 1010
	WRITE(20,8) ISPEED,IDIR,IPUL1,IPUL2
	GOTO 2000
1010	IF (IPUL2.GE.1000) GOTO 1020
	WRITE(20,7) ISPEED,IDIR,IPUL1,IPUL2
	GOTO 2000
1020	WRITE(20,3) ISPEED,IDIR,IPUL1,IPUL2
2000	REWIND 20
C READ COMPLETION CHARACTER.
C      READ(20,4) IDONE
C      REWIND 20
C	WRITE(7,1237)
C1237	FORMAT(' DEBUG - POSIT: POINT #4.')
	NCHAR = 1
	CALL IFIN(NCHAR,STRING)
	IDONE=STRING(NCHAR)
C CHECK FOR AN ERROR.
C	WRITE(7,1238)
C1238	FORMAT(' DEBUG - POSIT: POINT #5.')
      IF(IDONE.EQ.IFINI) GO TO 1
C AN ERROR HAS OCCURED. UPDATE ANGLE TO THE CURRENT VALUE
C AND SET IBAD TO -1 INDICATING AN ERROR.
      WRITE(20,5)
      REWIND 20
C      READ(20,6) TEMP,IDONE
C      REWIND 20
C	WRITE(7,1239)
C1239	FORMAT(' DEBUG - POSIT: POINT #6.')
	NCHAR = 1
	CALL IFIN(NCHAR,STRING)
	DECODE(6,6,STRING) TEMP,IDONE
      ANGLE = TEMP/PPD
      IBAD = -1
      GO TO 2
C UPDATE ANGLE TO NEW VALUE.
1     ANGLE = ANGNEW
C	WRITE(7,1240)
C1240	FORMAT(' DEBUG - POSIT: POINT #7.')
2     RETURN
3     FORMAT(' P11',3I1,I4,'*')
4     FORMAT(A1)
5     FORMAT(' $!R11*')
6     FORMAT(F5.2,A1)
7     FORMAT(' P11',3I1,'0',I3,'*')
8     FORMAT(' P11',3I1,'00',I2,'*')
9     FORMAT(' P11',3I1,'000',I1,'*')
      END
C***********************************************************************
C
	SUBROUTINE IFSPED(AIN, AOUT)
C
	IMPLICIT INTEGER*2 (I-N)
      DIMENSION SPEED(9)
      DATA SPEED/0.0625,0.125,0.25,0.5,1.,2.,10.,20.,60./
	AOUT = SPEED( ISCODE(AIN))
	RETURN
	END
C=======================================================================
      FUNCTION ISCODE(DPM)
C
C
C PROGRAMMER: C.L. MALLORY
C             ALFRED UNIVERSITY, ALFRED, NEW YORK  14802
C
C
C FUNCTION ISCODE CONVERTS THE REQUESTED SPEED (DPM) IN DEGREES PER MINUTE
C INTO THE APPROPRIATE UNITS FOR THE CANBERRA INTERFACE.
C
C
C THE SPEED CODES FOR THE CANBERRA INTERFACE ARE AS FOLLOWS:
C
C SPEED CODE    DEGREES PER MINUTE
C      0           0.0625 (1/16)
C      1           0.125  (1/8)
C      2           0.25   (1/4)
C      3           0.5    (1/2)
C      4           1.0
C      5           2.0
C      6           10.0
C      7           20.0
C      8           60.0   (SLEW)
C   
C   
	IMPLICIT INTEGER*2 (I-N)
      DIMENSION SPEED(9)
      DATA SPEED/0.0625,0.125,0.25,0.5,1.,2.,10.,20.,60./
C SCAN POSIBLE SPEED CODES AVAILABLE.
      DO 1 I = 9,1,-1
      IF(DPM.EQ.SPEED(I)) GO TO 3
      IF(DPM.GT.SPEED(I)) GO TO 2
1     CONTINUE
      I = 1
C SELECT SPEED CODE CLOSEST TO THE VALUE OF DPM.
2     IF((DPM - SPEED(I)).GT.(SPEED(I + 1) - DPM)) I = I + 1
3     ISCODE = I - 1
      RETURN
      END

C**********************************************************************
C
	SUBROUTINE IFSSCN( SANG,EANG,DANG,SPEED,TIMEL,COUNTL,WRCNT)
C
C	STEPSCAN A RANGE FROM SANG TO EANG
C
C	IF EANG.LT.0 THEN COUNT IABS(EANG) POINTS
C
C======================================================================
C
C++++    INCLUDE 'COMMON.FTN'
C======================================================================
C
C   VARIABLE DECLARATION AND COMMON BLOCKS
C
      IMPLICIT INTEGER*2 (I-N)
C
      COMMON /IO/ 
     & IRD,        ITYP,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
C
      COMMON /IFDATA/
     & BANGL,      EANGL,      SETANG,     
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,      
     & IFTYPE,     IFNAME(6)
	BYTE IFNAME
C
      COMMON /IFCMN/ 
     & STPSIZ,     CANG,       ANGLE,      COUNTS,     CTIME,       
     & ISTEP,      IFSTAT,     NERRS,      LIMERR,     KICK
C
C----    INCLUDE 'COMMON.FTN'
C Calls IFMOVE, IFCNT.
C
C======================================================================
C
C   Assume scan will be sucessful.
	IFSTAT = 0
	KICK = 0
C
C======================================================================
C
C	STEP SCAN -- RETURN LOTS OF VALUES FOR COUNTS
C
C   Get number of points to look at.  Number of points is either
C   calculated, or equal to -EANG.
1000	NPTS = - INT(EANG)
	IF(NPTS.LT.0) NPTS = INT( (EANG-SANG) / DANG + 0.5)
C
C   Make sure what we are doing is reasonable.
	IF(NPTS.LT.0 .OR. DANG.LE.0.0 .OR. TIME.LE.0.0) GOTO 9000
C
C   Start the loop.  ANG is the current angle, IPT is the number of the point.
	ANG = SANG
	IPT = 1
C
C   Slew to first point
	CALL IFMOVE( SANG, SPSLEW)
C
C   Get speed for stepping.
	 DPM = SPEED
	 IF( DPM.EQ.0.) DPM = SPSTEP
C
C   Move to the correct angle
1100	 CALL IFMOVE( ANG, DPM)
	 IF( IFSTAT.LT.0) GOTO 9990
C
C   Count for awhile
	 CALL IFCNT( TIMEL, COUNTL)
	 IF( IFSTAT.LT.0) GOTO 9990
C	 This is the place to insert Xrays off recovery.
C
C   Store the counts
	 CALL WRCNT
C
C   Go do the next point.
	ANG = ANG + DANG
	IPT = IPT + 1
	IF(IPT.LE.NPTS) GOTO 1100
C
C   Finished all requested points.
C
	GOTO 9999
C
C======================================================================
C
C	ABNORMAL RETURNS
C
C   Invalid call parameters: neg # points or neg time.
9000	WRITE(IERRU,9004) SANG*STPSIZ, EANG*STPSIZ, 
     &    DANG*STPSIZ, TIME
9004	FORMAT(' > ERROR < INVALID CALL IFSSCN:',3F9.4,F7.2)
	IFSTAT = -6
	KICK = -3
	CALL IFERR
	GOTO 9999
C
C   IFMOVE or IFCNT do the error handling when they fail so just return.
C   This message is for debug purposes.
9990	CONTINUE
	IF(IBUG.NE.0) WRITE(IBUG,9994)
9994	FORMAT(' > IFSSCN ABNORMAL EXIT <')
C
C======================================================================
C
C	FINAL RETURN
C
9999	RETURN
	END
C***********************************************************************
	SUBROUTINE IFTIME(AIN, AOUT)
	AOUT=AIN
	RETURN
	END

      SUBROUTINE XREAD (MODULE,DATA,IBAD)
C
C MODIFICATIONS:
C     JAN-85  JIM WALKER CHANGED CHARACTER VARIABLES TO BYTE FOR FORTRAN IV
C
C XREAD WILL READ THE RESULTS FROM ANY PARTICULAR UNIT HUNG ON THE
C INTERFACE. FOR OUR SETUP WE USED ONLY THREE DIFFERENT TYPES OF UNITS.
C
C ARGUMENT DEFINITION:
C MODULE - UNIT ON THE INTERFACE TO BE READ.
C DATA - THE DATA CONTAINED IN THE MODULE.
C IBAD - FLAG INDICATING OPERATION STATUS.
C        -1 - INDICATES AN ERROR OCCURED DURING THE READ.
C         0 - INDICATES A NORMAL TERMINATION OF THE READ.
C
C WE USED THREE BASIC GENERIC UNITS;  10,20 AND 40.
C THEY ARE:
C 10 - AXIS POSITIONERS
C 20 - DIGITAL TO ANALOG CONVERTERS
C 40 - COUNTER-TIMER UNITS
C
C YOU MAY HAVE TO ADD SPECIAL FORMATS TO READ FROM A DIFFERENT
C GENERIC TYPE OF UNIT. IN EACH GENERIC FAMILY THE FORMAT IS
C ALMOST THE SAME FOR ANY UNIT IN THAT FAMILY.
C
C    ISSUE THE READ COMMAND FOR THE PARTICULAR UNIT DESIRED.
	IMPLICIT INTEGER*2 (I-N)
	BYTE STRING(32),IFINI,IDONE
      DATA IFINI/')'/
      DATA PPD/400./
      REWIND 20
      WRITE(20,1000) MODULE
      REWIND 20
      IF(MODULE.GE.41) GO TO 10
      IF(MODULE.GE.21) GO TO 5
C      READ(20,1005) DATA,IDONE
	NCHAR = 0
	CALL IFIN(NCHAR,STRING)
	DECODE(6,1005,STRING) DATA,IDONE
C    CORRECT FOR THE AXIS POSITIONER READING AND TWO-THETA.
      DATA = DATA/PPD
      CALL CKANG(DATA,DATA,IPPUL1,IPUL2,IBAD)
      GO TO 20
C5     READ(20,1010) DATA,IDONE
5	NCHAR = 0
	CALL IFIN(NCHAR,STRING)
	DECODE(5,1010,STRING) DATA,IDONE
      GO TO 20
10    IF(MODULE.EQ.42) GO TO 15
C      READ(20,1015) DATA,IDONE
	NCHAR = 0
	CALL IFIN(NCHAR,STRING)
	DECODE(7,1015,STRING) DATA,IDONE
      GO TO 20
C15    READ(20,1020) DATA,IDONE
15	NCHAR = 0
	CALL IFIN(NCHAR,STRING)
	DECODE(7,1020,STRING) DATA,IDONE
C    CHECK THE CONDITION OF THE READ. IF AN ATTENTION OCCURED SET IBAD.
20    IF(IDONE.EQ.IFINI) GO TO 30
25    IBAD=-1
      REWIND 20
      WRITE(20,1025)
30    REWIND 20
      RETURN
C
C    THE FORMATS CORRESPOND TO THE UNITS AS:
C 1000 - ISSUES THE READ COMMAND OF UNIT 'MODULE'.
C 1005 - USED FOR THE AXIS POSITIONER.
C 1010 - USED FOR THE DIGITAL TO ANALOG CONVERTERS.
C 1015 - USED FOR THE COUNTER.
C 1020 - USED FOR THE TIMER. AUTOMATICALLY POSITIONS THE DECIMAL POINT.
C 1025 - USED IN THE RESET OF INTERFACE IN CASE OF AN ATTENTION..
C
1000  FORMAT(' R',I2,'*')
1005  FORMAT(F5.2,A1)
1010  FORMAT(F4.2,A1)
1015  FORMAT(F6.0,A1)
1020  FORMAT(F6.2,A1)
1025  FORMAT('  $!')
      END
      SUBROUTINE XWRITE (MODULE,DATA)
C
C XWRITE WILL TRANSFER DATA TO THE DIGITAL TO ANALOG CONVERTERS OR
C TO ANY UNIT WHICH CAN INTELLIGENTLY DECODE THE DATA. THIS DOES NOT
C INCLUDE THE AXIS POSITIONER SINCE A WRITE COMMAND TO IT IS TOTALLY
C UNINTERPRETABLE BY THE UNIT AND IS IGNORED.
C
	IMPLICIT INTEGER*2 (I-N)
      REWIND 20
      WRITE(20,1) MODULE,DATA
      REWIND 20
      RETURN
1     FORMAT('W',I2,F4.2,'*')
      END
