C*****************************************************************************
C*****************************************************************************
C
C	THIS VERSION OF AUTO IS INCOMPLETE, HOWEVER YOU MAY FIND IT EASIER
C	TO FINISH THIS VERSION THAN TO ADAPT THE OLD, WORKING, VERSION TO
C	YOUR EQUIPMENT.  THE OLD VERSION WAS ORIGINALLY DESIGNED TO OPERATE
C	TWO DIFFRACTOMETERS SIMULTANEOUSLY AND, AS A RESULT, IS VERY
C	COMPLICATED.  THIS NEW VERSION IS MUCH SIMPLER, BUT IS UNFINISHED AND
C	UNTESTED.
C
C	IF YOU DECIDE YOU WANT THIS VERSION WE APOLIGIZE FOR ITS PRESENT
C	CONDITION.  WE HOPE TO FINISH IT IN WHEN CLASSES GET OUT AND WE
C	HAVE MORE TIME.
C
C	This version started by:
C		James Walker   (More of a computer bum than a scientist.)
C		NYS College of Ceramics
C		Alfred University
C		Alfred, NY 14802
C
C
C	In general, subroutines that are specific to the interface you are
C	using begin with IF.  Subroutines specific to the computer system
C	begin with SY.  Exceptions are subroutines taken from other programs.
C
C*****************************************************************************
C
C	THIS IS THE VARIABLE DICTIONARY FROM THE OLD VERSION.  SOME OF THIS
C	IS OBSELETE.
C
C     IF1, IF2     =  ?2 - THE LOGICAL UNIT NUMBER OF THE X-RAY INTERFACE
C     IRD          =  5 - TERMINAL INPUT
C     ITYP         =  6 - TERMINAL OUTPUT
C
C
C     BANG         = THE BEGINNING 2-THETA FOR RUN
C     BKGTIM       = BACKGROUND COUNT TIME IN SECONDS
C     BKGTI1	   = SAVES BKGTIM FOR MULTIPLE REPITITONS
C     CANG         = THE CURRENT 2-THETA OF THE DIFFRACTOMETER
C     DANG         = THE DELTA 2-THETA OR STEP WIDTH
C     DELPK        = LAST CALCULATED SHIFT IN USER'S PANG AS
C                    CALCULATED IN PKFIND (PEAK HEIGHT MODE).
C     EANG         = THE ENDING 2-THETA FOR THE RUN
C     FIXERR       = 0 - FIXED TIME COUNT MODE (WITH OPTIMIZATION)
C                  = NN.NN - PERCENT ERROR FOR FIXED ERROR COUNT MODE.
C     IACT         = A CURRENT ACTIVITY CODE FOR A UNIT
C                     = -1 LIMIT SWITCH HIT OR INTERFACE ERROR,
C		           2-THETA WAS LOST
C                     =  0 UNIT NOT ACTIVE
C                     =  1 UNIT IS COUNTING
C                     =  2 UNIT IS STEPPING
C                     =  3 UNIT IS SLEWING
C     CNT          = THE ARRAY FOR COLLECTED INTENSITY VALUES
C     			USED AS A SCRATCH ARRAY USED IN VARIOUS PLACES
C     IDAT         = THE DATE OF THE START OF THE RUN
C     IDBUG        =  0 - NO DEBUG PROCEDURES
C                  = >0 - RUN APPROPRIATE ROUTINES
C     IFLAG        = RUN CONTROL FLAGS READ FROM QUANT RUN FILE
C        IFLAG(1)     = FILE TYPE DESCRIPTOR
C                        = 0 DATA FILE FROM PATTERN COLLECTION
C                        = 1 OUTPUT DATA FILE FROM QUANT
C                        = 2 QUANT RUN FILE FOR STANDARD DETERMINATION
C                        = 3 QUANT RUN FILE FOR UNKNOWN DETERMINATION
C                        = 4 OUTPUT FILE FROM CALIBRATION RUN
C        IFLAG(2)     = RUN TYPE DESCRIPTOR
C                        = 0 PATTERN COLLECTION
C                        = 1 QUANT ANALYSIS FOR WEIGHT PERCENT
C                        = 2 DETERMINE CONSTANTS FROM STANDARDS
C                           (QUANT, I-REL, OR CALIBRATION)
C			 = 3 MEASURE RELATIVE INTENSITIES
C        IFLAG(3)     = QUANTITATIVE ANALYSIS TYPE
C                        = 0 QUAL
C                        = 1 INTERNAL STANDARD METHOD
C                        = 2 INTENSITY RATIO METHOD
C                        = 3 SPIKING METHOD
C                        = 4 RELATIVE INTENSITY RUN
C                        = 5 CALIBRATION RUN (PROFILE MEASUREMENT)
C        IFLAG(4)     = ELEMENTAL ANALYSIS FLAG
C                        = 0 ELEMENTAL COMPOSITION WILL NOT BE ENTERED
C                        = 1 ELEMENTAL COMPOSITION WILL BE USED
C        NREP		 = NUMBER OF REPETIONS FOR EACH SAMPLE MOUNT
C	 NMOUNT		 = NUMBER OF MOUNTINGS FOR THIS COMPOUND OR MIXTURE
C        IFLAG(7-10)	 = AVAILABLE FOR FUTURE EXPANSION
C     IPK          = DATA COLLECTION MODE FLAG
C                     = 0 STEP SCAN (I.E. TO BE LATER INTEGRATED)
C                     = 1 PEAK COUNT MODE
C     IPKFND       = RESULT OF PEAK FIND ROUTINE
C		      = -1 NO PEAK FOUND
C		      =  0 PEAK FOUND IN UNSMOOTHED EXTREMES
C		      =  1 PEAK LOCATED NEAR EXPECTED VALUE
C     IPT          = THE NUMBER OF THE CURRENT GROUP OF 16 DATA POINTS
C                    WHICH IS BEING COLLECTED OR WAS JUST COLLECTED
C     IRATE        = GONIOMETER MOVEMENT RATE CODE 
C     ????         = A STATUS FLAG FOR THE DIFFRACTOMETER
C                     = 0 NOT IN USE
C                     = 1 QUALITATIVE ANALYSIS RUN
C                     = 2 QUANTITATIVE ANALYSIS RUN
C                     = 3 INTENSITY MEASURING RUN
C                     = 4 CALIBRATION RUN
C                     = 5 ALIGNMENT RUN
C     ISAVE        = 0 DO NOT SAVE INTEGRATED COUNTS
C		   = 1 SAVE COUNTS ACCUMULATED DURING SCAN
C     ISTATS       = THE ADDRESS OF INTERFACE MODULE THAT COMPLETED
C     ITOT         = THE TOTAL NUMBER OF DATA POINTS COLLECTED:
C                    FOR QUAL ALL POINTS, FOR QUANT THE POINTS
C                    OF THE PEAK CURRENTLY BEING MEASURED
C     ITIM         = TIME RETURNED BY SUBROUTINE DATE
C     TITLE(20)   = THE RUN TITLE (20A4)
C     USER(5)      = THE OPERATOR'S NAME (5A4)
C     IZRST        = A FLAG TO INDICATE A ZERO STEP REQUEST TO SLEW
C                     = 0 (FALSE) - NON ZERO STEP REQUEST
C                     = 1 (TRUE)  - A ZERO STEP REQUEST. WE ARE AT
C                      THE DESIRED ANGLE.
C     CNTLIM       = THE MAXIMUM COUNTS ALLOWED AT A POINT
C     MODULE(I)	   = MODULE ADDRESSES OF INTERFACES
C		      (1) = COUNTER
C		      (2) = TIMER
C		      (3) = AXIS POSITIONER
C		      (4) = GENERIC ADDRESS OF COUNTER/TIMER (40)
C     MVCNT        = A FLAG TO ESTABLISH STEP AND COUNT METHOD
C		     = 0 ERROR
C                    = 1 FOR INDEPENDENT STEP THEN COUNT
C                    = 2 FOR SIMULTANEOUS STEP AND COUNT
C     NBG          = THE NUMBER OF BACKGROUND POINTS TO MEASURE ON
C                    ON EACH SIDE OF THE PEAK
C     NPK          = THE NUMBER OF POINTS TO MEASURE AT THE PEAK IN PEAK
C                    COUNT MODE OR THE NUMBER OF POINTS TO AVERAGE OVER
C                    AT THE MAXIMUM IN INTEGRATE MODE TO ESTIMATE THE
C                    THE PEAK INTENSITY
C     NPTPK       = NUMBER OF POINTS IN PEAK REGION (QUANT RUN)
C                    = NPK IF IPK=1
C                    = (EANG-BANG)/DANG+1-NPTBG
C			WHERE NPTBG=NBG OR 2*NBG
C     PANG        = THE 2-THETA OF THE PEAK MAXIMUM
C     PPD         = PULSES PER DEGREE FOR GONIOMETER STEPPER MOTOR
C     RATE        = THE MOVE RATE IN DEGREES PER MINUTE
C     SCONC       = CONCENTRATION OF STANDARD FOR A STANDARD RUN
C     SIMTIM      = COUNT TIME CALCULATION VARIABLE
C     TANG        = THE TARGET ANGLE OF THE CURRENT OR NEXT MOVE
C     TEANG       = TRUE ENDING ANGLE OF SCAN
C     TIME        = THE COUNT TIME PER POINT (IN SECONDS)
C     TIME1	  = SAVES TIME FOR MULTIPLE REPITIONS
C     TIMLIM      = THE MAXIMUM TIME TO COUNT A LINE IN MINUTES
C                   (IE THE SUM OF THE TOTAL BACKGROUND AND PEAK TIMES)
C
C     CONC        = CONCENTRATION OF ADDED STANDARD FOR SPIKING METHOD
C                   OR CONCENTRATION OF INTERNAL STANDARD.
C     MOUNT	  = THE CURRENT NUMBER OF TIMES A SAMPLE HAS BEEN
C                   MOUNTED IN THE PRESENT RUN (.LE.IFLAG(6)).
C     LPK         = THE SEQUENTIAL NUMBER OF THE PEAK FROM THE RUN
C                   FILE CURRENTLY BEING DETERMINED
C     NUM         = THE SEQUENCE NUMBERS OF THE LINES FROM THE
C                   RUN FILE TO BE DETERMINED FOR THIS UNKNOWN SAMPLE
C     IREP       = THE CURRENT REPITION NUMBER FOR THE PRESENT MOUNT
C                   (.LE.IFLAG(5)).
C
C     NMFIL(15)   = NAME OF THE OUTPUT FILE
C     NREC        = NUMBER OF RECORDS WRITTEN ON THE OUTPUT FILE
C     IENRN(5)    = ESTIMATED TIME OF END OF RUN
C
C
C    IOFF         = FLAG FOR USE OR NONUSE OF TEMPERATURE MONITORS
C                    = 0  CONTINUE TO READ TEMPERATURE
C                    = 1  DO NOT READ TEMPERATURE
C    ITEMP        >  0  100 TIMES THE TEMPERATURE IN DEGREES CENTIGRADE
C                 =  0  TEMPERATURE READING TURNED OFF (IOFF=1)
C                 = -1 64BIT I/O CARD NOT OPERATIONAL
C                 = -2 OMEGA 410A+002A DID NOT RESPOND TO DATA REQUEST
C                 = -3 OMEGA 410A+002A OVERFLOW BIT SET
C***********************************************************************
C
	PROGRAM AUTO
C
C			-        AUTO        -
C
C     THE PROGRAM PACKAGE AUTO IS A SECOND GENERATION AUTOMATED POWDER
C  DIFFRACTOMETER CONTROL SYSTEM DESIGNED FOR DATA COLLECTION AND OUTPUT
C  FILE CREATION LINKING TO FURTHER DATA REDUCTION PACKAGES.
C
C
C*****************************************************************************
C
C     DESCRIPTION: $$
C
C          THIS PROGRAM BEGINS THE AUTO PACKAGE.  INITILIZATION IS
C     PERFORMED FIRST AND THEN THE MENU IS AUTOMATICLY CALLED.
C
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 /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
C======================================================================
C
C	START HERE
C
C  System specific initialization: 
C  Assign units 5 & 6 to the terminal, & get the current date.
C
	CALL SYINIT
C
C  Write program heading and current date & time
C
	CALL SYTIME
	WRITE(ITYP,1000) ITIM,IDAT
1000	FORMAT(19X,'**  AUTO  **',/,
     &    ' A DATA COLLECTION PROGRAM FOR QUANTITIVE ANALYSIS',/,
     &    9X,'VERSION: AU3.debug RSX July, 1985',/,/
     &    ' Program started at',
     &    I3,':',I2,':',I2,' on ',I2,'/',I2,'/',I2)
C     &    I3,':',I2.2,':',I2.2,' on ',I2,'/',I2,'/',I2.2)
C
C
C======================================================================
C
C   MAIN MENU -- GET AN OPTION AND BRANCH TO APPROPRIATE ROUTINE
C
C   Prompt for option
C
2000	WRITE(ITYP,2004)
2004	FORMAT(/,/,' Enter option number <0 for help>:',$)
C
C   Read otion number
C
	READ(IRD,2104,END=9999) IOPT
2104	FORMAT(I)
C
C  Branch to appropriate routine:
C
C 20 = exit
	IF(IOPT.EQ.20) GOTO 9999  
C  0 or bad option prints menu     v--
        IF(IOPT.LE.0 .OR. IOPT.GT. 3 ) GOTO 4000
C  1-3 are valid.           This --^ is the highest valid option.
	GOTO (3001,3002,3003),IOPT
C  It should never get here, especially if option # was valid.
	GOTO 4000
C
C
C======================================================================
C
C  CALL SUBROUTINE TO DO OPTION
C
3001	CALL RUNFIL
	GOTO 2000
C
3002	CALL QUANT
	GOTO 2000
C
3003	CALL DEBUG
	GOTO 2000
C
C
C======================================================================
C
C  PRINT MENU WHEN ASKED OR WHEN INVALID OPTION IS GIVEN
C
C  Bark at invalid options; just print menu for option 0 (help)
C
4000	IF(IOPT.NE.0) WRITE(ITYP,4004)
4004	FORMAT(/,' Invalid option; try again.')
C
	WRITE(ITYP,4014)
4014	FORMAT(' Valid options are:',/,
     &  '    0 - Print this menu',/,
     &  '    1 - Enter run control parameters (build a runfile)',/,
     &  '    2 - Collect data for quantitative analysis',/,
     &  '    3 - Select rarely used debugging options',/,
     &  '   20 - Exit')
C
	GOTO 2000
C
C
C======================================================================
C
C  ALL DONE FOR TODAY.  SEE YA TOMORROW.
C
9999	WRITE(ITYP,9998)
9998	FORMAT(/,'      **   NORMAL TERMINATION OF AUTO.  ',
     1	'HAVE A NICE DAY.   **')
C
	CALL EXIT
	END
	.ROOT	AUTO-01BKDATA-01CRASTAT-SYSUB-BUG-DEF-*(OV10,OV20)
SYSUB:	.FCTR   SYINIT-SYOPEN-SYTIME
BUG:	.FCTR   30DEBUG
OV10:	.FCTR	10RUNFIL
OV20:	.FCTR	20QUANT-OV21-OV22-OV23-OV24-IFLB
OV21:	.FCTR	21QBEGIN-21CHEM-21COPY25-21RDCONC
OV22:	.FCTR	22PASS0-22OPTIM-22PKFIND-22SMTH13-22STRCNT-22TIMFIX
OV23:	.FCTR	23PKSCAN-23WRCNT-23WRREC
OV24:	.FCTR	24FINISH
DEF:	.FCTR	[1,1]FORLIB/DL
IFLB:	.FCTR	[300,3]CANB/LB
	.END
C***********************************************************************
C
	BLOCK DATA
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 /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
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	DATA IRD, ITYP,IERR, IBUG, IF1,IF2, IRUN, IRAW, ICAL, IOX,IOY
     &   /    5,    6,   6,    7,   20, 2,    3,    4,    8,   9,  10/
C  Note: CALL RAPR(TT#,IF1).  Otherwise it uses iunit=8.
C  The ADC canberra routines like IF1=20.
C
C		dimension on arrays in PEAK.
	DATA MPEAK/20/
C
C	DATA MODULE/41,42,11,40/
C
	END
C**********************************************************************
C
	SUBROUTINE IFERR
C
C	ABNORMAL TERMINATION ROUTINE -- WHEN THE INTERFACE ROUTINES HIT
C	A FATAL ERROR THEY PRINT A MESSAGE DESCRIBING WHAT HAPPENED.  
C	THEN THEY CALL THIS WHICH PRINTS OUT ALL INFORMATION
C	NEEDED TO RESTART RUN, THEN EXITS.
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
C  Exit
	WRITE(ITYP,9004) IFSTAT,KICK
9004	FORMAT(' >> ABNORMAL TERMINATION OF AUTO <<',/,
     &   ' >  IFSTAT, KICK=',2I3)
C
C  Print out most of the information including traceback.
	CALL STATUS
	STOP
	END
C
C**********************************************************************
C
	SUBROUTINE STATUS
C
C	PRINT OUT INFORMATION TO IDENTIFY THE RUN AND GIVE SOME IDEA
C	HOW FAR ALONG IT IS.
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 Should print to IERR the following:
C  NMRUN, NMRAW, TITLE, USER, CONC, SCONC, IFLAG(method,chem)
C  Lpeak, (ipeak), (npeak), (irep), nrep, (mount), nmount,
C  Ifname, angle, (nerrs)
C  ITIM, IDAT, (ISTIM), (IENTIM)
C Currently dumps everything in common.
C
C======================================================================
C
	WRITE(ITYP,2)
2	FORMAT(' Do you really want status? <ret=N>',$)
	READ(IRD,3) IY
3	FORMAT(A1)
	IF(IY.NE.'N' .AND. IY.NE.'n') WRITE(IERR,1) 100
1	FORMAT(' In subroutine status called thus:',I1)
	IF(IY.NE.'Y' .AND. IY.NE.'y') RETURN
C This is used by IFsubs, but doesn't start with IF.  Deviation from standard.
	WRITE(IERR,4)
     & IRD,        IERR,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
4	FORMAT('      COMMON /IO/ ',11I3)
C
	WRITE(IERR,14)ICOUNT,CNT
14	FORMAT('      COMMON /ARRAY/',I3,5(/,10F8.0))
C
	WRITE(IERR,24)
     & MPEAK,      PANG,   PKTIM,  BKGTIM, 
     & IPKFND, LPEAK
24	FORMAT('      COMMON /PKCMN/ ',I3, 6(/,10F8.4),/,20I3,/,20L2)
C
	WRITE(IERR,34)
     & CONC,       SCONC,      NREC,       IPEAK,      NPEAK,
     & IREP,       NREP,       MOUNT,      NMOUNT
34	FORMAT('      COMMON /RUN/ ',2F8.4,7I5)
C
	WRITE(IERR,44)
     & TITLE,  USER,    NMRUN,  NMRAW,  IFLAG
44	FORMAT('      COMMON /RUN2/',/,20A4,/,5A4,3X,40A1,/,
     &   3X,40A1,3X,4I2)
C
	WRITE(IERR,54)
     & ITIM,    IDAT,    ISTIM,   IENTIM
54	FORMAT('      COMMON /TIME/ ',
     & 3(I2,'/',I2,'/',I2,I3,':',I2,':',I2))
C     & 3(I2,'/',I2,'/',I2.2,I3,':',I2.2,':',I2.2))
C
C
	WRITE(IERR,64)
     & BANGL,      EANGL,      SETANG,     
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,      
     & IFTYPE,     IFNAME
64	FORMAT('      COMMON /IFDATA/',/,7F8.4,/,I3,X,6A1)
C
	WRITE(IERR,74)
     & STPSIZ,     ANGLE,      COUNTS,     CTIME,       ISTEP,
     & IFSTAT,     NERRS,      LIMERR
74	FORMAT('      COMMON /IFCMN/ ',F8.4,3F8.1,I5,3I4)
C
C	COMMON /IFCANB/ MAXIS, MCNT, MTIM
C	COMMON /IFDACO/ ISYNC, ICMD, IOUT { This is hard coded in RAPR }
	WRITE(IERR,84) CANG
84	FORMAT('      COMMON /IFTEST/ CANG = ',F8.1)
C
C
	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		QUANTITATIVE ANALYSIS COMMAND FILE CREATION
C
	SUBROUTINE RUNFIL
C
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE CREATES A RUN FILE TO DIRECT THE
C	   COLLECTION OF QUANTITATIVE ANALYSIS DATA.  
C
C***********************************************************************
C
C	HISTORY:
C
C	  This subroutine was taken from the old, unwieldy version of
C	auto with a few minor changes.
C	  Answers to Yes/No questions can be given in lower case.
C	  Calls to subroutines FILUP, and ALOT have been replaced by
C	some read statements and a call to SYOPEN.
C
C	LATER REVISIONS:
C
C***********************************************************************
C
C  THE FORMAT OF THE RUN FILE IS AS FOLLOWS:
C
C
C  RECORD 1:  TITLE RECORD
C
C  COL   1- 80 TITLE
C  COL  81-100 OPERATOR'S NAME
C  COL 101-106 DATE OF FILE CREATION
C  COL 113-122 IFLAG - RUN OPTION SELECTION FLAGS
C
C
C  RECORD 2: ONE FOR N LINES TO BE ANALYSED (ONE RECORD PER PROFILE)
C
C  COL   1-  7  STARTING ANGLE OF PROFILE OR LOW ANGLE BACKGROUND
C  COL   8- 14  2-THETA OF PEAK MAXIMUM
C  COL  15- 21  ENDING ANGLE OF PROFILE OR HIGH ANGLE BACKGROUND
C  COL  22- 28  STEP WIDTH (NOT USED FOR PEAK COUNTING)
C  COL  29- 32  RATE OF MOTION BETWEEN DATA POINTS (DEGREES/MIN)
C               SET TO 60.0 DEGREES PER MINUTE
C  COL  33- 40  TIMLIM THE MAX TIME TO COUNT A LINE IN MINUTES
C  COL  41- 45  FIXERR THE PERCENT ERROR TO COUNT TO.  IF ZERO
C               A FIXED TIME COUNT WILL BE PERFORMED
C  COL  46- 50  CNTLIM THE MAX NUMBER OF COUNTS TO COLLECT AT A POINT
C  COL  51- 56  THE NAME OF THE PHASE
C  COL  57- 62  THE H K AND L OF THE LINE (3I2)
C  COL  63      KODE DESCRIBING THE TYPE OF LINE BEING ENTERED
C                 = 1 A LINE BELONGING TO THE UNKNOWN PHASE BEING
C                     ANALYSED
C                 = 2 A LINE OF THE INTERNAL STANDARD MATERIAL
C                 = 3 A REFERENCE LINE FROM THE SAMPLE HOLDER
C                 = 4 AN AMORPHOUS HALO LINE. NO BACKGROUND POINTS ARE
C                     TO BE MEASURED.
C  COL  64      IOVLP THE NUMBER OF OTHER LINES OVERLAPPING THIS ONE
C  COL  65      IPK = 0 - STEP SCAN THE PEAK
C                   = 1 - PEAK COUNT MODE
C  COL  66- 67  NPK THE NUMBER OF PEAK POINTS TO MEASURE. IN INTEGRATE
C               SCAN MODE THIS IS NUMBER TO AVERAGE AT MAX FOR PEAK I.
C  COL  68- 69  NBG THE NUMBER OF BACKGROUND POINTS ON EACH SIDE OF PEAK
C  COL  70- 75  RELATIVE INTENSITY OF THE LINE
C  COL  76- 79  STANDARD DEVIATION OF THE RELATIVE INTENSITY
C  COL  80- 88  STANDARD INTENSITY VALUE (I/ISTD OR IPURE OR I/IREF)
C  COL  89- 96  SIGMA OF STANDARD INTENSITY
C  COL  97-104  CONCENTRATION OF ADDED PHASE FOR SPIKING METHOD
C               OR OF REFERENCE PHASE FOR INTERNAL STD METHOD
C  COL 105-111  COUNT TIME AT PEAK POINTS
C  COL 112-118  COUNT TIME AT BACKGROUND POINTS
C  COL 119      IOPTIM = 1 - COUNT IN FIXED TIME OPTIMIZATION MODE
C                      = 2 - COUNT IN FIXED ERROR OPTIMIZATION MODE
C                      = 3 - COUNT WITH CONSTANT TIME FOR ALL STEPS
C  COL 120      ILOC = 0 - INTEGRATE COUNT MODE
C                    = 1 - FOUND PEAK WITHIN .09 DEGREES OF RUNFILE
C                          VALUE
C                    = 2 - FOUND PEAK OUTSIDE .09 DEGREES OF RUNFILE
C                          VALUE
C                    = 3 - FAILED TO LOCATE THE PEAK
C  COL 121-128  WEIGHT FRACTION OF THE STANDARD PHASE FOR INTERNAL
C               STANDARD METHOD OR FOR THE INTENSITY RATIO METHOD THE
C               MU/RO OF THE STANDARD.
C
C
C  RECORD 3: LINE OVERLAP INFORMATION AND CHEMICAL COMPOSITION
C            OF STANDARD LINES WHEN NEEDED
C
C  NOTE: RECORDS 2 AND 3 ARE REPEATED FOR EACH REGION TO BE MEASURED
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 /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 Calls SYTIME, SYOPEN.
C
C
C======================================================================
C
C	VARIABLE DECLARATION:
C
	BYTE IBLK
	BYTE IPHASE(6), IPHAS2(6), IPHAS3(6)
C
C  INITILIZE 
C
	DATA IBLK/' '/, RATE/60.0/, MVMODE/0/, IOVLP/0/
C
	DATA IPHASE/' ',' ',' ',' ',' ',' '/
	DATA IPHAS2/' ',' ',' ',' ',' ',' '/
	DATA IPHAS3/' ',' ',' ',' ',' ',' '/
C
	DATA OANG1/0.0/, OANG2/0.0/
C
	DATA OINT1/0.0/, OINT2/0.0/
C
	DATA OSIG1/0.0/, OSIG2/0.0/
C
	DATA IH/0/, IK/0/, IL/0/
	DATA IH2/0/, IK2/0/, IL2/0/
	DATA IH3/0/, IK3/0/, IL3/0/
C
C======================================================================
C
C  WRITE OUT THE GREETING
C
	CALL SYTIME
	WRITE(ITYP,1004) ITIM, IDAT
1004	FORMAT(//,'    QUANTITATIVE ANALYSIS COMMAND FILE BUILDING AT '
     1	I2,':',I2,':',I2,' ON ',I2,'/',I2,'/',I2,/)
C     1	I2,':',I2.2,':',I2.2,' ON ',I2,'/',I2.2,'/',I2.2,/)
C
C======================================================================
C
C  INPUT THE NAME OF THE RUN FILE
C
	WRITE(ITYP,1014)
1014	FORMAT(' Enter the name of the run file <.RUN> ? ',$)
	READ(IRD,1024,END=9999) NMRUN
1024	FORMAT(40A1)
C
C  Create the file using .RUN as the default extension.
	CALL SYOPEN(IRUN,NMRUN,'.RUN',1)
C
C  Set flag indicating this is a run file.
	IFLAG(1) = 4
C
C  Enter title information
C
	WRITE(ITYP,1034)
1034	FORMAT(/,' Enter a title for this run file (80 characters max)',/
     &  ' Title? ',$)
	READ(IRD,1044,END=9900) TITLE
1044	FORMAT(20A4)
C
	WRITE(ITYP,1054)
1054	FORMAT(/,' Enter your name (20 characters) ? ',$)
	READ(IRD,1044,END=9900) USER
C
C======================================================================
C
C  WHAT TYPE OF ANALYSIS DOES HE WANT ?
C
C  The default is rel int.
	IDFLT = 4
1000	WRITE(ITYP,1010) IDFLT
1010	FORMAT(/,' METHOD OF ANALYSIS (I1) ? ',/,
     1	'      1 - INTERNAL STANDARD       2 - INTENSITY RATIO',/
     2	'      3 - SPIKING                 4 - REL. INTENSITY',/
     3	'      5 - PROFILE',/,
     4  ' CHOICE <ret=',I1,'> ? ',$)
C
	READ(IRD,1020,END=9999) IFLAG(3)
1020	FORMAT(I1)
C
C  If only a return was input set the default.
	IF (IFLAG(3).EQ.0) IFLAG(3) = IDFLT
C
C  Check for valid option; try again if necessary.
	IF (IFLAG(3).LT.0 .OR. IFLAG(3).GT.5) GOTO 1000
C
C  SET THE RUN TYPE DESCRIPTOR FLAGS IF NECESSARY
C
C  Internal standard & Intensity ratio: we only hand build the standards file
	IF(IFLAG(3).EQ.1 .OR.
     &     IFLAG(3).EQ.2) IFLAG(2) = 2
C Spiking method
	IF(IFLAG(3).EQ.3) IFLAG(2) = 1
C Relative intensity measurement
	IF(IFLAG(3).EQ.4) IFLAG(2) = 3
C Profile measurement (Note: this version of AUTO doesn't do profile meas.)
	IF(IFLAG(3).EQ.5) IFLAG(2) = 0
	IF(IFLAG(3).EQ.5) IFLAG(1) = 5
C
C  IF SPIKING, RELATIVE INTENSITY, OR PROFILE ANALYSIS, THEN
C  CHEMISTRY IS NOT USED
C
	IFLAG(4) = 0
	IF (IFLAG(3).GE.3) GOTO 100
C
	WRITE(ITYP,1030)
1030	FORMAT(//,' WILL CHEMICAL COMPOSITION BE ENTERED (Y/N,ret=N)?',$)
C
	READ(IRD,1040,END=9900) IY
1040	FORMAT(A1)
C
	IF (IY.EQ.'Y' .OR. IY.EQ.'y') IFLAG(4) = 1
C
C======================================================================
C
C  WRITE THE TITLE RECORD (RECORD #1)
C
100	WRITE(IRUN,1045) TITLE,USER,ITIM,IDAT,(IFLAG(I),I=1,4)
1045	FORMAT(20A4,5A4,3I2,3I2,4I1,'000000')
	NREC=1
C
C======================================================================
C
C  ENTER INFORMATION ON EACH LINE
C
	K = 0
200	K = K + 1
210	WRITE(ITYP,1050) K
1050	FORMAT(//' PLEASE ENTER THE FOLLOWING INFORMATION FOR LINE',
     1	' NO. ',I3,//,'   - NAME OF PHASE (BLANK TERMINATES INPUT)'/
     2	'   - H, K, AND L (3(X,I2))'/
     3	'   - SCAN CODE (I1) =0 INTEGRATE, =1 PEAK COUNT'/
     4	'   - LINE CODE (I1) =1 UNKNOWN, =2 STD, =3 REF, =4 AMORPH'/
     5	'   - DESIRED % ERROR (0=FIXED TIME)'/
     6	'   - TIME(MIN) TO COUNT PK + BKG'/
     7	'   - RELATIVE INTENSITY OF THE LINE'/
     8	'   - STANDARD DEVIATION OF RELATIVE INTENSITY'/
     9	'   - STANDARD INTENSITY'/
     *	'   - STANDARD DEVIATION OF STANDARD INTENSITY'//
     1	'          NAME    H  K  L S L ERROR TIME   RELINT  SIG.  ',
     2	'STDINT  SIG.'/
     3	' DEFAULT: ------  0  0  0 0 1  0.0   15.0    0.0   0.0   ',
     4	'  0.0   0.0'/
     5	' FORMAT:  AAAAAA NN NN NN N N NN.NN NNN.N  NNN.NN  N.NN  ',
     6	'NNN.NN  N.NN'/
     7	' --------------------------------------------------------',
     8	'------------'/
     9	' INPUT:   ',$)
C
	READ(IRD,1060,END=400) (IPHASE(I) ,I=1,6),IH,IK,IL,IPK,KODE,
     1	FIXERR,TIMLIM,FREL,STDREL,STD,SIGSTD
1060	FORMAT(6A1,3(X,I2),2(X,I1),X,F5.2,X,F5.1,2(2X,F6.2,2X,F4.2))
C
C======================================================================
C
C  ARE WE FINISHED?
C
	IF (IPHASE(1).EQ.IBLK.AND.IPHASE(2).EQ.IBLK.AND.
     1	IPHASE(3).EQ.IBLK.AND.IPHASE(4).EQ.IBLK.AND.
     2	IPHASE(5).EQ.IBLK.AND.IPHASE(6).EQ.IBLK)
     3	GOTO 400
C
C======================================================================
C
C  SET DEFAULT VALUES
C
	IF (KODE.EQ.0) KODE=1
	IF (TIMLIM.LT.0.01) TIMLIM  = 15.0
C
C======================================================================
C
C  ECHO INPUT
C
	WRITE(ITYP,1070) (IPHASE(I),I=1,6),IH,IK,IL,IPK,KODE,
     1	FIXERR,TIMLIM,FREL,STDREL,STD,SIGSTD
1070	FORMAT(' RESULT:  ',6A1,3(X,I2),2(X,I1),X,F5.2,X,F5.1,
     2	2(2X,F6.2,2X,F4.2))
C
	WRITE(ITYP,1080)
1080	FORMAT(/' IS THIS CORRECT (Y/N,ret=Y) ? ',$)
	READ(IRD,1090,END=200) IY
1090	FORMAT(A1)
	IF (IY.EQ.'N' .OR. IY.EQ.'n') GOTO 210
C
C======================================================================
C
C  REQUEST ANGLE CONTROL INFORMATION FOR THE CURRENT LINE
C
220	WRITE(ITYP,1100) K
1100	FORMAT(//' PLEASE ENTER THE FOLLOWING INFORMATION FOR LINE',
     1	' NO. ',I3,//,'   - PEAK 2-THETA'/
     2	'   - BACKGROUND LOW 2-THETA'/
     3	'   - BACKGROUND HIGH 2THETA'/
     4	'   - STEP WIDTH'/
     5	'   - MAXIMUM COUNTS'/
     6	'   - NUMBER OF PEAK POINTS TO COLLECT'/
     7	'   - NUMBER OF BACKGROUND POINTS TO COLLECT'/
     8	'   - MOVECOUNT METHOD  0 = INDEPENDANT, 1 = SIMULTANEOUS'//
     9	'          PK 2-TH BKGL2TH BKGH2TH STPWDTH CNT MAX #PK  #BKG M'/
     *	' DEFAULT:   0.0     0.0     0.0    0.01   900000.    5   10 0'/
     1	' FORMAT:  NNN.NNN NNN.NNN NNN.NNN NN.NNNN NNNNNN. NNNN NNNN N'/
     2	' ------------------------------------------------------------'/
     3	' INPUT:   ',$)
C
	READ(IRD,1110,END=200) PANGD,BANG,EANG,DANG,CNTLIM,NPK,NBG,MVMODE
1110	FORMAT(3(F7.3,X),F7.4,X,F7.0,X,I4,X,I4,X,I1)
C
C======================================================================
C
C  SET DEFAULT PARAMETERS
C
	IF (DANG.EQ.0.0) DANG = .01
	IF (CNTLIM.LT.1) CNTLIM = 900000.
	IF (NPK.LT.1) NPK = 5
	IF (NBG.LT.1) NBG = 10
	IF (KODE.EQ.4) NBG = 0
C  Note that some interface libraries may not support simultaneous movecount.
	IF (MVMODE.LT.1) MVMODE = 0
C
C======================================================================
C
C  ONLY MOTION TOWARD HIGH ANGLE WILL BE ALLOWED IN INTEGRATE MODE.
C  IN PEAK HEIGHT MODE EITHER ONE OR TWO BACKGROUNDS MAY BE ENTERED
C  IN ANY ORDER
C
	IF ((IPK.NE.0).OR.(EANG.GT.BANG)) GOTO 230
C
	WRITE(ITYP,1120)
1120	FORMAT('  >> ILLEGAL ANGLES << - EANG MUST BE > BANG')
	GOTO 220
C
C  IF NPK IS NOT ODD FORCE IT
C
230	IF ((INT(NPK/2.0)*2).EQ.NPK) NPK=NPK-1
C
C======================================================================
C
C  ECHO INPUT PARAMETERS
C
	WRITE(ITYP,1130) PANGD,BANG,EANG,DANG,CNTLIM,NPK,NBG,MVMODE
1130	FORMAT(' RESULT:  ',3(F7.3,X),F7.4,X,F7.0,X,I4,X,I4,X,I1)
C
	WRITE(ITYP,1140)
1140	FORMAT(/' IS THIS CORRECT (Y/N,ret=Y) ? ',$)
	READ(IRD,1150,END=200) IY
1150	FORMAT(A1)
	IF (IY.EQ.'N' .OR. IY.EQ.'n') GOTO 220
C
C======================================================================
C
C  READ OVERLAPPING LINE INFORMATION - NONE ALLOWED IF SPIKING,
C  RELATIVE INTENSITY, OR PROFILE ARE TO BE PERFORMED.
C
	IF (IFLAG(3).GE.3) GOTO 300
C
	WRITE(ITYP,1200)
1200	FORMAT(//' ENTER THE NUMBER OF LINES WHICH OVERLAP THIS LINE',
     1	'(MAX=2) ? ',$)
C
	READ(IRD,1210,END=200) IOVLP
1210	FORMAT(I1)
C
C======================================================================
C
C  READ THE OVERLAP LINE INFORMATION FOR RECORD 3
C
	IF(IOVLP.EQ.0) GOTO 300
C
240	IF (IFLAG(3).NE.5) GOTO 250
C
	WRITE(ITYP,1220)
1220	FORMAT(//,' ENTER THE FOLLOWING FOR THE OVERLAPPING LINE(S):',//
     1	'   - PHASE NAME'/
     2	'   - H, K, AND, L FOR THE LINE'/
     3	'   - ANGLE LOCATION IN 2-THETA'//
     4	'          NAME1   H  K  L PK1 2TH  NAME2   H  K  L PK2 2TH'/
     5	' DEFAULT: ------  0  0  0   0.0    ------  0  0  0   0.0'/
     6	' FORMAT:  AAAAAA NN NN NN NNN.NNN  AAAAAA NN NN NN NNN.NNN'/
     7	' ---------------------------------------------------'/
     8	' ENTER:   ',$)
C
	READ(IRD,1230,END=200) IPHAS2,IH2,IK2,IL2,OANG2,
     1	IPHAS3,IH3,IK3,IL3,OANG3
1230	FORMAT(2(6A1,3(X,I2),X,F7.3,2X))
C
C  ECHO THE INPUT
C
	WRITE(ITYP,1240) IPHAS2,IH2,IK2,IL2,OANG2,
     1	IPHAS3,IH3,IK3,IL3,OANG3
1240	FORMAT(' RESULT:  ',2(6A1,3(X,I2),X,F7.3,2X))
C
	GOTO 260
C
C======================================================================
C
250	WRITE(ITYP,1250)
1250	FORMAT(//,' ENTER THE FOLLOWING FOR THE OVERLAPPING LINE(S):',//
     1	'   - PHASE NAME'/
     2	'   - H, K, AND, L FOR THE LINE'/
     3	'   - RELATIVE INTENSITY'/
     4	'   - STANDARD DEVIATION OF THE INTENSITY'//
     5	'          NAME1  H K L REL-I SIG   NAME2  H K L REL-I SIG'/
     6	' DEFAULT: ------ 0 0 0 100.0 0.5   ------ 0 0 0 100.0 0.5'/
     7	' FORMAT:  AAAAAA N N N NNN.N N.NN  AAAAAA N N N NNN.N N.NN'/
     8	' ---------------------------------------------------------'/
     9	' ENTER:   ',$)
C
	READ(IRD,1260,END=200) IPHAS2,IH2,IK2,IL2,OINT2,OSIG2,
     1	IPHAS3,IH3,IK3,IL3,OINT3,OSIG3
1260	FORMAT(2(6A1,3(X,I2),X,F5.1,X,F4.2,2X))
C
C  ECHO THE INPUT
C
	WRITE(ITYP,1270) IPHAS2,IH2,IK2,IL2,OINT2,OSIG2,
     1	IPHAS3,IH3,IK3,IL3,OINT3,OSIG3
1270	FORMAT(' RESULT:  ',2(6A1,3(X,I2),X,F5.1,X,F4.2,2X))
C
C  IS EVERYTHING 'HUNKY-DOREY' ?
C
260	WRITE(ITYP,1280)
1280	FORMAT(/' IS THIS CORRECT (Y/N,ret=Y) ? ',$)
	READ(IRD,1290,END=200) IY
1290	FORMAT(A1)
	IF (IY.EQ.'N' .OR. IY.EQ.'n') GOTO 240
C
C======================================================================
C
C  NOW PROCEED TO WRITE RECORD 2 (TYPE 7) OF THE RUN FILE
C
300   WRITE(IRUN,1300) BANG,PANGD,EANG,DANG,
     1	RATE,MVMODE,TIMLIM,FIXERR,
     2	CNTLIM,IPHASE,IH,IK,IL,KODE,IOVLP,IPK,NPK,
     3	NBG,FREL,STDREL,STD,SIGSTD
1300  FORMAT(3F7.3,F7.4,F4.1,I1,F5.1,F5.2,F7.0,6A1,3I2,3I1,2I2,
     1	F6.1,F4.1,F9.4,F8.4)
C
C  THE CHEMICAL ANALYSIS SECTION OF RECORD 3 (TYPE 8) WILL BE SUPPLIED
C  BY THE PROCESSING PROGRAM FROM THE INFO CONTAINED IN RECORD 6
C  AS READ BY QUANT
C
	WRITE(IRUN,1310)
1310	FORMAT(128(' '))
	NREC=NREC+2
C
C  RETURN TO TOP FOR NEXT LINE
C
	GOTO 200
C
C======================================================================
C
C  RUN FILE HAS BEEN WRITTEN TO DISK. WRITE AN END OF FILE AND CLOSE
C
400	ENDFILE IRUN
	CLOSE(UNIT=IRUN)
C
C  PRINT THE SUMMARY MESSAGE
C
	WRITE(ITYP,420) (NMRUN(I),I=1,14),NREC
420	FORMAT(/,'  RUN FILE ',14A1,' CONTAINS ',I3,' RECORDS.')
	GOTO 9999
C
C======================================================================
C
9900	WRITE(ITYP,9904)
9904	FORMAT(' File building aborted.')
	CLOSE(UNIT=IRUN,DISPOSE='DELETE')
C
9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE QUANT
C
C	MAIN ROUTINE FOR COLLECTING QUANTITIVE DATA.
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 IPEAK, MPEAK, IRUN, ITYP, MOUNT, NMOUNT, IREP, NREP.
C Calls QBEGIN, IFLOAD, PASS0, PKSCAN, SYTIME, FINISH
C
C======================================================================
C
C	GET READY TO DO A RUN
C
C   Initialize the interface, Input any last minute information, open files.
C
	CALL QBEGIN( IQUIT)
	CALL STATUS !$$
C
C   User may abort run before it even starts
	IF( IQUIT.NE.0) GOTO 9999
C
C======================================================================
C
C	MAKE THE MEASUREMENTS FOR HOWEVER MANY MOUNTINGS WE ARE SUPPOSED TO
C
	DO 6000, MOUNT=1,NMOUNT
C
C   Start the mounting by rewinding the runfile and skipping the first record.
	 REWIND IRUN
	 READ(IRUN,1004) JUNK
1004	 FORMAT(A1)
C
C   WE NEED A SAMPLE FOR EACH MOUNTING
C
C   Prompt for sample
	WRITE(ITYP,1014) MOUNT, NMOUNT
1014	FORMAT(' READY FOR MOUNTING',I2,' OF',I2)
C
C   Move to a convienient angle and wait for the user to type S to start.
	CALL IFLOAD( IQUIT)
C
C   User may have said E or ^Z to Exit early.
	IF( IQUIT.NE.0) GOTO 9900
C
C  Do preliminary measurements to find peaks and optimize times
C  that will be used for all repitions
	CALL STATUS !$$
	IREP = 0
	CALL PASS0
C
C======================================================================
C
C  LOOP FOR THE REPETITIONS
C
	DO 5000, IREP=1,NREP
	CALL STATUS !$$
C
C   Start the repetition by rewinding the runfile and skipping the first record.
	 REWIND IRUN
	 READ(IRUN,3004) JUNK
3004	 FORMAT(A1)
C
C   Loop to measure peaks.
	 IPEAK=0
4000	  IPEAK = IPEAK + 1
	  IF(IPEAK.GT.MPEAK) GOTO 4900
	  CALL PKSCAN( IEND)
	CALL STATUS !$$
	  IF( IEND.EQ.0) GOTO 4000
C
C======================================================================
C
C  END OF REPETITION, PRINT TIME
4900	CALL SYTIME
	WRITE(ITYP,4904) IREP,NREP,ITIM,IDAT
4904	FORMAT(' END OF REPETITION',I3,' OF',I3,' AT',
     &    I3,':',I2,':',I2,' ON',I3,'/',I2,'/',I2)
C     &    I3,':',I2.2,':',I2.2,' ON',I3,'/',I2,'/',I2.2)
5000	CONTINUE
C
C  END OF MOUNTING
6000	CONTINUE
C
	GOTO 9900
C
C======================================================================
C
C	DATA COLLECTION COMPLETE.  CLEAN UP.
C
9900	CALL FINISH
C
9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE CHEM
C
C  CHEMISTRY (OR MU/RO) IS REQUIRED FOR THE INTENSITY RATIO METHOD
C  Record 6 is elemental composition of the unknown or standard
C  If IFLAG(4) = 0 then record 6 is blank and mu/ro is used instead.
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
3000	IF(IFLAG(4).EQ.0) GOTO 9999
	IF(IFLAG(4).NE.1) WRITE(ITYP,3001) (IFLAG(I),I=1,4)
3001	FORMAT(' >> INVALID CHEMISTRY FLAG << IFLAG =',4I2,/,
     &   ' > It will be corrected for you, but you should know.')
	IF(IFLAG(3).EQ.2) GOTO 3010
	WRITE(ITYP,3004)
3004	FORMAT(' Since you are not doing the intensity ratio method',
     &    ' you do not have to enter chemestry.')
C
C  Prompt for elemental composition
C
3010	WRITE(ITYP,3014)
3014	FORMAT(/,' Please enter the following information on the'
     1	' sample',/,' composition (max. 10 entries, return to'
     2	' finish):',//,'     - ELEMENT SYMBOL IN CAPITOL LETTERS',/
     3	'     - WEIGHT PERCENT IN SAMPLE',/
     4	'     - STANDARD DEVIATION',//
     5	'              EL % WT. S.DEV.',/
     6	' FORM:        AA NN.NN NN.NN',/
     7	' ---------------------------')
C        ELEMENT # II: aa ff.ff ff.ff
C
C  Loop up to 10 times to enter elements
C
	I = 1
C  Prompt for each element
3020	WRITE(ITYP,3024) I
3024	FORMAT(' ELEMENT # ',I2,'? ',$)
C  Read the symbol into IPKFND, wt% into PKTIM, s.dev into BKGTIM
	READ(IRD,3034,END=9500) IPKFND(I),PKTIM(I),BKGTIM(I)
3034	FORMAT(A2,X,F5.2,X,F5.2)
C
C  Blank for first element means we are done
C  this test is only meaningful the first time but so what.
	IF( IPKFND(1).EQ.'  ') GOTO 3200
C  Blank for other elements means no more elements.
	IF( IPKFND(I).EQ.'  ') GOTO 3100
C  End of loop.
	I = I + 1
	IF(I.LE.10) GOTO 3020
C
C  Echo data and confirm that it is right.
C
3100	NCHEM = I-1
	WRITE(ITYP,3104) (I,IPKFND(I),PKTIM(I),BKGTIM(I),I=1,NCHEM)
3104	FORMAT(/,' Sample composition as entered:',/,
     &    4('  EL % WT. S.DEV.  '), 3(/,4(2X,A2,2F6.2)) )
C
	WRITE(ITYP,3114)
3114	FORMAT(' All correct? <Y/N, ret=Y> ?',$)
	READ(IRD,3124,END=9500) IY
3124	FORMAT(A1)
C
	IF(IY.EQ.'N' .OR. IY.EQ.'n') GOTO 3000
C
C Set flag indicating chemestry is present.
	IFLAG(4) = 1
	GOTO 9999
C
C Set flag indicating chemestry is not present.
3200	IFLAG(4) = 0
	GOTO 9999
C
C  Set flag indicating user hit ^Z.
9500	IFLAG(4) = -1
C
9999	RETURN
	END

C**********************************************************************
C
	SUBROUTINE COPY25
C
C	READ THE DIFFRACTOMETER CALIBRATION FILE AND WRITE
C	RECORDS 2 THROUGH 5 OF THE RAW DATA FILE.
C
C	CURRENTLY READS THE OLD CONFIGURATION FILE FORMAT
C	THERE SHOULD ALSO BE A VERSION TO READ DIFFRAC-500 FILE.
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
C	OPEN(UNIT=ICAL,FILE='CONFIG.DAT',STATUS='OLD',READONLY)
	OPEN(UNIT=ICAL,NAME='CONFIG.DAT',TYPE='OLD',SHARED)
C
	DO 7,I=1,4
	READ(ICAL,4) (CNT(J),J=1,32)
	WRITE(IRAW,4) (CNT(J),J=1,32)
7	CONTINUE
4	FORMAT(32A4)
C
	CLOSE(UNIT=ICAL)
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE QBEGIN( IQUIT)
C
C	SET UP FOR A QUANTITATIVE DATA COLLECTION RUN
C
C  OPEN THE RUN AND RAW FILES
C  ASK ANY LAST MINUTE QUESTIONS (or get them from old version of RAW)
C  READ THE CALIBRATION FILE FOR THE DIFFRACTOMETER.
C  INITIALIZE THE INTERFACE
C
C  If the user types control Z in response to any question; this routine
C  will set IQUIT to nonzero and return to main.
C
C=====================================================================
C
C	THE "QUANT" DATA COLLECTION PACKAGE ALLOWS FOR FIVE MODES OF
C	DATA COLLECTION.  THREE ARE FOR QUANTITATIVE ANALYSIS AND TWO
C	ARE FOR SELECTED AREA DATA COLLECTION. THEY ARE:
C
C		INTERNAL STANDARD METHOD (IFLAG(3) = 1)
C		INTENSITY RATIO METHOD   (IFLAG(3) = 2)
C		SPIKING METHOD           (IFLAG(3) = 3)
C		PEAK AND INTEGRATED INT. (IFLAG(3) = 4)
C		CALIBRATION AND PROFILE  (IFLAG(3) = 5)
C
C	NOTE: INTENSITY AND CALIBRATION DATA COLLECTION ARE IDENTICAL.
C	THE DIFFERENT IFLAG VALUES ARE ONLY FOR PURPOSES OF ANALYSIS
C	OF THE RAW DATA.  GENERALLY THE PEAK AND INTEGRATED INTENSITY
C	MODE WILL USED FOR DETERMINATION OF RELATIVE INTENSITIES.
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 /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, IRUN, IRAW of /IO/
C Uses CNT of /ARRAY/
C Uses PANG, PKTIM, BKGTIM, IPKFND, LPEAK of /PKCMN/
C Uses CONC, SCONC, NREC, NREP, NMOUNT of /RUN/
C Uses TITLE, USER, NMRUN, NMRAW, IFLAG of /LOG/
C Uses ITIM, IDAT, ISTIM, IENTIM of /TIME/
C Calls SYOPEN, FLAGS, SYTIME, IFINIT, COPY25
C
C=====================================================================
C
C  THIS IS THE BEGINNING OF A QUANT RUN, SAY HELLO !
C
	WRITE(ITYP,104)
104	FORMAT(/,11X,'** DATA COLLECTION FOR',
     1	' QUANTITATIVE ANALYSIS **',/)
C
C=====================================================================
C
C	OPEN THE RUN FILE AND READ THE FIRST RECORD
C
C  Prompt for the name
1000	WRITE(ITYP,1004)
1004	FORMAT(' Please input the name of the run file',
     1	' you wish to use.',/,' Filename <.RUN> ? ',$)
C
C  Read the name
	READ(IRD,1014,END=9020) NMRUN
1014	FORMAT(128A1)
C
C  Open the file using .RUN as the default extension.
	CALL SYOPEN(IRUN,NMRUN,'.RUN',0)
C
C  READ THE FIRST LINE IN THE RUN FILE
C
	READ(IRUN,1024) TITLE,USER, IDAT,ITIM,
     &	   (IFLAG(I),I=1,4),NREP,NMOUNT
1024	FORMAT(20A4,5A4, 3I2,3I2, 10I1)
C
C  This had better be a run file.
	IF(IFLAG(1).GE.3 .AND. IFLAG(1).LE.5) GOTO 1040
	WRITE(ITYP,1034)
1034	FORMAT(' >> ERROR << THAT IS NOT A RUN FILE.  IFLAG(1)=',I1)
	GOTO 9010
C  This is an output data file for quantitative analysis
C	IFLAG(1) = 1 ! data from unknown (from program runfil)
C	IFLAG(1) = 2 ! data from calibration (from subroutine runfil)
1040	IFLAG(1) = 1
C
C=====================================================================
C
C	OPEN THE RAW DATA FILE
C
C  Prompt for the name
	WRITE(ITYP,1104)
1104	FORMAT(' Please input the name of the output data file',/,
     1	' Filename <.RAW> ? ',$)
C
C  Read the name
	READ(IRD,1014,END=9010) NMRAW
C
C  Create the file using .RAW as the default extension.
	CALL SYOPEN(IRAW,NMRAW,'.RAW',1)
C
C=====================================================================
C
C	GET THE CORRECT RUN TITLE AND USER NAME
C	The title and username are read into the CNT array so if he
C	just hits return we haven't written over the title or
C	username from the run file.
C
C  Run title:
	WRITE(ITYP,2004) TITLE
2004	FORMAT(' Enter the run title of up to 80 characters',/,
     &   ' or hit return to accept this:',/,X,20A4,/,' Title ? ',$)
C
	READ(IRD,2014,END=9000) (CNT(I),I=1,20)
	IF(CNT(1).EQ.'    ' .OR. CNT(1).EQ.'/   ') GOTO 2100
2014	FORMAT(20A4)
C
	DO 2020,I=1,20
2020	TITLE(I) = CNT(I)
C
C  User name:
2100	WRITE(ITYP,2104) USER
2104	FORMAT(' Enter your name <ret=',5A4,'>  ? ',$)
C
	READ(IRD,2014,END=9000) (CNT(I),I=1,5)
	IF(CNT(1).EQ.'    ' .OR. CNT(1).EQ.'/   ') GOTO 4000
C
	DO 2110,I=1,5
2110	USER(I) = CNT(I)
C
C=====================================================================
C IFLAG(3) METHOD   IFLAG 2 RUN TYPE    CONC (was wtprct)  SCONC (was constd)
C 1  internal std     1  unknown	  int.std.            N/A ?
C 1  internal std     2  standards	  int.std.          conc reference
C 2  intens ratio     1  unknown	  u/p sample     u/p reference (nochem)
C 2  intens ratio     2  standards	  u/p sample
C 3  spiking          1  always           spiking phase        N/A
C 4  rel-I run.       3  always		   N/A                 N/A
C 0 and 5 not implemented
C----------------------------------------------------------------------
C
C   Important variables written to record 7: 
C	CONC goes in colums 97-104
C	SCONC goes in colums 121-128
C  Some methods don't use both of these but let's not put junk in the file.
4000	CONC = 1.0
	SCONC = 0.0
C
C  Method 0: pattern collection (not implemented).
C
	IF(IFLAG(3).NE.0) GOTO 4100
	WRITE(ITYP,4004)
4004	FORMAT(' >> You cannot do PATTERN COLLECTION',
     &    ' with this version of the program.')
	GOTO 9000
C
C  Method 1: Internal standard.  Need concentrations of phases.
C
4100	IF(IFLAG(3).NE.1) GOTO 4200
	IF(IFLAG(2).LT.1 .OR. IFLAG(2).GT.2) GOTO 4920
	IF(IFLAG(2).EQ.1) WRITE(ITYP,4114)
4114	FORMAT(' INTERNAL STANDARD METHOD run to analyze an unknown.')
	IF(IFLAG(2).EQ.2) WRITE(ITYP,4124)
4124	FORMAT(' INTERNAL STANDARD METHOD run to measure a standard.',
     &  /,' NOTE: the output from this run must be processed before',
     &  /,' you can analyze an unknown.')
	IFLAG(1) = IFLAG(2)
4130	WRITE(ITYP,4134)
4134	FORMAT(' Enter the concentration of the INTERNAL STANDARD.')
	CALL RDCONC(CONC)
C  No default for CONC, and 0.0 is nonsense.
	IF(CONC.EQ.0.0) GOTO 4130
	IF(CONC.LT.0.0) GOTO 9000
	IF(IFLAG(2).EQ.2) GOTO 4800
C  In a standard run, if the reference phase isn't pure we need to
C  know the concentration.
	WRITE(ITYP,4144)
4144	FORMAT(' Enter what the concentration of the phase you',/,
     &   ' are interested in was in the sample before the internal',/,
     &   ' standard was added.  <return=1.0>')
	CALL RDCONC(SCONC)
	IF(SCONC.EQ.0.0) SCONC = 1.0
	IF(SCONC.LT.0.0) GOTO 9000
	GOTO 4800
C
C  Method 2: Intensity ratio.
C
C We don't store any concentrations here.  The concentration is 1.0 for
C the standard runs, and unknown for the unknown runs.
C Store mu/rho of the standard for the standard runs; store mu/rho of the
C unknown (whole sample) for the unknown runs.  If IFLAG(4)=1, then chemistry
C is stored instead of mu/rho.
C
4200	IF(IFLAG(3).NE.2) GOTO 4300
	IF(IFLAG(2).LT.1 .OR. IFLAG(2).GT.2) GOTO 4920
	IFLAG(1) = IFLAG(2)
	IF(IFLAG(2).NE.1) GOTO 4250
	WRITE(ITYP,4214)
4214	FORMAT(' INTENSITY RATIO METHOD run to analyze an unknown.')
	IF(IFLAG(4).EQ.1) GOTO 4800
	WRITE(ITYP,4254)
4224	FORMAT(' Enter the mass absorption coeff. of this mixture.')
	READ(IRD,4234,END=9000) CONC
4234	FORMAT(F8.3)
	IF(CONC.EQ.0.0) IFLAG(4) = 1
C SCONC will be taken from each record in the run file.
	GOTO 4800
4250	WRITE(ITYP,4254)
4254	FORMAT(' INTENSITY RATIO METHOD run to measure a pure standard.',
     &  /,' NOTE: the output from this run must be processed before',
     &  /,' you can analyze an unknown.')
	IF(IFLAG(4).EQ.1) GOTO 4800
	WRITE(ITYP,4264)
4264	FORMAT(' Enter the mass absorption coeff. of this standard.')
	READ(IRD,4234,END=9000) CONC
C  If mu/rho isn't given then chemistry must be.
	IF(SCONC.EQ.0.0) IFLAG(4) = 1
C  Program Runfil will copy mu/rho sample into mu/rho standard in the
C  runfile to analyze an unknown.  For now, leave it blank.
	SCONC = 0.0
	GOTO 4800
C
C  Method 3: Spiking.  We only need the concentration of the spiking phase.
C
4300	IF(IFLAG(3).NE.3) GOTO 4400
	WRITE(ITYP,4304)
4304	FORMAT(' SPIKING METHOD')
	IF(IFLAG(2).NE.1) GOTO 4920
	IFLAG(1) = 1
	WRITE(ITYP,4314)
4314	FORMAT(' Enter the concentration of the spiking phase.')
	CALL RDCONC(CONC)
	IF(CONC.LT.0.0) GOTO 9000
C SCONC is not used.
	GOTO 4800
C
C  Method 4: Relative intensity measurement; not for quant analysis.
C
4400	IF(IFLAG(3).NE.4) GOTO 4500
	WRITE(ITYP,4404)
4404	FORMAT(' RELATIVE INTENSITY MEASUREMENT')
	IF(IFLAG(2).NE.3) GOTO 4920
	IFLAG(1) = 1
C  CONC and SCONC are meaningless in this case.
	GOTO 4800
C
C  Method 5: Profile measurement (not implemented)
C
4500	IF(IFLAG(3).NE.5) GOTO 4930
	WRITE(ITYP,4504)
4504	FORMAT(' >> You cannot do PROFILE MEASUREMENT',/,
     &    ' with this version of the program.')
C	IFLAG(1) = 6
	GOTO 9000
C
C  Enter chemistry for record 6 if necessary. (routine tests flags)
C
4800	CALL CHEM
	IF(IFLAG(4).LT.0) GOTO 9000
C  Chemistry or mu/ro is required for intensity ratio method.
	IF(IFLAG(3).EQ.2 .AND. IFLAG(4).EQ.0) GOTO 4200
	GOTO 5000
C
C  Illegal run type for this method.
C
4920	WRITE(ITYP,4924) IFLAG(2), (IFLAG(J),J=1,4)
4924	FORMAT(' >> ERROR << invalid run type flag for this method.',/,
     &   ' > IFLAG(2) =',I2,'     IFLAG(1 to 4) ='4I2)
	GOTO 9000
C
C  Illegal method flag.
C
4930	WRITE(ITYP,4934) IFLAG(3), (IFLAG(J),J=1,4)
4934	FORMAT(' >> ERROR << unrecognized method code in run file.',/,
     &    ' > IFLAG(3) =',I2,'     IFLAG(1 to 4) =',4I2)
	GOTO 9000
C
CC----------------------------------------------------------------------
CC----------------------------------------------------------------------
CC----------------------------------------------------------------------
CC  REQUEST WT FRACTION OF REFERENCE OR SPIKING PHASE
CC  This dialog must be clarified!!!
CC
CC------------------------------ CONC -----------------------
C4000	CONC = 1.0
C	IF ((IFLAG(3).NE.1) .AND. (IFLAG(3).NE.3)) GOTO 4150
CC		  v------^     v---------------^
CC    INTERNAL STANDARD OR SPIKING METHOD - ENTER CONCENTRATION OF PHASE
CC
C4100	WRITE(ITYP,4110)
C4110	FORMAT(/,' ENTER WT FRACTION OF REFERENCE OR SPIKING PHASE'
C     1	'(F7.3)',/,' ? ',$)
CC
C	READ(IRD,10020) CONC
C10020	FORMAT(F7.3)
C	IF ((CONC.LT.0.0). OR. (CONC.GT.1.0)) GOTO 4100
CC
CC -------------------------- SCONC -------------------------
CC Do this one first; Mu/ro should immediatly follow chem.
CC If he/she/it hits return for Mu/ro branch back to 3010
CC  IF THIS IS A STANDARD RUN GET THE CONCENTRATION OF THE STANDARD
CC   Is the default 0.0?
C4150	IF (IFLAG(2).NE.2) GOTO 5000  ! run to measure standards
C	IF (IFLAG(3).EQ.2) GOTO 4170  ! Intens ratio method
CC
C	WRITE(ITYP,4160)
C4160	FORMAT(/,' ENTER THE CONCENTRATION OF THE STANDARD BEING RUN'
C     1	,/,' ? ',$)
CC
C	READ(IRD,10020) SCONC
C	GOTO 5000
CC
C4170	IF (IFLAG(4).EQ.1) GOTO 5000  ! Chem present on rec 6
C	WRITE(ITYP,4180)
C4180	FORMAT(/,' ENTER THE MASS ABSORPTION COEFF. OF THE STANDARD'
C     1	,/,' ? ',$)
CC
C	READ(IRD,10020) SCONC
C
C======================================================================
C
C  WHICH LINES ON THE RUN FILE ARE TO BE DETERMINED ?
C
C  All lines will be measured if rel. int. or calibration run)
5000	IF (IFLAG(3).GT.3) GOTO 5050
C
	WRITE(ITYP,5004)
5004	FORMAT(' Enter the number of each line to be measured',/,
     1	' <ret= all lines> (20I) ? ',$)
C
C  Scratch array needed here.  use IPKFND.
	READ(IRD,5024) (IPKFND(I),I=1,20)
5024	FORMAT(20I)
C
C  If first line # was 0; she hit return: do all lines.
C  All you femminists take note that I used "she" this time.
C  Next time I'm saying "it" because "it" is neuter.
	IF( IPKFND(1).EQ.0) GOTO 5050
C
C  Set flags to skip all lines then change the ones we should measure.
	DO 5030, I=1,20
5030	  LPEAK(I) = .FALSE.
	DO 5040, I=1,20
	  IPEAK = IPKFND(I)
	  IF( IPEAK.GT.0 .AND. IPEAK.LE.20) LPEAK(IPEAK) = .TRUE.
5040	CONTINUE
C  Skip over where all lines are set.
	GOTO 5500
C
C  Do all lines if it hit return or if doing a rel. int. or calibration run.
5050	DO 5060, I=1,20
5060	LPEAK(I) = .TRUE.
C
C=====================================================================
C
C  INPUT THE NUMBER OF REPETIONS AND MOUNTINGS FOR THIS SAMPLE
C
C  Default is 1 & 1 unless these are given in the run file.
5500	IF(NREP.EQ.0) NREP = 1
	IF(NMOUNT.EQ.0) NMOUNT = 1
C
C  Read number of repetitions.
	WRITE(ITYP,5514) NREP
5514	FORMAT(/,' ENTER NO. OF REPETIONS <ret=',I1,'> ? ',$)
	READ(IRD,5524) IANS
5524	FORMAT(I)
	IF(IANS.NE.0) NREP = IANS
C
C  Read number of mountings.
	WRITE(ITYP,5534) NMOUNT
5534	FORMAT(' ENTER NO. OF MOUNTINGS <ret=',I1,'> ? ',$)
	READ(IRD,5524) IANS
	IF(IANS.NE.0) NMOUNT = IANS
C
C======================================================================
C
C   INITIALIZE THE INTERFACE AND WRITE THE FIRST 6 RECORDS OF THE RAW FILE
C
	CALL IFINIT( IQUIT)
	IF( IQUIT.NE.0) GOTO 9000
C
C   WRITE THE FIRST 6 RECORDS OF THE FILE
C
C   Rec 1 is run title, user name, flags, & runfile name.
	CALL SYTIME
	WRITE(IRAW,6104) TITLE,USER, IDAT,ITIM, (IFLAG(I),I=1,4),
     &    NREP,NMOUNT,0,0,0,0,(NMRUN(I),I=1,6)
6104	FORMAT(20A4,5A4, 3I2,3I2, 10I1, 6A1)
C
C   Records 2 through 5 are from the diffractometer configuration file.
C
	CALL COPY25
C
C   Record 6 is the chemestry data or blank (depending on IFLAG(4))
	IF(IFLAG(4).EQ.0) WRITE(IRAW,6604)
6604	FORMAT(128(' '))
	IF(IFLAG(4).NE.0) 
     &     WRITE(IRAW,6614) (IPKFND(I),PKTIM(I),BKGTIM(I),I=1,NCHEM)
C  Make sure record length is 128.
6614	FORMAT(128(' '),T1,10(A2,2F5.2))
C
	NREC = 6
C
C======================================================================
C
C  LAST THING BEFORE LEAVING: CLEAR ARRAYS EXCEPT FOR LPEAK
C  Everything gets set up to function properly elsewhere before it is
C  used.  The only reason we do this is so that CALL STATUS won't print junk.
C
	DO 7010, I=1,20
	IPKFND(I) = 0
	BKGTIM(I) = 0.0
	PKTIM(I) = 0.0
	PANG(I) = 0.0
	CNT(I) = 0.0
	CNT(I+20) = 0.0
7010	CONTINUE
C
	DO 7020, I=1,6
C  CNT(45 & 46) get cleared twice; that's cheap.
	CNT(40+I) = 0.0
	CNT(44+I) = 0.0
	IENTIM(I) = 0
	ISTIM(I) = 0
7020	CONTINUE
C
	GOTO 9999
C
C=====================================================================
C
C  RETURNS
C
C  Return to main if user types ^Z or an error occurs.
9000	CLOSE(UNIT=IRAW, DISPOSE='DELETE')
9010	CLOSE(UNIT=IRUN)
9020	WRITE(ITYP,9024)
9024	FORMAT(' RUN CANCELED')
	IQUIT = 1

C  THAT'S ALL SHE WROTE ....
C
9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE RDCONC(WTFR)
C
C	READ A WEIGHT FRACTION AND MAKE SURE IT'S REASONABLE
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 of /IO/
C
 1	WRITE(ITYP,4)
 4	FORMAT(' Enter weight fraction (F8.4) ? ',$)
	READ(ITYP,14,END=9000) WTFR
14	FORMAT(F8.4)
	IF(WTFR.GE.0.0 .AND. WTFR.LE.1.0) GOTO 9999
	WRITE(ITYP,24)
24	FORMAT(' Weight fraction must be between 0.0 & 1.0',
     &   ' with decimal point.')
	GOTO 1
C ^Z means quit.  Assign a silly value that main can test for.
9000	WTFR = -1.0
9999	RETURN
	END

C***********************************************************************
C
	SUBROUTINE OPTIM
C
C		COUNT OPTIMIZATION ROUTINE
C
C	DESCRIPTION:
C     THIS ROUTINE OPTIMIZES THE TIME SPENT COUNTING THE PEAK AND
C  BACKGROUND POINTS IN EITHER FIXED TOTAL TIME MODE OR FIXED ERROR
C  MODE.  IN FIXED ERROR MODE THE TOTAL TIME IS CONSTRAINED TO BE
C  LESS THAN LIMTIM.  IF THE TOTAL TIME CALCULATES TO BE GREATER THEN
C  THE ROUTINE CONVERTS TO FIXED TIME OPTIMIZATION.
C  ## This routine was taken from the old version with little modification.
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
C Uses NBG, NPK, FIXERR, CNT(1), CNT(2), TIMLIM, IPK, BANG, EANG, DANG
C Uses outputs: BKGTIM(IPEAK), PKTIM(IPEAK), FIXERR
C
C***********************************************************************
C
C  DETERMINE THE NUMBER OF BACKGROUND POINTS TO BE COLLECTED
C
	NPTBG=NBG
	IF (EANG.EQ.0.0) NPTBG=NBG+NBG
C
C  DETERMINE THE NUMBER OF PEAK OR SCAN POINTS TO BE COLLECTED
C
	NPTPK=NPK
	IF (IPK.EQ.0) NPTPK=IFIX(((EANG-BANG)/DANG)+1.0-NPTBG)
C
C***********************************************************************
C
C  TEST IF BACKGROUND POINT WAS MEASURED. IF NOT SET R AND RINV TO 0.0
C  AND SKIP THE RATIO CALCULATION
C
	R    = 0.0
	RINV = 0.0
	IF (NPTBG.EQ.0) GOTO 100
C
C  CALCULATE THE RATIO OF PEAK TO BACKGROUND INTENSITIES
C
	R = SQRT(CNT(2)/CNT(1))
	IF (R.LT.1.0) R = 1.0
	RINV = 1.0/R
C
C***********************************************************************
C
C  BRANCH TO THE PROPER COUNT MODE ROUTINE
C
100	IF (FIXERR.EQ.0.0) GOTO 200
C
C***********************************************************************
C
C  WE ARE IN THE FIXED ERROR MODE.  CHECK THAT PEAK AND BKG
C  COUNTS ARE DIFFERENT - IF NOT CONVERT TO FIXED TIME MODE
C
	IF (CNT(1).GE.CNT(2)) GOTO 200
C
C  COMPUTE THE PEAK COUNT TIME (IN SECONDS) FOR FIXED ERROR MODE
C
	TOTIME = (CNT(2)+R*CNT(1)) / ((FIXERR*FIXERR/10000.)*
     1	(CNT(2)-CNT(1))*(CNT(2)-CNT(1)))
C
C***********************************************************************
C
C  IF THE TIME REQUIRED IS STILL UNDER THE LIMIT THEN GO TO THE
C  FINAL CALCULATION SECTION
C
	IF (((TOTIME+TOTIME*RINV)/60.).LE.TIMLIM) GOTO 300
C
C***********************************************************************
C
C  WE ARE IN FIXED TIME MODE (TIMLIM IS IN MINUTES) DETERMINE
C  COUNT TIME = TIME IN SECONDS.
C
200	CONTINUE
C
D	IF (FIXERR.GT.0.0 .AND. IBUG.GT.0 ) WRITE(IBUG,210)
D210		FORMAT('  >> OPTIM <<  CONVERTED FROM FIXED ERROR '
D    1		'TO FIXED TIME MODE.')
C
	FIXERR = 0.0
C
	TOTIME = 60.0*TIMLIM / (1.0+RINV)
C
C***********************************************************************
C
C  NOW COMPUTE THE BACKGROUND COUNT TIME FOR BOTH MODES
C
C  IF THE MAXIMUM TIME COUNT ALLOWED IN THE SCALER USING A TIME
C  BASE OF .01 SEC IS EXCEEDED DEFAULT TO MAX TIME OF 9000.
C
300	IF (TOTIME/NPTPK.GT.9000.) TOTIME = 9000.*NPTPK
C
	PKTIM(IPEAK) = TOTIME/NPTPK
C
	BKGTIM(IPEAK) = 0.0
	IF (NPTBG.EQ.0) GOTO 9999
	BKGTIM(IPEAK) = TOTIME / (NPTBG * R)
C
C***********************************************************************
C
C  DEBUG PRINT OUT
C
9999	CONTINUE
C
D	IF(IBUG.NE.0) WRITE(IBUG,510) IPEAK,CNT(1),CNT(2),FIXERR,
D    1	TIMLIM,NPTPK,NPTBG,PKTIM(IPEAK),BKGTIM(IPEAK)
D510	FORMAT(' >> DEBUG0 <<  OPTIM RESULTS FOR PEAK #',I3,/,
D    1  ' > BKG CNTS:',4X,F8.0,7X,'PEAK CNTS: ',3X,F8.0,/,
D    2  ' > COUNT ERROR:',5X,F6.2,5X,'TIME LIMIT:',7X,F6.2,/,
D    3  ' > # PEAK PTS:',4X,I5,8X,'# BKG PTS:',6X,I5,/,
D    4  ' > PEAK CNT TIME: ',F8.2,5X,'BKG CNT TIME:',3X,F8.2)
C
C***********************************************************************
C
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE PASS0
C
C	DO THE PRELIMINARY MEASUREMENTS ON A PEAK TO 
C	FIND THE EXACT POSITION (PANG) IF NECESSARY
C	AND OPTIMIZE THE COUNTING TIMES (BKGTIM & PKTIM)
C	$$ While we are here estimate the finishing time.
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 ITYP, IRUN, ITIM,IDAT, IPEAK,NPEAK, MPEAK, LPEAK, IPKFND, ISTIM,IENTIM
C Calls IFANGL, IFMOVE, IFCNT, IFSPED, IFINTE, OPTIM, PKFIND, SYTIM, TIMFIX.
C
	DIMENSION JKL(3)
	BYTE NAM(6)
C
	DELPK = 0.0
C
C   Make sure we have the first peak in the run file
	REWIND IRUN
	READ(IRUN,4) JUNK
4	FORMAT(A1)
C
C  Announce start of run.
	CALL SYTIME
	WRITE(ITYP,104) ITIM, IDAT
104	FORMAT(' PRELIMINARY PASS STARTED AT',
     &   I3,':',I2,':',I2,' ON',I3,'/',I2,'/',I2)
C     &   I3,':',I2.2,':',I2.2,' ON',I3,'/',I2,'/',I2.2)
C
C   Loop through all peaks
	IPEAK = 0
1000	IPEAK = IPEAK + 1
C
C======================================================================
C
C	DO A PEAK
C
C   Read the records from the RUN file.
C
      READ(IRUN,1004,END=2000) BANGD,PANGD,EANGD, DANGD, RATE, MVCNT, 
     1	TIMLIM, FIXERR, CNTLIM, NAM, JKL, KODE,IOVLP,IPK, NPK,NBG,
     2	FREL, SIGREL, STD, SIGSTD, JUNK
1004  FORMAT(3F7.3,F7.4,F4.1,I1, 
     1  F5.1,F5.2,F7.0,6A1,3I2,3I1,2I2,
     2	F6.1,F4.1,F9.4,F8.4, /,A1)
C
C   Make sure we are supposed to be doing this peak.
C
	IF(.NOT.LPEAK(IPEAK)) GOTO 1000
C
C  Convert the angles from degrees to steps.  (No round off error with 
C  whole numbers because they can be represented exactly in binary.)
C
	CALL IFANGL( BANGD, BANG)
	CALL IFANGL( PANGD, PANG(IPEAK))
	CALL IFANGL( EANGD, EANG)
	CALL IFANGL( DANGD, DANG)
C
C   PEAK FINDING
C
C   In peak height mode, we either find the peak . . .
	IF(IPK.EQ.1) CALL PKFIND( PANG(IPEAK), DANG, DELPK, IFOUND)
C   or assume a displacement equal to last peak found.
	IF(IPK.EQ.2) PANG(IPEAK) = PANG(IPEAK) + DELPK
C
C   OPTIMIZE COUNT TIMES
C
C   Count background point for 1 second with no count limit.
	CALL IFMOVE( BANG, 0.0)
	CALL IFCNT ( 1.0, BTIM, 0.0, CNT(1))
C   Integrate over the peak using default integration speed.
	CALL IFINTE( BANG, EANG, 0.0)
C   Convert to counts per second.
	CNT(2) = COUNTS / CTIME
C   Take the two counts and calculate the optimum count times
	CALL OPTIM
C
C   Tens digit of IPKFND(IPEAK) indicates fixed time or fixed error mode.
	IPKFND(IPEAK) = 10
	IF(FIXERR.GT.0.0) IPKFND(IPEAK) = IPKFND(IPEAK) + 10
C   One's digit of IPKFND(IPEAK) indicates how well peak was found.
	IF(IPK.EQ.1) IPKFND(IPEAK) = IPKFND(IPEAK) + IFOUND
C
C   Go do next peak.
	IF(IPEAK.LT.MPEAK) GOTO 1000
C
C   Check to see if we are at end of file.
	READ(IRAW,1004,END=2000) BANGD
C   No, we weren't.  Print a warning that we won't go any farther.
	WRITE(IERR,1904) IPEAK
1904	FORMAT(' >> WARNING << End of run file not hit after',I3,
     &   ' peaks.')
C
C======================================================================
C
C   FINISHED ALL PEAKS.
C
C   Keep track of how many peaks there are
2000	NPEAK = IPEAK
C
C   Print estimated time this mounting will be done.
	CALL SYTIME
	WRITE(ITYP,2004) ITIM, IDAT
2004	FORMAT(' PRELIMINARY PASS COMPLETED AT',
     &    I3,':',I2,':',I2,' ON',I3,'/',I2,'/',I2)
C     &    I3,':',I2.2,':',I2.2,' ON',I3,'/',I2,'/',I2.2)
	ITIM(2) = ITIM(2) + MINUTS
	CALL TIMFIX
	WRITE(ITYP,2104) HOURS, ITIM(1),ITIM(2), IDAT
2104	FORMAT(' THIS MOUNTING SHOULD TAKE', F6.2,' HOURS',
     &    ' AND FINISH AT',
     &    I3,':',I2,' ON',I3,'/',I2,'/',I2)
C     &    I3,':',I2.2,' ON',I3,'/',I2,'/',I2.2)
C
C======================================================================
C
C  All done here.
9999	RETURN
	END
C***********************************************************************
C
	SUBROUTINE PKFIND( PANG1, DANG, DELPK, IFOUND)
C
C	PEAK LOCATOR ROUTINE
C
C		THIS ROUTINE PERFORMS A SEARCH FOR A PEAK NEAR
C	   THE EXPECTED POSITION.  THE SEARCH RANGE IS FROM THE
C	   EXPECTED PEAK POSITION (PANG1) MINUS DANG*25 TO THE EXPECTED
C	   POSITION PLUS DANG*24 GIVING A TOTAL OF 50 POINTS FOR
C	   EACH PEAK.  THE DATA IS THEN SMOOTHED AND SEARCHED FOR
C	   PEAK.
C
C  IFOUND is the returned status and will go in column 120 of record 7.
C		= 0  This routine not called.
C		= 1  Peak located within the smoothed region.
C		      in this case update DELPK, the latest peak
C		      shift from initial peak angle PANG1.
C		= 2  Peak located at extremes of search range,
C		      i.e., in the unsmoothed portion which is the
C		      first and last 6 points for the 13 pt smooth.
C		= 3  Peak not located.
C  	PASS0 stores IFOUND as the units digit of IPKFND(IPEAK)
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 /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 ICOUNT, ICNT, IBUG
C Uses PANG1, as a dummy variables
C Calls SMTH13 to smooth the data;
C Calls IFSSCN with Subroutine STRCNT as an argument.
	EXTERNAL STRCNT
C
C======================================================================
C
C  COLLECT THE 50 DATA POINTS AT 1/2 SEC EACH POINT.
C
	BANG = PANG1 - 25.0*DANG
	ICOUNT = 0
	CALL IFSSCN(BANG,-50.0,DANG,0.0,0.5,0.0,STRCNT)
C
C  DATA COLLECTION IS NOW COMPLETED.  SMOOTH THE DATA.
C
	CALL SMTH13
C
C  SEARCH THE SMOOTHED DATA FOR THE LARGEST VALUE.  NOTE: THE FIRST 6
C  AND THE LAST 5 POINTS WERE NOT SMOOTHED.  IF THE PEAK LIES IN THESE
C  EXTREMES A FLAG IS RETURNED TO THE CALLING PROGRAM.
C
	IMAX = 0
	AMAX  = 0
	DO 210 I= 1,50
	IF(CNT(I).LT.AMAX) GOTO 210
	AMAX = CNT(I)
	IMAX= I
210	CONTINUE
C
C  WAS A PEAK FOUND ?
	IFOUND = 3
	IF (AMAX.LT.10) GOTO 9999
C
C  PEAK WAS FOUND. CALCULATE THE POSITION
C
	DEL = (IMAX - 26) * DANG
	PANG1 = PANG1 + DEL
C
C  IS THE PEAK AT EXTREMES WHERE NO SMOOTHING WAS PERFORMED ?
	IFOUND = 2
	IF ((IMAX.LT.7) .OR. (IMAX.GT.44)) GOTO 9999
C
C  PEAK LOCATED WITHIN SMOOTHED REGION,
C  UPDATE DELPK SINCE PEAK IS WELL DETERMINED
C
	IFOUND = 1
	DELPK = DEL
C
C======================================================================
C
C	DEBUG DISPLAY OF RESULTS WHEN RETURNING
C
9999	CONTINUE
D	IF(IBUG.NE.0) WRITE(IBUG,9994) PANG1,IFOUND,DEL,IMAX,AMAX,TIME
D9994	FORMAT(' >> DEBUG0 <<  PKFIND RESULTS: PANG1 = ',F9.4,
D    1	' IFOUND=',I3,/,' > PEAK DELTA=',F7.2,' PT #=',I3,
D    2	' PEAK CNTS=',F8.0,' TIME=',F7.2)
C
	RETURN
	END
C***********************************************************************
C
	SUBROUTINE SMTH13
C
C	PEAK SMOOTHING ROUTINE
C
C		THIS ROUTINE PERFORMS A 13 POINT SAVITSKY-GOLAY
C	   SMOOTH ON 50 DATA POINTS.  THIS SIZE GROUP IS WHAT IS
C	   COLLECTED BY SUBROUTINE PKFIND AROUND THE APPROXIMATE
C	   PEAK POSITION.
C	## This was taken from the old version.
C
C  CONVOLUTING INTEGERS ARE -11,0,9,16,21,24,25
C  NORMALIZING FACTOR IS    143	(= (N-1)**2 - 1  WHERE N=13 HERE)
C
C  FLOATING POINT ARITHMETIC IS USED TO AVOID THE OVERFLOW
C  THAT OCCURS USING 16 BIT INTEGERS (I*2).
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 /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 CNT of /CNTCMN/ as the array of intensity values to be smoothed.  
C The smoothed values are to be returned in the same array.
C
	DIMENSION SAVE(6)
C  SAVE = a scratch array for saving data values so that the 
C         smoothed values can be placed back into the CNT array.
C
C======================================================================
C
C  MOVE THE FIRST SIX RAW DATA POINTS INTO THE SCRATCH ARRAY
C
	DO 10 I=1,6
10	SAVE(I) = CNT(I)
C
C  TOP OF THE SMOOTHING LOOP
C
	DO 30 I=1,38
C
C======================================================================
C
C	CALCULATE THE SMOOTHED POINT
C
	SUM =     - 11.0 * (SAVE(1) + CNT(I+12))
	SUM = SUM +  9.0 * (SAVE(3) + CNT(I+10))
	SUM = SUM + 16.0 * (SAVE(4) + CNT(I+ 9))
	SUM = SUM + 21.0 * (SAVE(5) + CNT(I+ 8))
	SUM = SUM + 24.0 * (SAVE(6) + CNT(I+ 7))
	SUM = SUM + 25.0 *  CNT(I+6)
C
C
C  SHIFT VALUES IN THE SCRATCH DATA ARRAY
C
	DO 20 J=1,4
20	SAVE(J) = SAVE(J+1)
C
C  GET THE NEXT VALUE FROM THE DATA
C
	SAVE(6) = CNT(I+6)
C
C  STORE THE SMOOTHED DATA POINT BACK IN THE DATA ARRAY
C
	CNT(I+6) = SUM/143.0
C
C======================================================================
C
C  BOTTOM OF THE SMOOTHING LOOP
C
30	CONTINUE
C
	RETURN
	END

C***********************************************************************
C
	SUBROUTINE STRCNT
C
C   THIS IS CALLED BY IFSSCN AT EACH STEP TO STORE COUNTS IN ARRAY CNT.
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 COUNT, ISTEP, CNT, IERR
C
	IF(ISTEP.GT.50) GOTO 9000
	CNT(ISTEP) = COUNTS
	GOTO 9999
C
9000	WRITE(IERR,9004) ISTEP
9004	FORMAT(' >> PROGRAM ERROR IN PKFIND << ISTEP =',I5)
C
9999	RETURN
	END
C***********************************************************************
C
	SUBROUTINE TIMFIX( IDAT, ITIM)
C
C		FIX TIME & DATE AFTER ARITHEMETIC.
C
C	 The program puts the sum of times into ITIM & IDAT and let
C	this routine worry about the carries.
C
C  This routine adds the estimated run time to the present time
C  and calculates the date and time that the job will be completed
C
C  THE RESULT IS STORED IN THE ARRAY AS:
C
C	ITIM(1) = Hour    ITIM(2) = Minute   ITIM(3) = Second
C	IDAT(1) = Month   IDAT(2) = Day      IDAT(3) = Year
C
	IMPLICIT INTEGER*2 (I-N)
	INTEGER ITIM(3), IDAT(3)
C
C======================================================================
C
C	FIRST DO THE TIME.  DIVISION AND THE MOD FUNCTION MAKE THIS EASY.
C
C   Add the carry from time to minutes.
	ITIM(2) = ITIM(2) + ITIM(3) / 60
C   Store the remaining seconds.
	ITIM(3) = MOD( ITIM(3), 60)
C
C   Handle minutes and hours.
	ITIM(1) = ITIM(1) + ITIM(2) / 60
	ITIM(2) = MOD( ITIM(2), 60)
C
C   Carry extra hours into days
	IDAT(2) = IDAT(2) + ITIM(1) / 24
	ITIM(1) = MOD( ITIM(1), 24)
C
C======================================================================
C
C	NOW THE HARD PART -- HOW MANY DAYS IN EACH MONTH?
C	## This piece is from the original.
C
	IMON = IDAT(1)
	IDAY = IDAT(2)
	IYR  = IDAT(3)
C
C  ALL MONTHS CAN HAVE 28 OR FEWER DAYS
C
200	IF (IDAY.LT.29) GOTO 300
C
C  FOR MONTHS OF 30 DAYS
C
	IF ((IMON.NE.4).AND.(IMON.NE.6).AND.
     1	(IMON.NE.9).AND.(IMON.NE.11)) GOTO 210
C
	IF (IDAY.LT.31) GOTO 300
	IMON = IMON + 1
	IDAY = IDAY - 30
	GOTO 300
C
C  FOR MONTHS OF 31 DAYS
C
210	IF (IMON.EQ.2) GOTO 220
C
	IF (IDAY.LT.32) GOTO 300
	IMON = IMON + 1
	IDAY = IDAY - 31
	GOTO 300
C
C  HANDLE THE ODDBALL FEBRUARY SEPERATELY
C
220	IF ((IDAY.LT.30).AND.(IYR.EQ.4*INT(IYR/4.0))) GOTO 300
	IMON = 3
	IDAY = IDAY - 28
	IF (IYR.EQ.4*INT(IYR/4.0)) IDAY = IDAY - 1
C
	IDAT(1) = IMON
	IDAT(2) = IDAY
C
C======================================================================
C
C  JUMP TO A NEW YEAR IF NECESSARY
C
300	IDAT(3) = IDAT(3) + IDAT(1) / 12
	IDAT(1) = MOD( IDAT(1), 12)
C
C  Let's just worry about this century.
	IDAT(3) = MOD( IDAT(3), 100)
C
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE PKSCAN( IEND)
C
C	THESE ARE THE IMPORTANT MEASUREMENTS ON A PEAK
C	FIRST SOME BACKGROUND POINTS ARE MEASURED ON THE LOW ANGLE SIDE,
C	THEN SOME POINTS ARE MEASURED AT THE TOP OF THE PEAK
C	THEN OPTIONALLY SOME MORE BACKGROUND POINTS ARE MEASURED ON THE HIGH
C	ANGLE SIDE.
C
C======================================================================
C
C
C	The argument IEND is set to 1 if the end of the run file is hit, 
C   otherwise IEND is set to 0 to indicate the peak was measured.  
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 /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 ICOUNT, NREC, STPSIZ, BKGTIM, PKTIM, IPKFND, LPEAK, CONC, SCONC.
C Calls IFANGL, IFSPED, WRREC;
C Calls IFSSCN with subroutine WRCNT as an argument.
C
	EXTERNAL WRCNT
	BYTE NAM(6)
	DIMENSION JKL(3)
C
C======================================================================
C
C	PROCESS THE LINE PARAMETERS RECORD OF THE FILES
C
C   Read the records from the RUN file.
C
	READ(IRUN,104,END=9000) BANGD, PANGD, EANGD, DANGD, RATE, MVCNT,
     1	TIMLIM, FIXERR, CNTLIM, NAM, JKL, KODE, IOVLP, IPK, NPK, NBG,
     2	FREL, SIGREL, STD, SIGSTD, SCONC1, ICHEM
104	FORMAT(3F7.3,F7.4,F4.1,I1,
     1  F5.1,F5.2,F7.0,6A1,3I2,3I1,2I2,
     2	F6.1,F4.1,F9.4,F8.4, 12X, F8.3,/,128A1)
C
C  Copy mu/rho of standard if analyzing unknown by intensity ratio.
C $$ Or, if internal standard method, copy concentration of standard.
	IF( (IFLAG(3).EQ.2.OR.IFLAG(3).EQ.1) .AND.
     &     IFLAG(2).EQ.1) SCONC = SCONC1
C
C   End of file not hit.
	IEND = 0
C
C   Make sure we are supposed to be doing this peak.
C
	IF( .NOT.LPEAK(IPEAK)) GOTO 9999
C
C  Convert the angles from degrees to steps.  (No round off error with 
C  whole numbers because they can be represented exactly in binary.)
	CALL IFANGL( BANGD, BANG)
	CALL IFANGL( EANGD, EANG)
	CALL IFANGL( DANGD, DANG)
C
C   The values written to the file should be rounded off to what the
C   interface actually used.
	BANGD = BANG * STPSIZ
	PANGD = PANG(IPEAK) * STPSIZ
	EANGD = EANG * STPSIZ
	DANGD = DANG * STPSIZ
	CALL IFSPED( RATE, RATE)
C
C   Write the line parameters and chemestry information to the raw file.
C
	WRITE(IRAW,4010) BANGD, PANGD, EANGD, DANGD, RATE, MVCNT,
     1	TIMLIM, FIXERR, CNTLIM, NAM, JKL, KODE, IOVLP, IPK, NPK, NBG, 
     2  FREL, SIGREL, STD, SIGSTD, 
     3	CONC, PKTIM(IPEAK),BKGTIM(IPEAK), IPKFND(IPEAK), SCONC, ICHEM
4010	FORMAT(3F7.3,F7.4,F4.1,I1,
     1  F5.1,F5.2,F7.0,6A1,3I2,3I1,2I2,
     2	F6.1,F4.1,F9.4,F8.4, 
     3  F7.3,2F7.2,I2,F7.3, /,128A1)
	NREC = NREC + 2
C
C======================================================================
C
C	MAKE THE MEASUREMENTS
C
C   Start at beginning of counts array.
	ICOUNT = 0
C
C   Measure the low angle background.
C
	BG2 = - FLOAT(NBG)
	CALL IFSSCN(BANG,BG2,DANG,RATE,BKGTIM(IPEAK),CNTLIM,WRCNT)
C
C   Measure the top of the peak.
C
	SANG = PANG(IPEAK) - DANG * (NPK/2)
	PK2 = - FLOAT(NPK)
	CALL IFSSCN(SANG,PK2,DANG,RATE,PKTIM(IPEAK),CNTLIM,WRCNT)
C
C   Measure the high angle background if necessary
C
	IF(EANGD.EQ.0.0) GOTO 8000
	SANG = EANG - DANG * (NBG-1)
	CALL IFSSCN(SANG,EANG,DANG,RATE,BKGTIM(IPEAK),CNTLIM,WRCNT)
	GOTO 8000
C
C   Write the last line of counts.
8000	IF(ICOUNT.GT.0) CALL WRREC
C
C======================================================================
C
C   End of run file
9000	IEND = 1
C
C  All done here.
9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE WRCNT
C
C	THIS IS CALLED BY IFSSCN AT EACH STEP TO DEAL WITH THE COUNTS.
C	WHEN 16 COUNTS HAVE BEEN COLLECTED, THE LINE IS WRITTEN TO A FILE.
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 COUNTS, TIME, ICOUNT, CNT, IFSTAT, ANGLE, STPSIZ, IERR
C Calls WRREC.
C
 	IF( IFSTAT.EQ.4 .OR. IFSTAT.EQ.5) GOTO 100
	WRITE(IERR,4) IFSTAT, ANGLE*STPSIZ
 4	FORMAT(' > ERROR IN WRCNT < IFSTAT =',I3,' 2THETA=',F8.4)
C
100	ICOUNT = ICOUNT + 1
C  Normally store the counts.
	CNT(ICOUNT) = COUNTS
C  If max # counts hit then use time counted in tenths of seconds.
	IF(IFSTAT.EQ.5) CNT(I) = - 10.0 * CTIME
C  Write out record when full.
	IF(ICOUNT.EQ.16) CALL WRREC
C
	RETURN
	END
C***********************************************************************
C
      SUBROUTINE WRREC
C
C	WRITE A RECORD TO THE RAW DATA FILE
C
C***********************************************************************
C
C     DESCRIPTION:
C
C           THIS ROUTINE WRITES THE COLLECTED DATA TO THE
C        OUTPUT FILE.  THIS CONSISTS OF COUNT TIMES AND X-RAY
C        COUNTS THAT WERE COLLECTED.  THIS ROUTINE IS NORMALLY
C        CALLED WHEN THERE ARE SIXTEEN DATA SETS TO BE OUPUT
C        EXCEPT ON THE LAST CALL WHERE ANY REMAINING DATA IS
C        WRITTEN.
C	## This was originally subroutine WRFILE
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 /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
C Uses STPSIZ, ANGLE, CNT, ICOUNT, NREC, IRAW, IERR, ITIM, IDAT
C Calls IFTEMP, SYTIME
C
C***********************************************************************
C
C  IS THERE ANY DATA IN THE BUFFER TO BE WRITTEN? IF NOT THEN RETURN
C
      IF(ICOUNT.EQ.0) GOTO 9999
C
C***********************************************************************
C
C  GET THE TEMPERATURE (COMMENTED OUT)
C
C     CALL IFTEMP(ITEMP)
C
C  GET THE TIME
C
      CALL SYTIME
C
C  GET THE ANGLE (IN DEGREES) FOR THE LAST POINT
C
      CANGD = ANGLE * STPSIZ
C
C***********************************************************************
C
C  WRITE THE DATA TO THE OUTPUT FILE.
C
      WRITE(IRAW,300) CANGD,ITIM(1),ITIM(2),ITEMP,
     1      (CNT(I),I=1,ICOUNT)
300   FORMAT(F8.3,2I2,I4,16F7.0)
C
C  KEEP TRACK OF THE NUMBER OF RECORDS WRITTEN
C
      NREC = NREC + 1
C
C***********************************************************************
C
C  TEST SUM OF COUNT ARRAY FOR SUM>0 AN INDICATION THAT SHUTTER IS OPEN
C  ALSO ZERO BUFFER ARRAY AND RESET POINTER
C
400   SUM=0.0
      DO 500 I=1,ICOUNT
      SUM=SUM+CNT(I)
500   CNT(I) = 0.0
C
      ICOUNT = 0
C
C  IF THE SUM IS ZERO TYPE A WARNING
C
      IF (SUM.NE.0.0) GOTO 9999
      WRITE(IERR,510) ITIM,IDAT,CANGD
510   FORMAT(' >> WARNING << - ZERO COUNTS! ARE XRAYS ON?',
     & I4,':',I2,':',I2,I3,'/',I2,'/',I2,' 2TH=',F8.3)
C     & I4,':',I2.2,':',I2.2,I3,'/',I2,'/',I2.2,' 2TH=',F8.3)
C
C***********************************************************************
C
C  ALL DONE
C
9999  RETURN
      END
C**********************************************************************
C
	SUBROUTINE FINISH
C
C	CLEAN UP AFTER DATA COLLECTION.
C
C	This procedure calls SYTIME and IFEXIT
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
C Uses ITYP, IRUN, IRAW, ITIM, IDAT
C Calls SYTIME, IFEXIT 
C
C   Close files
	CLOSE(UNIT=IRAW)
	CLOSE(UNIT=IRUN)
C
C   Print message with completion time
	CALL SYTIME
	WRITE(ITYP,1004) ITIM, IDAT
1004	FORMAT(' DATA COLLECTION TERMINATED AT ',
     &   I2,':',I2,':',I2,' ON ',I2,'/',I2,'/',I2)
C
C   Shut down diffractometer and ask user to remove sample.
	CALL IFEXIT
C
C   Return to main program
9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE DEBUG
C  Select debugging options
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'
	DIMENSION NBUG(20)
C
C	PRINT THE MENU AND GET AN OPTION
C
100	WRITE(ITYP,104)
104	FORMAT(/,' SELECT DEBUG OPTIONS:',/,
     &   '  0  print this menu',/,
     &   ' -1  select output file or disable output',/,
     &   '  1  print times',/,
     &   ' 20  back to main program',/,' ?',$)
C
200	READ(IRD,204,END=9999) IOPT1,IOPT2
204	FORMAT(2I)
C
C======================================================================
C
	IF(IOPT1.EQ.0) GOTO 100
	IF(IOPT1.EQ.-1) GOTO 1000
	IF(IOPT1.EQ.20) GOTO 9999
	IF(IOPT1.GT.0 .AND. IOPT.LE.10) GOTO 2000
	WRITE(ITYP,304)
304	FORMAT(' INVALID DEBUG OPTION; TRY AGAIN.')
	GOTO 100
C
C======================================================================
C
1000	IBUG=IOPT2
C	  WRITE(ITYP,1004)
C1004	  FORMAT(' Enter unit #',$)
	GOTO 200
C
C======================================================================
C
2000	NBUG(IOPT1)=IOPT2
C
C======================================================================
C
9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYINIT
C
C	SYSTEM DEPENDANT PROGRAM INITIALIZATION.
C
C  NOTE: This does not initialize the interface.  You should be able
C  to create a run file from another terminal while the interface is busy.
C
C  Unit numbers to be used are assigned in BKDATA.
C
C  VMS: Do nothing.
C  RSX: Assign unit 6 to terminal; Attach terminal.
C  RT:  Somebody knows but I don't.
C
	IMPLICIT INTEGER*2 (I-N)
	PRINT*,'THIS IS THE VAX VERSION'
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYATCH( IUNIT)
	IMPLICIT INTEGER*2 (I-N)
C  RSX needs to attach lines.
C  This is the VMS version so just return.
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYDTCH( IUNIT)
	IMPLICIT INTEGER*2 (I-N)
C  RSX needs to detach lines.
C  This is the VMS version so just return.
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYOPEN( IUNIT, NAME, NDEF, NEW)
C
C   OPEN A FILE.
C	IUNIT = unit number to open on
C	NAME  = file name
C	NDEF  = the default portions of the filename
C	NEW   = 1 if this is a new file.
C
C	THIS VERSION IS INTENDED FOR VAX OR PDP-11 FORTRAN-77
C	READONLY & CARRIAGECONTROL are not standard keywords.
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE NAME, NDEF
C
C======================================================================
C
C  Insert the default fields into the filename.
	CALL SYDFLT(NAME,NDEF)
C
C======================================================================
C
C	OPEN THE FILE
C
1000	IF(NEW.EQ.1) GOTO 1010
C
C   Open an old file for read.
C	OPEN(UNIT=IUNIT, FILE=NAME, STATUS='OLD', READONLY)
	OPEN(UNIT=IUNIT, NAME=NAME, TYPE='OLD', SHARED)
	GOTO 9999
C
C   Create a new file.
C1010	OPEN(UNIT=IUNIT, FILE=NAME, STATUS='NEW', 
1010	OPEN(UNIT=IUNIT, NAME=NAME, TYPE='NEW', 
     &      CARRIAGECONTROL='LIST')
C
9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYDFLT(NAME,NDEF)
C
C	FILL IN DEFAULT FIELDS OF A FILENAME.
C
C   This version is intended for RSX or VMS or RT-11.
C   The syntax for a filename is disk:[directory]name.extension;version
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE NAME(1), NDEF(1)
C
C  Find the various pieces of the filename and default.
	CALL SYPARS(NAME,IDISK,IDIR,IEXT,IVER,IEND)
	CALL SYPARS(NDEF,JDISK,JDIR,JEXT,JVER,JEND)
C
C  Insert defaults into the missing fields of NAME
C
C  First the Version number
	IF(IVER.EQ.IEND)
     &    CALL INSERT(NAME,IVER,IEND,NDEF,JVER,JEND-1)
C  Extension
	IF(IEXT.EQ.IVER)
     &    CALL INSERT(NAME,IEXT,IEND,NDEF,JEXT,JVER-1)
C  Name field
	IF(IDIR+1.EQ.IEXT)
     &    CALL INSERT(NAME,IDIR+1,IEND,NDEF,JDIR+1,JEXT-1)
C  Directory
	IF(IDISK.EQ.IDIR)
     &    CALL INSERT(NAME,IDISK+1,IEND,NDEF,JDISK+1,JDIR)
C  Finally the disk
	IF(0.EQ.IDISK)
     &    CALL INSERT(NAME,1,IEND,NDEF,1,JDISK)
C  Make sure the filename ends with a null character.
	NAME(IEND) = 0
C  All done
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYPARS(NAME,IDISK,IDIR,IEXT,IVER,IEND)
C
C	FIND THE VARIOUS ELEMENTS OF THE FILENAME
C
C   This version is intended for RSX or VMS or RT-11.
C   The syntax for a filename is disk:[directory]name.extension;version
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE NAME(40)
C
C  Assume nothing exists until it is found.
	IDISK = 0
	IDIR = 0
	IEXT = 0
	IVER = 0
C  Scan the name looking for punctuation marks.
	DO 100, I=1,40
	  IF(NAME(I).EQ.':') IDISK = I
	  IF(NAME(I).EQ.']') IDIR = I
	  IF(NAME(I).EQ.'.') IEXT = I
	  IF(NAME(I).EQ.';') IVER = I
	  IEND = I
	  IF(NAME(I).LE.' ') GOTO 200
100	CONTINUE
C
C  The returned variables should be in order; a blank field is indicated
C  by equal locations for marks.
200	IF(IVER.EQ.0) IVER = IEND
	IF(IEXT.EQ.0) IEXT = IVER
	IF(IDIR.EQ.0) IDIR = IDISK
	RETURN
	END
C**********************************************************************
C
	SUBROUTINE INSERT(IBIG,IAT,ILEN,LITTLE,JBEG,JEND)
C
C	Insert a little substring from LITTLE from JBEG to JEND
C	into a big string IBIG before IAT and update ILEN, the length of IBIG.
C	For example, CALL INSERT('ABCDE',2,5,'12345',3,4) will result 
C	in A34BCDE.  It was written that way because that's what I need today.
C
	IMPLICIT INTEGER*2 (I-N)
	BYTE IBIG(1),LITTLE(1)
C
C  If the little string is length 0 then don't bother.
	IF(JBEG.GT.JEND) GOTO 9999
C
C  Make a space in IBIG
	INC = JEND - JBEG + 1
	DO 80, I=ILEN,IAT,-1
80	IBIG(I+INC) = IBIG(I)
C
C  Move the little string into place and update the length of IBIG
	ILEN = ILEN + INC
	INC = INC - 1
	DO 90, I=0,INC
90	IBIG(I+IAT) = LITTLE(I+JBEG)
C
C  All done.
9999	RETURN
	END
C**********************************************************************
C
	SUBROUTINE SYTIME
C
C	AUTO SYSTEM DATE AND TIME ROUTINE for RSX 11M
C
C		This routine gets date and time from the system
C	and stores them as integers in IDAT, and ITIM as follows:
C
C	ITIM(1) = Hour    ITIM(2) = Minute   ITIM(3) = Second
C	IDAT(1) = Month   IDAT(2) = Day      IDAT(3) = Year
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 /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 ITIM, IDAT
C Calls IDATE & TIME from the system library.
C
	INTEGER*2 IBUFF(4)
C
C======================================================================
C
C  Obtain the date from the system clock
C
	CALL IDATE( IDAT(1), IDAT(2), IDAT(3) )
C
C  Let the user know if the date has not been set.
	IF(IDAT(3).LT.83) WRITE(ITYP,1000) IDAT,ITIM
1000	FORMAT(/,' >> WARNING << THE SYSTEM DATE IS NOT SET. ',
     1  ' YOU MAY WANT TO ',/,' ABORT AND RESTART, ELSE',
     2	' ACCEPT THE DATE',I3,'/',I2,'/',I2,I3,':',I2,/)
C     2	' ACCEPT THE DATE',I3,'/',I2,'/',I2.2,I3,':',I2.2,/)
C
C
C======================================================================
C
C   STORE TIME IN RELEVANT VARIABLES
C
C  Get the time as a character string in the form hh:mm:ss
	CALL TIME(IBUFF)
C
C  Store time as integers
	DECODE(6,1020,IBUFF) ITIM
1020	FORMAT(I2,X,I2,X,I2)
C
C======================================================================
C
C  DEBUG: SHOW  DATE/TIME CONVERSION 
C
D	IF(IBUG.NE.0) WRITE(IBUG,1030) IDAT,ITIM
D1030	FORMAT(' > SYTIME=',I2,'/',I2,'/',I2, I3,':',I2,':',I2)
CD1030	FORMAT(' > SYTIME=',I2,'/',I2,'/',I2.2, I3,':',I2.2,':',I2.2)
C
C======================================================================
C
	RETURN
	END
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
