CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			-        AUTO        -
C
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     CONTROL RETURNS TO THIS PROGRAM WHENEVER NO OTHER OPERATION
C     IS BEING PERFORMED, AUTO THEN CYCLES THROUGH THE WAITING LOOP
C     UNTIL SERVICE IS REQUESTED OR THE SYSTEM IS EXITED.
C
C
C*****************************************************************************
C
C     CREDITS:
C                 AUTHORS     (JUNE 1980)
C
C           ROBERT L. SNYDER
C
C           NYS COLLEGE OF CERAMICS
C           ALFRED UNIVERSITY
C           ALFRED, NY  14802
C
C
C           CAMDEN R. HUBBARD
C
C           NATIONAL BUREAU OF STANDARDS
C           WASHINGTON, D.C.  20234
C
C
C           NICOLAS C. PANAGIOTOPOULOS
C
C           JCPDS INTERNATIONAL CENTRE FOR DIFFRACTION DATA
C           NATIONAL BUREAU OF STANDARDS
C           WASHINGTON, D.C.  20234
C
C
C
C                 WITH MODIFICATIONS BY:
C
C           WIM RICHTER (PWR)
C	    CSIR SOUTH AFRICA
C
C           DALE C. EARL (DCE)
C           POLAND, NY  13431
C
C	    JIM WALKER (JDW)
C
C*****************************************************************************
C
C     OPERATING REQUIREMENTS FOR VERSION:       AU1.0 RT
C
C     OPERATING SYSTEM: RT-11 V04.0
C                       (ALSO USES PROGRAMMED REQUESTS FEATURE)
C     PROGRAMMING LANGUAGE: PDP FORTRAN IV V02.5-6
C     MEMORY: MINIMUM OF 48K BYTES
C     MASS STORAGE: ANY APPROPRIATE MEDIA
C     INTERFACE: CANBERRA
C                   - 6726 TELECOMPUTER INTERFACE
C                   - 6647 AXIS POSITIONER
C                   - 6326 COUNTER/TIMER
C
C     OPERATING REQUIREMENTS FOR VERSION:       AU2.0M RSX
C
C     OPERATING SYSTEM: RSX-11M V04.10
C     PROGRAMMING LANGUAGE: FORTRAN 77
C     MEMORY: MINIMUM OF 128K BYTE SYSTEM
C     MASS STORAGE: ANY APPROPRIATE MEDIA
C     INTERFACE: CANBERRA
C                   - 6726 TELECOMPUTER INTERFACE
C                   - 6647 AXIS POSITIONER
C                   - 6326 COUNTER/TIMER
C
C
C*****************************************************************************
C
C     REVISIONS:
C
C           1981 JAN  8  CRH
C           1981 FEB  5  CRH
C           1981 FEB 10  CRH  - ADDED OPEN, CLOSE, PKFIND, SMTH13
C                             - REPLACED QUANT WITH BGQUAN AND RNQUAN
C                             - REPLACED STDFIL WITH RUNFIL
C                             - MOVE CALL TO POP TO AUTO AND DELETED IT
C                               FROM ALL SUBROUTINES
C           1981 JUN 21  CRH  - CORRECTED BUG IN RUNFIL (CALL ALOT WITH A
C                               CONSTANT IN CALL LIST FOR ISIZE LEADS TO
C                               REPLACEMENT OF CONSTANT)
C                             - USED LOCAL ARRAY ISAVE IN SMTH13 INSTEAD
C                               OF IALPH ARRAY SINCE THE USE OF IALPH
C                               NEEDED TO BE RETAINED IN RNQUAN
C           1981 JUN 29  CRH  - REVISED INTRUP IN ORDER TO ZERO FLAG TABLE
C                               AFTER A FLAG WAS READ.  NEEDED FOR HP2621
C                               TERMINAL.
C                             - CHANGES TO RNQUAN AND OPTIM TO REFLECT
C                               DEFINITION OF COLUMNS 120 AND 121 OR
C                               RECORD 7 OF OUPUT DATA FILE
C                             - ADDED VARIABLE DELPK(IUNIT) TO
C                               COMMON/SCAN/ TO IMPROVE CENTERING OF PEAKS
C                               FOR PEAK FIND AND OPTIM.
C           1981 JUL  2       - REVISED RNQUAN TO CORRECTLY WRITE
C                               NAM, JKL, ETC.
C           1981 JUL 28       - AUTO REVISED TO ENABLE OVERLAYING OF MAIN
C                               BRANCHES.
C           1981 AUG  5       - INCORPORATE TEMPERATURE READING AND
C                               STORAGE IN BGTEMP, ENTEMP, RNQUAN, QUAL,
C                               CONSOL, WRFILE, AND MAIN
C                             - REINSTATED DEBUG PRINT IN ESTIM
C           1981 AUG 12       - REVISED OPTIM AND ESTIM TO HANDLE
C                               EXTREMELY LOW COUNTS RATES
C                             - ALSO CORRECTED RECORD 7 WRITE
C           1981 DEC 31  PWR  - MAJOR REVISION TO RUN ON THE PDP11
C                               WITH CANBERRA INTERFACE
C           1982 MAY 15  DCE  - MAJOR REVISION TO RUN IN A SINGLE USER
C                               CONFIGURATION
C           1984 JUN 20  DCE  - MODIFIED AND DEBUGGED TO RUN UNDER RSX
C
C*****************************************************************************
C
C  THIS IS THE RSX11M VERSION OF AUTO 
C	USE THE FOLLOWING ODL FILE TO CREATE THE OVERLAY
C
C  	.ROOT AUTO-DUMP-COM1-COM2-COM3-COM4-*(OVRL1,OVRL2,OVRL3)
C  COM1:	.FCTR	BRANCH-CONSOL-CONJOB-TTERM-TINTFC-IF-POP-PUSH
C  COM2:	.FCTR	BGMOVE-ENMOVE-BGCNT-ENDCNT-CKANG-STPSCN
C  COM3:	.FCTR	ISCODE-FIXANG-FIXTIM-ESTIM-ENTIM
C  COM4:	.FCTR	RUNFIL-FILNAM-FILEUP-ALOT-DATIM-FOPEN-WRFILE-FINIS
C  OVRL1:	.FCTR	BKDATA-INIT-IFINIT-ATCH
C  OVRL2:	.FCTR	QUAL-ENQUAL
C  OVRL3:	.FCTR	BGQUAN-RNQUAN-OPTIM-SMTH13-PKSCAN-PKFIND
C  	.END
C
C
C*****************************************************************************
C
C
C	COMMON BLOCK GLOSSARY:
C
C
C  I/O DEFINITIONS - COMMON /IO/
C
C     NBS          =  2 - THE LOGICAL UNIT NUMBER OF THE X-RAY INTERFACE
C     IDT          =  0 -  UNUSED
C     ICLOCK       =  0 -  UNUSED
C     ISPEC        =  4 - SPECIAL LUN TO BE USED FOR VARIOUS DISC FILES
C                     USED BY ALOT TO READ FILE CONFIG.DAT
C                     USED BY RUNFIL TO WRITE RUN FILE INFORMATION
C     IRD          =  5 - TERMINAL INPUT
C     ITYP         =  7 - TERMINAL OUTPUT
C     IPRT         =  6 - LINE PRINTER OUTPUT
C     IDISK(1)     =  8 - STANDARD INPUT FILE FOR DIFFRACTOMETER #1
C     IDISK(2)     = 10 - OUTPUT DATA FILE FOR DIFFRACTOMETER #1
C     IFIN         = 12 - INPUT FOR TRANS ROUTINE
C     IFOUT        = 13 - OUTPUT FOR TRANS ROUTINE
C
C
C  GENERAL PARAMETER DEFINITIONS-COMMONS /ANG/,/BUFF/,/CNTL/,
C  /COUN/,/PROB/, AND /SCAN/.
C
C     BANG         = THE BEGINNING 2-THETA FOR RUN
C     BKGTIM       = BACKGROUND COUNT TIME IN SECONDS
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     IALPH        = A SCRATCH ARRAY USED IN VARIOUS PLACES
C     CNT          = THE ARRAY FOR COLLECTED INTENSITY VALUES
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        IFLAG(5)     = NUMBER OF REPETIONS FOR EACH SAMPLE MOUNT
C	 IFLAG(6)     = NUMBER OF MOUNTINGS FOR THIS COMPOUND OR MIXTURE
C        IFLAG(7-10)  = AVAILABLE FOR FUTURE EXPANSION
C     INTR         = THE STATUS WORD FROM THE INTERFACE
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     IRUN         = 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     ITITLE(50)   = THE RUN TITLE
C                     - CHAR 1-80 = TITLE
C                     - CHAR 81-100 = THE OPERATOR'S NAME
C     ITRANS(20,2) = A LIFO ARRAY OF TRANSFER FLAGS CONTROLLING
C		     THE SOFTWARE INTERRUPT CALL SEQUENCE.
C		      = 0 ERROR CONDITION, STACK EMPTY
C                     = 1 CALL BGMOVE
C                     = 2 CALL ENMOVE
C                     = 3 CALL BGCNT
C                     = 4 CALL ENDCNT
C                     = 5 CALL PKFIND
C                     = 6 CALL PKSCAN
C                     = 7 CALL STPSCN
C                     = 8 CALL RNQUAN
C                     = 9 CALL ESTIM
C                     = 10 CALL FINIS
C                     = 11 CALL ENQUAL
C                     = 17-19 AVAILABLE FOR FUTURE EXPANSION
C		      = 20 NOP, RETURN TO POLLING LOOP
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     MXUNIT       = NO. OF DIFFRACTOMETERS RUNNING SIMULTANEOUSLY
C     NAME(15)     = A SCRATCH NAME ARRAY
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     TIMLIM      = THE MAXIMUM TIME TO COUNT A LINE IN MINUTES
C                   (IE THE SUM OF THE TOTAL BACKGROUND AND PEAK TIMES)
C
C
C  QUANTITATIVE ANALYSIS PARAMETERS - COMMON /QUAN/
C
C     CONC        = CONCENTRATION OF ADDED STANDARD FOR SPIKING METHOD
C                   OR CONCENTRATION OF INTERNAL STANDARD.
C     LOOP        = 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     IREPT       = THE CURRENT REPITION NUMBER FOR THE PRESENT MOUNT
C                   (.LE.IFLAG(5)).
C
C
C  RUN,DATE, AND TIME PARAMETERS - COMMON /RNDT/
C
C     NMFIL(15)   = NAME OF THE OUTPUT FILE
C     NREC        = NUMBER OF RECORDS WRITTEN ON THE OUTPUT FILE
C     ITR         = ACTIVITY OF THE UNIT
C		     = 1  INACTIVE
C		     = 2  POWDER DATA COLLECTION
C		     = 3  QUANT ANALYSIS
C		     = 4  SLEW
C     IENRN(5)    = ESTIMATED TIME OF END OF RUN
C
C
C  TEMPERATURE READING AND INTERFACE VARIABLES  -  COMMON /TEMP/
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    IADDTM       = 12 THE NBS BUS CARD BASE ADDRESS (I*4 VARIABLE)
C
C***********************************************************************
C
	PROGRAM AUTO
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		STACK:		STACK POINTER
C
	COMMON /STACK/	IPOINT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
C		QUAN:		QUANT PARAMETERS
C
	COMMON /QUAN/	CONC,		LOOP,		LPK,
     1	NUM(20),	IREPT,		SCONC
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
	BYTE IALPH, NAME, NMFIL
C
	MODE = 0
C
C***********************************************************************
C
C  WRITE PROGRAM TITLE AND LAST REVISION DATE
C
	WRITE(ITYP,1000)
1000	FORMAT(28X,'**   AUTO  **',/,
     1	' A REAL TIME DIFFRACTOMETER CONTROL SYSTEM.  VERSION: ',
     2	'AU2.0M RSX 20-JUN-84.')
C
C***********************************************************************
C
C  INITILIZE THE SYSTEM, PROGRAM, AND DEVICES
C
	CALL INIT
C
C***********************************************************************
C
C  FIRST TIME THROUGH SO CALL THE CONSOL ROUTINE
C
	CALL CONSOL(1)
C
C***********************************************************************
C
C  POLLING LOOP:
C	POLLING IS DONE ON THE TERMINAL DEVICE LOOKING FOR AN ESC
C  CHARACTER AND ON THE INTERFACE DEVICE LOOKING FOR A COMPLETION CODE.
C  TERMINAL AND DEVICE POLLING ARE SYSTEM DEPENDENT THEREFORE THEY ARE
C  SUBROUTINES.
C
C
C***********************************************************************
C
C  TEST THE TERMINAL
C
10	CALL TTERM(MODE)
	IF(MODE.EQ.1 .OR. IPOINT.EQ.0) CALL CONSOL(0)
C
C***********************************************************************
C
C  CHECK THE STACK FOR A 9999 (EXIT) COMMAND.  EXECUTE IT IMMEDIATELY.
C
	CALL POP(IGOTO1,IGOTO2)
	IF (IGOTO1.EQ.9999) GOTO 9999
	IF (IGOTO1.NE.0) CALL PUSH(IGOTO1,IGOTO2)
C
C***********************************************************************
C
C  TEST THE DEVICE OR DEVICES FOR A SERVICE CONDITION
C
	MODE = 0
	IF (IACT.GT.0) CALL TINTFC(MODE)
	IF (MODE.EQ.1) CALL BRANCH
C
C***********************************************************************
C
C  CHECK THE STACK FOR A 9999 (EXIT) COMMAND.  EXECUTE IT IMMEDIATELY.
C
	CALL POP(IGOTO1,IGOTO2)
	IF (IGOTO1.EQ.9999) GOTO 9999
	IF (IGOTO1.NE.0) CALL PUSH(IGOTO1,IGOTO2)
C
C  NOT AN EXIT CALL, LOOP BACK THROUGH POLLING SECTION
C
	GOTO 10
C
C***********************************************************************
C
C  ALL DONE FOR TODAY.  SEE YA TOMORROW.
C
9999	CALL IFDTCH(NBS,IERROR)
	CALL IFDTCH(IRD,IERROR)
C
	WRITE(ITYP,1010)
1010	FORMAT(/,'      **   NORMAL TERMINATION OF AUTO.  ',
     1	'HAVE A NICE DAY.   **')
C
	CALL EXIT
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C           FILE SPACE ALLOCATION ROUTINE
C
C***********************************************************************
C
C     DESCRIPTION:
C
C           THIS ROUTINE ALLOCATES AN OUTPUT FILE FOR THE
C        AUTO DATA COLLECTION SYSTEM.  IT THEN WRITES THE FIRST
C        RECORD OR THE FIRST FIVE RECORDS DEPENDENT ON THE VALUE
C        OF IFLAG(1).  THE VALUE OF THE PASSED VARIABLE ISIZE IS
C        IGNORED FOR THE RT-11 OPERATING SYSTEM SINCE ALL FILES
C        ARE ALLOCATED AS SEQUENTIAL.
C
C
C***********************************************************************
C***********************************************************************
C
      SUBROUTINE ALOT(ID,ISIZE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C     SUBSECTION: COMMON BLOCKS
C
C
C           IO:         INPUT/OUTPUT UNIT NUMBERS
C
      COMMON /IO/ NBS,        IDT,        ICLOCK,
     1      ISPEC,            IRD,        IPRT,       ITYP,
     2      IDISK(2),   IFIN,       IFOUT
C
C           CNTL:       PROGRAM CONTROL VARIABLES
C
      COMMON /CNTL/     IACT,       IDBUG,            INTR,
     1      IRUN,       ITRANS(20,2),     MVCNT
C
C           BUFF:       SCRATCH ARRAYS
C
      COMMON /BUFF/     IALPH(128), NAME(16)
C
C           PROB:       RUN IDENTIFIERS
C
      COMMON /PROB/     IDAT(3),    IFLAG(10),  ITIM(3),
     1      ITITLE(50)
C
C***********************************************************************
C
C     VARIABLE DECLARATION:
C
      BYTE IALPH, NAME, NAMEFL(16)
C
      DIMENSION JFLAG(10)
C
      DATA NAMEFL /'C','O','N','F','I','G',
     1      '.','D','A','T',6*0/
C
C***********************************************************************
C
C  DEBUG IDENTIFICATION
C
D	WRITE(ITYP,1234)
D1234	FORMAT('  >> DEBUG0 << - ENTRY TO ALOT.')
C
C***********************************************************************
C
C  FOR A DATA FILE WRITE RECORDS 1,2,3,4,5
C  FOR A RUN  FILE WRITE RECORD  1
C
      CALL FOPEN(ID,IERROR)
      IF (IERROR.NE.0) GOTO 9000
C
C***********************************************************************
C
C  IF THIS IS FOR A RUN FILE THEN ONLY WRITE THE FIRST RECORD
C
      IF((IALPH(113).NE.'2') .AND. (IALPH(113).NE.'3')) GOTO 90
C
	WRITE(ID,990) (ITITLE(I),I=1,50),(IDAT(I),I=1,3),
     1	(ITIM(I),I=1,3),(IALPH(112+I),I=1,10)
990	FORMAT(50A2,3I2,3I2,10A1)
	GOTO 9999
C
C***********************************************************************
C
C  WRITE RECORD # 1  - TITLE, OPERATOR, DATE, AND FLAGS
C
90      WRITE(ID,1000) (ITITLE(I),I=1,50),(IDAT(I),I=1,3),
     1      (ITIM(I),I=1,3),(IFLAG(I),I=1,10)
1000  FORMAT(50A2,6I2,10I1)
C
C***********************************************************************
C
C  OPEN THE SPECIFICATION AND CONFIGURATION FILE CONFIG.DAT
C  PLACE THE CONFIGURATION FILE NAME IN ARRAY NAME
C
      DO 100 I=1,14
100   NAME(I) = NAMEFL(I)
C
      CALL FOPEN(ISPEC,IERROR)
      IF (IERROR.NE.0) GOTO 9000
C
C READ THE INSTRUMENT SPECIFICATION AND CALIBRATION FILE
C WRITE TO OUTPUT FILE RECORDS 2,3,4 AND 5
C
      DO 200 I=1,4
      READ(ISPEC,1010,END=210) (IALPH(J),J=1,128)
1010  FORMAT(128A1)
C
210   WRITE(ID,1020) (IALPH(J),J=1,128)
1020  FORMAT(128A1)
200   CONTINUE
C
C***********************************************************************
C
C  RELEASE THE LOGICAL UNIT# ISPEC FROM FILE CONFIG
C
      CLOSE(UNIT=ISPEC,ERR=9010)
C
C***********************************************************************
C
C  DEBUG IDENTIFICATION
C
D	WRITE(ITYP,1235)
D1235	FORMAT('  >> DEBUG0 << - EXIT FROM ALOT.')
C
      GOTO 9999
C
C***********************************************************************
C
9000  WRITE(ITYP,9001)
9001  FORMAT(/,'  >> ERROR << - ON OPENING DATA FILE IN ALOT')
      GOTO 9999
C
9010  WRITE(ITYP,9011)
9011  FORMAT(/,'  >> ERROR << - ON CLOSE OF CONFIG.DAT FILE IN ALOT')
C
C***********************************************************************
C
9999  RETURN
      END
C---- Subroutine Description --------------------------------------------------
C
C							File: ATCH.FTN
C
C Desciption
C
C	Subroutine to implement the logic required to determine if the Physical
C	Device associated with the specified LUN is attached to another task.
C	If the device is available it will be attached to the requesting task
C	and the value returned in IOSB will be +1. Otherwise the attach request
C	is aborted and a negative value will be returned in IOSB. The LUN must
C	be assigned to a physical device prior to calling this routine.
C
C Author: J. R. Years  16-march-83
C	  Siemens-Allis, Inc.
C	  Cherry Hill, New Jersey
C
C---- Environment ------------------------------------------------------------
C
C  Computer System:	PDP-11
C Operating System:	RSX-11M Version 4.0-B
C
C	  Language:	PDP-11 Fortran IV
C
C      Application:	General Support Library
C      Application:	DIFFRAC V Vesion 2.0
C      Application:	
C
C---- Routine Description ----------------------------------------------------
C
C				Routine: ATCH
C
C  Date  Time	Who	What
C ------ ----	---	----
C 031683 1119	JRY	Original
C
C
	SUBROUTINE ATCH ( LUN ,IOSB ,IDS )
C
C  Function:
C		Attach to physical device.
C    Inputs:
C		I*2	LUN	Logical unit number to be attached.
C
C   Outputs:
C		I*2	IOSB	Two word array to receive the final I/O
C				Status. Definition of values returned are
C				described in the D.E.C. RSX11M/M-PLUS I/O
C				DRIVERS REFERENCE MANUAL.
C
C		I*2	IDS	Variable to receive the Directive Status.
C				Definition of values returned are descibed
C				in the D.E.C. RSX11M/M-PLUS I/O DIVERS
C				REFERENCE MANUAL.
C
C     notes:
C
C
C---- References -------------------------------------------------------------
C
C      Subroutines: QIO , MARKtime , WAITFR
C	     Files: none
C
C---- Data -------------------------------------------------------------------
C
	INTEGER LUN , IOSB(2) , IDS , EFL4 , TEN , TICK
C
	DATA EFL4/4/ , TEN/10/ , TICK/1/
C
C---- Logic ------------------------------------------------------------------
C

	CALL QIO( "1400 , LUN ,,, IOSB,, IDS )	! Issue Attach directive
	IF ( IDS .NE. 1) GO TO 200
	IF ( IOSB(1) .NE. 0 ) GO TO 200
		CALL MARK ( EFL4 ,TEN ,TICK ,IDS ) ! Wait for attach 
		IF ( IDS .NE. 1) GO TO 200
		CALL WAITFR (EFL4 ,IDS)
		IF (IDS .NE. 1) GO TO 200
	IF (IOSB(1) .NE. 0 ) GO TO 200
C
C	The ATTACH has not completed in the allowed time so the physical
C	device must be Attached to another task. Issue a QIO to kill
C	the Attach directive.
C
	CALL WTQIO ( "12 , LUN ,EFL4 ,,,, IDS )	! Kill Attach directive
C
  200	RETURN
C
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			START COUNTER/TIMER
C
C***********************************************************************
C
C	DESCRIPTION:
C
C  THIS SUBROUTINE STARTS THE COUNTER IN FIXED TIME/FIXED COUNT MODE
C  THE CALLING ROUTINE MUST SET UP TIME AND CNTLIM.  THE INTERFACE
C  WILL SEND A COMPLETION CHARACTER WHEN EITHER IS REACHED.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE BGCNT
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME
C
C***********************************************************************
C
C  SET THE ACTIVITY FLAG
C
	IACT = 1
C
C***********************************************************************
C
C  WE ARE NOW READY TO SET THE INTERFACE
C
C
C   GENERATE THE COUNTS CODE FOR THE CANBERRA INTERFACE
C
	I2 = INT(ALOG10(CNTLIM)+.001)
	I1 = INT(CNTLIM / 10.**I2)
C
C   PRESET THE COUNTER TO CNTLIM COUNTS
C
	ENCODE(6,100,IALPH(1)) 'W',MODULE(1),I1,I2,'*'
100	FORMAT(A1,I2,I1,I1,A1)
C
C   GENERATE THE TIME CODE FOR THE CANBERRA INTERFACE
C
	IF (TIME.LT.0.1) THEN
		I2 =  1
		I1 =  1
		ELSE
		IF (TIME.LT.1.0) THEN
			I2 = 1
			I1 = INT(TIME*10.)
			ELSE
			I2=INT(ALOG10(TIME)+.001)
			I1=INT(TIME/(10.**I2))
			I2=I2+2
			END IF
		END IF
C
C  PRESET THE TIMER WITH THE TIME LIMIT
C
	ENCODE(6,110,IALPH(7)) 'W',MODULE(2),I1,I2,'*'
110	FORMAT(A1,I2,I1,I1,A1)
C
C***********************************************************************
C
C   ISSUE THE RESET/START COMMAND TO THE INTERFACE USING THE
C   GENERIC ADDRESS
	ENCODE(6,120,IALPH(13)) 'X',MODULE(4),'31*'
120	FORMAT(A1,I2,A3)
C
	CALL IFOUTP(NBS,IALPH,18,IERROR)
	IF (IERROR.EQ.0) GOTO 9999
C
C***********************************************************************
C
C  ERROR MESSAGE AND ABORT
C
9000	WRITE(ITYP,9010)
9010	FORMAT(/,'  >> ERROR << - ON DATA OUTPUT FROM BGCNT')
	CALL PUSH(10,4)
C
C***********************************************************************
C
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			MOVE THE GONIOMETER
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE DIRECTS THE AXIS POSITIONER TO BEGIN
C	   A MOVE FOR GIVEN NUMBER OF DEGREES IN A GIVEN DIRECTION
C
C	IF RATE = 0.0 THEN MOTION WILL BE SET AT MAXIMUM RATE
C
C	IF TANG-CANG IS NEGATIVE MOTION IS TOWARD LOW ANGLE, IF
C	POSITIVE MOTION IS TOWARD HIGH ANGLE
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE BGMOVE
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
	DIMENSION NSTEP(2)
	BYTE IALPH, NAME
C
C***********************************************************************
C
C  IF ACTIVITY FLAG IS NOT ZERO THIS ROUTINE WAS CALLED IMPROPERLY
C
	IF (IACT.NE.0) GOTO 9000
C
C***********************************************************************
C
C  STORE THE REAL TARGET ANGLE IN CASE WE NEED IT LATER
C
	ANGLE = TANG
C
C  INTEGRATED MOVE?
C
	IACT = 4
	IF ((ISAVE.EQ.1).AND.(RATE.NE.0.0)) GOTO 300
C
C  IS THIS GOING TO BE A SLEW?
C
	IACT = 2
	IF (RATE.NE.0.0) GOTO 100
C
C***********************************************************************
C
C  YES IT IS A SLEW, SET UP
C
	IACT = 3
	RATE = 200.0
C
C  INITIALLY, MOVE TO 0.05 DEGREES LOWER THAN THE TARGET
C  ANGLE, SECOND MOVE WILL MOVE UP THE LAST 0.05 DEGREES TO REMOVE
C  THE BACKLASH.
C
C  UNLESS WE ARE ALREADY 0.05 DEGREES BELOW THE TARGET ANGLE, THAT IS!
C  
	IF (TANG.EQ.CANG+0.05) GOTO 100
C
	TANG = TANG - 0.05
C
C  SET UP STACK FOR THE SECOND CALL
C
	CALL PUSH(1,0)
C
C***********************************************************************
C
C  CONVERT REQUESTED RATE INTO NEAREST AVAILABLE INSTRUMENT RATE
C  THESE ARE CODES 0-8 FOR THE CANBERRA INTERFACE
C
100	CALL ISCODE(RATE,IRATE)
C
C  CHECK TO MAKE SURE WE ARE DOING A LEGAL MOVE AND GET THE NUMBER OF
C  PULSES THE INTERFACE SHOULD SEND TO THE STEPPER MOTOR
C
	CALL CKANG(NSTEP(1),NSTEP(2),IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
C  IF THIS WAS A SLEW THE TARGET ANGLE GETS RESTORED HERE
C
	TANG = ANGLE
C
C  SET THE DIRECTION CODE (NEG IF NSTEP(1) OR NSTEP(2) IS NEG)
C		1 = POSITIVE DIRECTION
C		0 = NEGITIVE DIRECTION
C
	IDIR = 1
	IF ((NSTEP(1).LT.0) .OR. (NSTEP(2).LT.0)) IDIR = 0
	NSTEP(1) = IABS(NSTEP(1))
	NSTEP(2) = IABS(NSTEP(2))
C
C***********************************************************************
C
C  SET UP THE INSTRUCTION
C
	ENCODE(11,200,IALPH) 'P',MODULE(3),IRATE,IDIR,NSTEP(1),
     1	NSTEP(2),'*'
200	FORMAT(A1,I2.2,I1.1,I1.1,I2.2,I3.3,A1)
C
	CALL IFOUTP(NBS,IALPH,11,IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
	GOTO 1000
C
C***********************************************************************
C
C    ISAVE=1, WE MUST PRESET THE COUNTER AND TIMER TO MAXIMUM VALUES
C  AND START THE INTEGRATED MOVE.
C
300	RATE = MIN(RATE,50.)
C
C  CONVERT REQUESTED RATE INTO NEAREST AVAILABLE INSTRUMENT RATE
C  THESE ARE CODES 0-8 FOR THE CANBERRA INTERFACE
C
	CALL ISCODE(RATE,IRATE)
C
C  PRESET COUNTER AND TIMER TO MAX
C
	ENCODE(11,310,IALPH) 'W',MODULE(1),'95+',MODULE(2),'95*'
310	FORMAT(A1,I2,A3,I2,A3)
	CALL IFOUTP(NBS,IALPH,11,IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
C  CHECK TO MAKE SURE WE ARE DOING A LEGAL MOVE AND GET THE NUMBER OF
C  PULSES THE INTERFACE SHOULD SEND TO THE STEPPER MOTOR
C
	CALL CKANG(NSTEP(1),NSTEP(2),IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
C  SET THE DIRECTION CODE (NEG IF NSTEP(1) OR NSTEP(2) IS NEG)
C		1 = POSITIVE DIRECTION
C		0 = NEGITIVE DIRECTION
C
	IDIR = 1
	IF ((NSTEP(1).LT.0) .OR. (NSTEP(2).LT.0)) IDIR = 0
	NSTEP(1) = IABS(NSTEP(1))
	NSTEP(2) = IABS(NSTEP(2))
C
C***********************************************************************
C
C  SET UP THE INSTRUCTION
C
	ENCODE(11,320,IALPH) 'I',MODULE(3),IRATE,IDIR,NSTEP(1),
     1	NSTEP(2),'*'
320	FORMAT(A1,I2.2,I1.1,I1.1,I2.2,I3.3,A1)
C
	CALL IFOUTP(NBS,IALPH,11,IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
C***********************************************************************
C
C  STORE THE COMPLETION ROUTINE ON THE STACK
C
1000	RATE = 50.0
	CALL PUSH(2,0)
	CALL PUSH(20,0)
C
	GOTO 9999
C
C***********************************************************************
C
C  ERROR: BAIL OUT AND SAVE AS MUCH AS POSSIBLE
C
9000	WRITE(ITYP,9010)
9010	FORMAT(/'  >> ERROR << - FROM BGMOVE, ABORTING.')
	CALL PUSH(10,4)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		ROUTINE TO BEGIN A QUANTITATIVE ANALYSIS RUN
C
C***********************************************************************
C
C	DESCRIPTION:
C
C	    THIS ROUTINE BEGINS A QUANTITATIVE DATA COLLECTION RUN
C	BY INPUTING THE APPROPRIATE DATA NECESSARY FOR THE RUN AND
C	THEN SETTING UP THE RUN TIME PROGRAM TOPERFORM THE
C	NECESSARY OPERATIONS.
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
	SUBROUTINE BGQUAN
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
C		QUAN:		QUANT PARAMETERS
C
	COMMON /QUAN/	CONC,		LOOP,		LPK,
     1	NUM(20),	IREPT,		SCONC
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
	BYTE IALPH, NAME, NMFIL, IBL
C
	DATA IBL/' '/
C
C***********************************************************************
C
C  THIS IS THE BEGINNING OF A QUANT RUN, SAY HELLO !
C
	WRITE(ITYP,1000)
1000	FORMAT(/,'           ** DATA COLLECTION FOR',
     1	' QUANTITATIVE ANALYSIS **')
C
C  SET RUNNING FLAGS
C
	IRUN = 1
	ITR = 3
	RUN = 0.0
C
C***********************************************************************
C
C  DOES A RUNFILE OF INSTRUCTIONS ALREADY EXIST ?
C
	WRITE(ITYP,1010)
1010	FORMAT(/,' DOES THE RUN FILE ALREADY EXIST (Y/N) ? ',$)
C
	READ(IRD,1020) IY
1020	FORMAT(A1)
	IF (IY.EQ.'Y') GOTO 100
C
C  NO A RUNFILE DOES NOT CURRENTLY EXIST, INPUT ALL THE INFORMATION
C  NOW IN THE FORM OF A NEW RUNFILE.
C
	CALL RUNFIL(1)
	GOTO 110
C
C  YES AN APPROPRIATE RUNFILE EXISTS SO GET IT'S NAME
C
100	WRITE(ITYP,1030)
1030	FORMAT(/' PLEASE INPUT THE NAME OF THE RUNFILE'
     1	' YOU WISH TO USE.',/' ? ',$)
	CALL FILNAM(-2)
C
C***********************************************************************
C
C  OPEN THE RUNFILE AND ATTATCH LOGICAL UNIT# ID=IDISK(1)
C
110	ID = IDISK(1)
	CALL FOPEN(ID,IERROR)
	IF (IERROR.NE.O) GOTO 9000
C
C***********************************************************************
C
C  READ IN THE RUN FILE
C
200	READ(ID,1200) (ITITLE(I),I=1,50),IDAT,ITIM,(IFLAG(I),I=1,10)
1200	FORMAT(50A2,6A2,10I1)
C
C  INITIALIZE THE OUTPUT FILE TYPE, SIZE, AND NUMBER OF LINES
C
	IFLAG(1) = 1
	ISIZE = 6
	LINES = 0
C
C***********************************************************************
C
C  INPUT THE NUMBER OF REPETIONS AND MOUNTINGS FOR THIS SAMPLE
C
	WRITE(ITYP,1210)
1210	FORMAT(/,' ENTER NO. OF REPETIONS AND NO. OF MOUNTINGS (2I1)'
     1	,/,' ? ',$)
C
	READ(IRD,1220) IFLAG(5),IFLAG(6)
1220	FORMAT(2I1)
C
	IF(IFLAG(5).EQ.0) IFLAG(5)=1
	IF(IFLAG(6).EQ.0) IFLAG(6)=1
C
C  WHICH LINES ON THE RUN FILE ARE TO BE DETERMINED ?
C  (ALL LINES WILL BE MEASURED IF REL. INT. OR CALIBRATION RUN)
C
	IF (IFLAG(3).GT.3) GOTO 210
C
	WRITE(ITYP,1230)
1230	FORMAT(/,' ENTER THE NUMBER OF EACH LINE TO BE MEASURED,'/
     1	' (DEFAULT = ALL LINES (20I2)) ? ',$)
C
	READ(IRD,1240) (NUM(I),I=1,20)
1240	FORMAT(20I2)
C
	IF (NUM(1).GT.0) GOTO 300
210	DO 220 I=1,20
220	NUM(I) = I
C
C***********************************************************************
C
C  NOW READ THE LINE INFORMATION FROM THE RUN FILE
C
300	READ(ID,1300,END=400)BANG,EANG,TIMLIM,IPK,NPK,NBG
1300	FORMAT(F7.3,7X,F7.3,12X,F5.1,29X,I1,2I2)
	LINES = LINES + 1
C
D	WRITE(ITYP,1301) LINES
D1301	FORMAT(' >> DEBUG << - LINES = ',I4)
C
C  TEST IF THIS LINE IS TO BE MEASURED.  IF SO THEN ADD TO # RECORDS
C  AND ESTIMATED RUN TIME
C
	DO 310 I=1,20
	IF (IFLAG(3).GT.3 .OR. LINES.EQ.NUM(I)) GOTO 320
310	CONTINUE
C
C  NO MATCH - DO NOT MEASURE THIS ONE
C
	GOTO 350
C
C***********************************************************************
C
C  COMPUTE THE NUMBER OF OUTPUT RECORDS NEEDED FOR THIS PEAK
C  BRANCH TO THE CALCULATION FOR THE PROPER COUNT MODE
C
320	IF (IPK.EQ.0) GOTO 330
C
C***********************************************************************
C
C  THIS IS A PEAK COUNTED LINE
C
	IREC = NPK + NBG
C
C  IF A SECOND BACKGROUND WAS REQUESTED ADD ANOTHER NBG
C
	IF (EANG.GT.0.0) IREC = IREC + NBG
	GOTO 340
C
C***********************************************************************
C
C  THIS PEAK WILL BE COUNTED IN INTEGRATE (STEP SCAN) MODE
C
330	IREC = (EANG - BANG)*200.
C
340	ISIZE = ISIZE + IREC/16 + 3
C
C  ADD MAXIMUM RUN TIME FOR THIS LINE TO THE ESTIMATED TOTAL TIME
C
	RUN = RUN + TIMLIM
C
C  NOW SKIP RECORD NUMBER 8 FOR THIS LINE
C
350	READ(ID,1310)
1310	FORMAT(A1)
C
C  LOOP UNTIL ALL RECORDS OF THE RUN FILE HAVE BEEN READ
C
	GOTO 300
C
C***********************************************************************
C
C  REWIND THE RUNFILE
C
400	REWIND ID
C
C  OPEN THE OUTPUT DATA FILE
C
	WRITE(ITYP,1400)
1400	FORMAT(/,' PLEASE ENTER THE FOLLOWING INFORMATION FOR THE '
     +	'OUTPUT DATA FILE:')
C
	CALL FILEUP(1)
C
C  SET THE OUTPUT FILE NAME IN THE STATUS AREA
C
	DO 1405, I=1,15
1405	NMFIL(I) = NAME(I)
C
C  SET THE ESTIMATED ENDING TIME VALUE IN TO THE STATUS AREA
C
	CALL ENTIM(RUN)
C
C  ALLOCATE THE FILE AND WRITE THE FIRST 5 RECORDS
C
	CALL ALOT(IDISK(2),ISIZE)
C
C***********************************************************************
C
C  IF ELEMENTAL COMPOSITION CONSTRAINTS ARE GOING TO BE USED
C  ENTER THE COMPOSITION OF THE UNKNOWN OR STANDARD
C
C
C  CHEMISTRY (OR MU/RO) IS REQUIRED FOR THE INTENSITY RATIO METHOD
C
C	if ((iflag(3).ne.2) .and. (iflag(4).eq.0)) goto 470
	IF (IFLAG(4).EQ.0) GOTO 470
C
420	DO 430, I=1,128
430	IALPH(I) = IBL
C
C  GET THE ELEMENTAL COMPOSITION
C
	WRITE(ITYP,1410)
1410	FORMAT(/,' PLEASE ENTER THE FOLLOWING INFORMATION ON THE'
     1	' SAMPLE',/,' COMPOSITION (MAX. 10 ENTRIES, RETURN TO'
     2	' TO FINISH):',//,'     - ELEMENT SYMBOL',/
     3	'     - WEIGHT PERCENT IN SAMPLE',/
     4	'     - STANDARD DEVIATION',//
     5	'              EL % WT. S.DEV.',/
     6	' FORM:        AA NN.NN NN.NN',/
     7	' ---------------------------')
C
	DO 440, I=1,10
	WRITE(ITYP,1420) I
1420	FORMAT(' ELEMENT # ',I2,': ',$)
	READ(IRD,1430) (IALPH(K),K=I*12-12,I*12)
1430	FORMAT(12A1)
C
	IF ((I.EQ.1) .AND. (IALPH(1).EQ.IBL) .AND.
     1	(IALPH(2).EQ.IBL)) GOTO 460
	IF ((IALPH(I*12-12).EQ.IBL) .AND.
     1	 (IALPH(I*12-11).EQ.IBL)) GOTO 450
C
440	CONTINUE
C
C  ASK IF IT IS ALL CORRECT.
C
450	WRITE(ITYPE,1440) (IALPH(I),I=1,120)
1440	FORMAT(/,' SAMPLE COMPOSITION AS ENTERED:',//
     1	2(1X,4(12A,4X),12A),//
     2	' CORRECT (Y/N) ? ',$)
C
	READ(IRD,1450) IY
1450	FORMAT(A1)
C
	IF (IY.EQ.N) GOTO 420
C
C***********************************************************************
C
C  SET FLAG IF CHEMISTRY WAS NOT ENTERED
C
460	IFLAG(4) = 1
	IF ((IALPH(1).EQ.IBL) .AND. (IALPH(2).EQ.IBL)) IFLAG(4) = 0
C
C  WRITE RECORD 6 ON THE OUTPUT DATA FILE
C
470	ID = IDISK(2)
	WRITE(ID,1460) (IALPH(I),I=1,120)
1460	FORMAT(128A1)
C
C  # OF RECORDS ON OUTPUT FILE
C
	NREC = 6
C
C***********************************************************************
C
C  CALL THE RUN PACKAGE TO DO THE COLLECTION
C
	CALL RNQUAN(1)
	CALL POP(J1,J2)
	GOTO 9999
C
C***********************************************************************
C
C  ERROR HANDLER
C
9000	WRITE(ITYP,9010)
9010	FORMAT('  >> ERROR << - OPEN FOR RUNFILE FAILED IN BGQUAN')
	CALL PUSH(10,3)
C
C***********************************************************************
C
C  TAKE THIS JOB AND ......, I AIN'T WORKING HERE NO MORE.
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			DATA INITILIZATION
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS PROGRAM MODULE INITILIZES THE COMMON
C	   BLOCKS USED IN THE AUTO PROGRAM SYSTEM.
C
C***********************************************************************
C***********************************************************************
C
	BLOCK DATA
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C***********************************************************************
C
C  BLOCK DATA INITILIZATION OF COMMON /IO/
C
	DATA NBS,IDT,ICLOCK,ISPEC,IRD,IPRT,ITYP,IDISK,IFIN,IFOUT
     1	/1,2,3,4,5,6,7,8,10,12,13/
C
C***********************************************************************
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C***********************************************************************
C
C  BLOCK DATA INITILIZATION OF COMMON /CNTL/
C
	DATA IACT/-1/
	DATA IDBUG/0/
	DATA INTR/0/
	DATA IRUN/0/
	DATA ITRANS/40*0/
	DATA MVCNT/0/
C
C***********************************************************************
C
C		STACK:		STACK POINTER
C
	COMMON /STACK/	IPOINT
C
C***********************************************************************
C
C  BLOCK DATA INITILIZATION OF COMMON /STACK/
C
	DATA IPOINT/0/
C
C***********************************************************************
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C***********************************************************************
C
C  BLOCK DATA INITILIZATION OF COMMON /BUFF/
C
	DATA IALPH/128*0/
	DATA NAME/16*0/
C
C***********************************************************************
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C***********************************************************************
C
C  BLOCK DATA INITIALIZATION OF COMMON /INTRFC/
C
	DATA MODULE/41,42,11,40/
	DATA ISTATS/0/
C
C***********************************************************************
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C***********************************************************************
C
C  BLOCK DATA INITIALIZATION OF COMMON /PROB/
C
	DATA IDAT/3*0/
	DATA IFLAG/10*0/
	DATA ITIM/3*0/
	DATA ITITLE/50*0/
C
C***********************************************************************
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C***********************************************************************
C
C  BLOCK DATA INITIALIZATION OF COMMON /RNDT/
C
	DATA NREC/0/
	DATA NMFIL/16*0/
	DATA ITR/1/
	DATA IENRN/5*0/
C
C***********************************************************************
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C***********************************************************************
C
C  BLOCK DATA INITILIZATION OF COMMON /ANG/
C
	DATA BANG/0.0/
	DATA CANG/0.0/
	DATA DANG/0.0/
	DATA EANG/0.0/
	DATA IRATE/0/
	DATA PANG/0.0/
	DATA RATE/60.0/
	DATA TANG/0.0/
	DATA IZRST/0/
	DATA NPTPK/0/
	DATA PPD/400./
C
C***********************************************************************
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C***********************************************************************
C
C  BLOCK DATA INITIALIZATION OF COMMON /SCAN/
C
	DATA IPKFND/0/
	DATA TEANG/0.0/
	DATA DELPK/0.0/
C
C***********************************************************************
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C***********************************************************************
C
C  BLOCK DATA INITIALIZATION OF COMMON /COUN/
C
	DATA CNT/50*0./
	DATA IPT/0/
	DATA ITOT/0/
	DATA CNTLIM/900000./
	DATA ISAVE/0/
	DATA SIMTIM/0.0/
C
C***********************************************************************
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C***********************************************************************
C
C  BLOCK DATA INITIALIZATION OF COMMON /TIM/
C
	DATA BKGTIM/0.0/
	DATA FIXERR/0.0/
	DATA IPK/0/
	DATA NBG/0/
	DATA NPK/0/
	DATA TIME/0.0/
	DATA TIMLIM/0.0/
C
C***********************************************************************
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
C***********************************************************************
C
C  BLOCK DATA INITIALIZATION OF COMMON /TEMP/
C
	DATA IOFF/0/
	DATA ITEMP/0/
	DATA IADDTM/12/
C
C***********************************************************************
C
C		QUAN:		QUANT PARAMETERS
C
	COMMON /QUAN/	CONC,		LOOP,		LPK,
     1	NUM(20),	IREPT,		SCONC
C
C***********************************************************************
C
C  BLOCK DATA INITIALIZATION OF COMMON /QUAN/
C
	DATA CONC/0.0/
	DATA LOOP/0/
	DATA LPK/0/
	DATA NUM/20*0/
	DATA IREPT/0/
	DATA SCONC/0.0/
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			PROCEDURE CALLING ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE HANDLES COMMANDS PASSED THROUGH THE
C	   STACK.  THE TOP COMMAND IS POPPED OFF AND THE PROPER
C	   ROUTINE IS CALLED IN THE MODE SPECIFIED BY THE SECOND 
C	   VALUE OF THE INTEGER PAIR.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE BRANCH
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		STACK:		STACK POINTER
C
	COMMON /STACK/	IPOINT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
C		QUAN:		QUANT PARAMETERS
C
	COMMON /QUAN/	CONC,		LOOP,		LPK,
     1	NUM(20),	IREPT,		SCONC
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATIONS
C
	BYTE IALPH, NAME, NMFIL
C
C***********************************************************************
C
C  DEBUG ROUTINE
C
100	IF(IDBUG.EQ.0) GOTO 200
C
	NIPT = IPT
	IF (IPT.EQ.0) THEN
		NIPT = 1
		CNT(1) = 0.0
		END IF
C
	WRITE(ITYP,1000) IDBUG, IACT, IPOINT,
     1	NREC, MVCNT, ISAVE, RATE, FIXERR, TEANG,
     2	BANG, CANG, EANG, TANG, PANG, DANG,
     3	NPK, TIME, NBG, BKGTIM, NPTPK, IPT, CNT(NIPT),
     4	((ITRANS(I,J),I=1,20),J=1,2)
C
1000	FORMAT(/,' >> DEBUG1 <<  BRANCH :  DEBUG=',I2,
     1	' IACT=',I2,' IPOINT=',I2,/,
     2	'  NREC=',I5,' MVCNT=',I1,' ISAVE=',I1,
     3	' RATE=',F5.1,' FIXERR=',F5.2,' TEANG=',F7.3,/,
     4	'  BANG=',F7.3,' CANG=',F7.3,' EANG=',F7.3,
     5	' TANG=',F7.3,' PANG=',F7.3' DANG=',F7.4,/,
     6	'  NPK=',I2,' TIME=',F7.2,' NBG=',I2,' BKGTIM=',F7.2,
     7	' NPTPK=',I4,' IPT=',I2,' CNT(IPT)=',F8.0,/,
     8	('  ITRANS:  ',I4,19I3))
C
C***********************************************************************
C
C	SUBSECTION:	REAL BRANCH
C
C
C	PROCEDURE CALL DEFINITIONS:
C
C		IGOTO1 = ROUTINE TO BE CALLED
C			IGOTO2 = MODE OF OPERATION
C
C		 0 = ERROR CONDITION, STACK IS EMPTY
C
C		 1 = CALL TO START A MOVE OPERATION (BGMOVE)
C
C		 2 = CALL TO FINISH A MOVE OPERATION (ENMOVE)
C
C		 3 = CALL TO START A COUNT OPERATION (BGCNT)
C
C		 4 = CALL TO FINISH A COUNT OPERATION (ENDCNT)
C
C		 5 = CALL TO LOCATE A PEAK (PKFIND)
C
C		 6 = CALL TO PEAK SCANNING ROUTINE (PKSCAN)
C
C		 7 = CALL TO MOVE AND COUNT ROUTINE (STPSCN)
C
C		 8 = CALL TO CARRY OUT QUANT ANALYSIS (RNQUAN)
C
C		 9 = CALL TO ESTIMATE COUNTING TIMES ON PEAK
C		     AND BACKGROUND AREAS (ESTIM)
C
C		10 = CALL TO TERMINATE THE RUN AFTER THE NEXT
C		     COMPLETION OF THE INTERFACE (FINIS)
C
C		11 = CALL QUANTITATIVE ANALYSIS COMPLETION
C		     ROUTINE (ENQUAL)
C
C		12 = CALL TO WRITE COLLECTED DATA TO THE
C		     OUTPUT DATA FILE (WRFILE)
C
C		20 = RETURN WITH NO OPERATION
C
C	THE LOOP WILL REPEAT UNTIL THE STACK IS EMPTY OR AN OPERATION
C  NUMBER 20 IS ENCOUNTERED.
C
C		CURRENT MAXIMUM IGOTO1 IS 9999.
C
C***********************************************************************
C
C  GET THE NEXT WORD OFF THE STACK.
C
200	CALL POP(IGOTO1,IGOTO2)
C
C***********************************************************************
C
C  CHECK FOR UNDEFINED COMMAND ERROR
C
	IF((IGOTO1.GE.1) .AND. (IGOTO1.LE.20)) GOTO 400
C
C  IF ITS AN EXIT COMMAND, PUT IT BACK AND RETURN.
C
	IF(IGOTO1.NE.9999) GOTO 300
	CALL PUSH(IGOTO1,IGOTO2)
	GOTO 9999
C
C  THE COMMAND IS BAD.  TELL THE OPERATOR.
C
300	WRITE(ITYP,1010) IGOTO1,IGOTO2
1010	FORMAT(/,' >> ERROR <<  UNDEFINED COMMAND ON STACK IN ',
     1	'BRANCH ROUTINE.',/,10X,'COMMAND: ',I4,'  MODE: ',I4,/)
C
C  IF ITS A ZERO THEN THE STACK IS EMPTY, RETURN
C
	IF(IGOTO1.EQ.0) GOTO 9999
C
C  SINCE COMMAND IS BAD IGNORE IT AND CONTINUE WITH NEXT COMMAND
C
	GOTO 100
C
C***********************************************************************
C
C  HERE IS THE MAIN COMPUTED GOTO
C
400	GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,
     1	16,17,18,19,20), IGOTO1
C
C***********************************************************************
C
C	COMMAND 1
C
1	CALL BGMOVE
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 2
C
2	CALL ENMOVE
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 3
C
3	CALL BGCNT
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 4
C
4	CALL ENDCNT(IGOTO2)
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 5
C
5	CALL PKFIND(IGOTO2)
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 6
C
6	CALL PKSCAN(IGOTO2)
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 7
C
7	CALL STPSCN(IGOTO2)
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 8
C
8	CALL RNQUAN(IGOTO2)
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 9
C
9	CALL ESTIM(IGOTO2)
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 10
C
10	CALL FINIS(IGOTO2)
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 11
C
11	CALL ENQUAL
	GOTO 100
C
C***********************************************************************
C
C	COMMAND 12
C
12	CALL WRFILE
	GOTO 100
C
C***********************************************************************
C
13	CONTINUE
14	CONTINUE
15	CONTINUE
16	CONTINUE
17	CONTINUE
18	CONTINUE
19	CONTINUE
	GOTO 9990
C***********************************************************************
C
C  RETURN. NO OPERATION NEEDED
C
20	GOTO 9999
C***********************************************************************
C***********************************************************************
C
C  TYPE THE MESSAGE FOR NONFUNCTIONING OPTIONS.  THEN GO GET THE
C  NEXT COMMAND.
C
9990	WRITE(ITYP,1020)
1020	FORMAT(/,'  >> STACK CALL NOT CURRENTLY IMPLIMENTED. <<',/)
	GOTO 100
C
C  AND SO ENDS ANOTHER CALL.  BACK TO MAIN - AUTO.
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		MOVEMENT CHECK AND PULSE CALCULATION
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE CHECKS FOR THE LEGALITY OF A MOVE
C	   AND ENSURES THAT IT IS AN INTEGRAL MULTIPLE OF THE STEP
C	   WIDTH GIVEN BY PPD.  IT ALSO GENERATES THE NUMBER OF
C	   INTERFACE PULSES THAT CORRESPOND TO THE REQUESTED MOVE,
C	   SETS A FLAG 'IBAD' AND PRINTS AN ERROR MESSAGE IF AN
C	   ERROR OCCURED.
C
C	THE ARGUMENTS ARE DEFINED AS FOLLOWS:
C
C		IPUL1 = THE THOUSANDS OF PULSES TO MOVE THE STEPPER
C		IPUL2 = THE UNITS, TENS, AND HUNDREDS OF PULSES TO
C			TO MOVE THE STEPPER
C		IBAD  = FLAG USED TO INDICATE:
C
C			+1 - ANGNEW WAS OUT OF RANGE OF ALIMLO
C			     AND ALIMHI
C			 0 - MOVE IS LEGAL
C	
C***********************************************************************
C
C	PROGRAMMER:
C
C		C. L. MALLORY
C		ALFRED UNIVERSITY
C		ALFRED, NY  14802
C		OCTOBER, 1979
C
C	MODIFIED BY:
C
C		DALE C. EARL
C		ALFRED UNIVERSITY
C		ALFRED, NY  14802
C		82/11/11 - USES COMMON BLOCK TO PASS ANGLES
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE CKANG(IPUL1,IPUL2,IBAD)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	DIMENSION NSTEP(2)
C
C  SET THE UPPER AND LOWER ANGLE LIMITS FOR THE DIFFRACTOMETERS
C
C	ALIMLO = LOWER TWO-THETA LIMIT OF THE GONIOMETER
C	ALIMHI = UPPER TWO-THETA LIMIT OF THE GONIOMETER
C
	ALIMLO = 2.94
	ALIMHI = 153.0
C
	IPUL1 = 0
	IPUL1 = 0
	IBAD = 0
C
C***********************************************************************
C
C  FIX THE ANGLE TO GET RID OF ROUND OFF ERRORS
C
	TANG = FIXANG(TANG)
C
C  CHECK IF TARGET ANGLE IS WITHIN  LIMITS
C
	IF ((TANG.LT.ALIMLO) .OR. (TANG.GT.ALIMHI)) GOTO 9000
C
C  CONVERT ANGLE CHANGE TO MOTOR PULSES
C
C	IPUL1 - THOUSANDS OF PULSES
C	IPUL2 - REMAINDER OF PULSES TO MOVE TO THE TARGET ANGLE
C
C  NOTICE BOTH IPUL1 AND IPUL2 ARE NEG WHEN THE MOVE IS NEGITIVE
C
	TEMP  = (TANG-CANG)*PPD
	IPUL1 = INT(TEMP/1000.)
	IPUL2 = NINT(TEMP-IPUL1*1000.)
C
C  CHECK FOR CONVERSION ROUND OFF ERRORS
C
D	TEMP = (IPUL1*1000 + IPUL2) / PPD
D	IF ((TANG-CANG).NE.TEMP) THEN
D		WRITE(ITYP,100) CANG, TANG, IPUL1, IPUL2, PPD, ANGLE
D100		FORMAT(/,' >> DEBUG0 <<  CKANG CONVERSION ROUND OFF '
D    1		'ERROR: CANG = ',F9.4,' TANG = ',F9.4,/,
D    2		'  IPUL1 = ',I5,' IPUL2 = ',I5,' PPD = ',F8.1,
D    3		' DELTA = ',F9.4)
D		END IF
C
C  ALL CHECKS PASSED - RETURN
C
	GOTO 9999
C
C***********************************************************************
C
C  ERROR DETECTED
C
9000	IBAD = 1
	IPUL1 = 0
	IPUL2 = 0
C
	WRITE(ITYP,9010) TANG,ALIMLO,ALIMHI
9010	FORMAT(/,' TARGET ANGLE: ',F8.3,' IS OUTSIDE LIMITS: ',
     1	F8.3,' AND',F8.3)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		CONSOL COMMAND EXECUTION PROGRAM
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS PROGRAM TAKES THE INPUT FROM THE CONSOL ROUTINE
C	   AND PERFORMS THE REQUEST REQUIRED.  THIS CAN CONSIST OF
C	   INLINE CODE ONLY OR OF STACK INSTRUCTIONS CALLED THROUGH
C	   THE BRANCH ROUTINE.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE CONJOB(ICODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		STACK:		STACK POINTER
C
	COMMON /STACK/	IPOINT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
C		QUAN:		QUANT PARAMETERS
C
	COMMON /QUAN/	CONC,		LOOP,		LPK,
     1	NUM(20),	IREPT,		SCONC
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME, NMFIL
C
C		TRUN:		CURRENT STATUS MESSAGE
C
	INTEGER TRUN(4,3)
C
	DATA TRUN/'IN','PO','QU','SL','AC','WD','AN','EW','TV','ER',
     1	'T ','  '/
C
C***********************************************************************
C
C	THE VALUE OF ICODE IS THE BRANCH VECTOR PASSED FROM CONSOL.
C  ASSUME ICODE WAS TESTED IN CONSOL FOR A VALUE IN THE LEGAL RANGE
C  AND BRANCH TO THE PROPER ROUTINE AS LISTED:
C
C		 1 - TYPE THE STATUS OF THE DEVICE
C		 2 - GIVE THE STORAGE DEVICE DIRECTORY
C		 3 - TRANSFER A FILE
C		 4 - DELETE A FILE
C		 5 - INITILIZE THE INTERFACE AND TRACKING
C		     COUNTER WITH THE CURRENT 2-THETA
C		 6 - SLEW TO A 2-THETA
C		 7 - OPEN THE SHUTTER
C		 8 - CREATE A RUN FILE
C		 9 - QUALITATIVE ANALYSIS RUN
C		10 - QUANTITATIVE ANALYSIS RUN
C		11 - TERMINATE THE CURRENT RUN
C		12 - CHANGE THE VALUE OF THE DEBUG FLAG
C		13 - STOP & EXIT
C
C***********************************************************************
C
C DO THE BRANCH
C
	GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13), ICODE
C
C***********************************************************************
C
C  TYPE THE STATUS OF THE COLLECTION UNIT
C
1	J = MAX(ITR,1)
	CALL DATIM
C
	WRITE(ITYP,110) ITIM, IDAT, CANG, IENRN, (TRUN(J,I),I=1,3),
     1	IACT, (NMFIL(I),I=1,14), TIME, BKGTIM
110	FORMAT(15X,'** STATUS ** AT ',I2,':',I2.2,':',I2.2,' ON ',
     1	I2,'/',I2.2,'/',I2.2,//,
     2	'  CURRENT 2-THETA:',4X,F9.3,3X,
     3	'TO END AT:',5X,I2,':',I2.2,2X,I2,'/',I2.2,'/',I2.2,/,
     4	'  RUN:',8X,3A2,5X,I2,7X,'FILE:',8X,14A1,/,
     5	'  COUNT TIME:',9X,F9.3,3X,'BKGRND TIME:',F9.3)
C
	GOTO 9999
C
C***********************************************************************
C
C  TYPE A STORAGE DEVICE DIRECTORY
C
C2	CALL CATALG
C	GOTO 9999
2	GOTO 9990
C
C***********************************************************************
C
C  TRANSFER A FILE
C
C3	CALL TRANS
C	GOTO 9999
3	GOTO 9990
C
C***********************************************************************
C
C  DELETE A FILE
C
C4	CALL DELETE
C	GOTO 9999
4	GOTO 9990
C
C***********************************************************************
C
C  SET THE INTERNAL REGISTERS WITH CORRECT 2-THETA
C
C  IF DEVICE IS INACTIVE OR ERRORED THIS OPTION IS ALLOWED
C
5	IF(IACT.LE.0) GOTO 5110
	WRITE(ITYP,5100)
5100	FORMAT(/,' DEVICE IS ACTIVE, ACTION CANCELED.')
	GOTO 5999
C
C  CALL IFINIT TO SET THE INTERFACE WITH AN ANGLE
C
5110	CALL IFINIT
5999	GOTO 9999
C
C***********************************************************************
C
C  ABSOLUTE SLEW REQUESTED, GET THE TARGET ANGLE
C
C  IF DEVICE IS ACTIVE WE CAN'T DO THIS
C
6	IF(IACT.EQ.0) GOTO 6110
	WRITE(ITYP,6100)
6100	FORMAT(/,' DEVICE IS ACTIVE, ACTION CANCELED.')
	GOTO 6999
C
6110	WRITE(ITYP,6120) CANG
6120	FORMAT(/,' CURRENT 2-THETA = ',F7.3,/
     1	' ENTER TARGET 2-THETA (F7.3): ',$)
	READ(IRD,6130) TANG
6130	FORMAT(F7.3)
C
C  START THE SLEW
C
	IF(CANG.EQ.TANG) GOTO 6999
C
	CALL PUSH(20,0)
C
	ITR = 4
	RATE = 0.0
	CALL BGMOVE
	CALL POP(J1,J2)
6999	GOTO 9999
C
C***********************************************************************
C
C OPEN THE SHUTTER ON THE XRAY TUBE
C
7	GOTO 9990
C
C***********************************************************************
C
C  CREATE A RUNFILE FOR A SUBSEQUENT OPERATION
C
8	CALL RUNFIL(0)
	GOTO 9999
C
C***********************************************************************
C
C  START A QUALITATIVE DATA COLLECTION RUN
C
9	IF(IACT.EQ.0) GOTO 9110
	WRITE(ITYP,9100)
9100	FORMAT(/,' DEVICE IS ACTIVE, ACTION CANCELED.')
	GOTO 9099
C
9110	CALL QUAL
9099	GOTO 9999
C
C***********************************************************************
C
C  START A QUANTITATIVE DATA COLLECTION RUN
C
10	IF(IACT.EQ.0) GOTO 10110
	WRITE(ITYP,10100)
10100	FORMAT(/,' DEVICE IS ACTIVE, ACTION CANCELED.')
	GOTO 10999
C
10110	CALL BGQUAN
10999	GOTO 9999
C
C***********************************************************************
C
C  TERMINATE A RUN EARLY
C
C  IF DEVICE IS INACTIVE THERE IS NO NEED TO KILL IT
C
11	IF(IACT.GT.0) GOTO 11110
	WRITE(ITYP,11100)
11100	FORMAT(/,' DEVICE IS ALREADY INACTIVE.')
	GOTO 11999
C
C  FIND OUT WHICH TYPE OF EXIT, HARD OR SOFT ?
C
11110	WRITE(ITYP,11120)
11120	FORMAT(/,' ENTER: 0  - PANIC STOP (2-THETA WILL BE LOST)',/,
     1	8X,'1  - KILL JOB AFTER NEXT COMPLETION',/,' ? ',$)
	READ(IRD,11130) ICODE
11130	FORMAT(I1)
C
C  CHECK FOR LEGAL INPUT
C
	IF(ICODE.EQ.0.OR.ICODE.EQ.1) GOTO 11150
	WRITE(ITYP,11140) ICODE
11140	FORMAT(/,' ILLEGAL INPUT: ',I4)
	GOTO 11110
C
C  CALL FINIS WITH THE PROPER CODE
C
11150	CALL FINIS(ICODE)
C
C
11999	GOTO 9999
C
C***********************************************************************
C
C  RESET THE DEBUG OUTPUT FLAG
C
12	WRITE(ITYP,12100)
12100	FORMAT(/,' ENTER DEBUG FLAG (0 = OFF) ? ',$)
	READ(IRD,12110) IDBUG
12110	FORMAT(I4)
C
C  DISPLAY DEBUG DATA ONCE NO MATTER WHAT THE VALUE
C
	NIPT = IPT
	IF (IPT.EQ.0) THEN
		NIPT = 1
		CNT(1) = 0.0
		END IF
C
	WRITE(ITYP,12120) IDBUG, IACT, IPOINT,
     1	NREC, MVCNT, ISAVE, RATE, FIXERR, TEANG,
     2	BANG, CANG, EANG, TANG, PANG, DANG,
     3	NPK, TIME, NBG, BKGTIM, NPTPK, IPT, CNT(NIPT),
     4	((ITRANS(I,J),I=1,20),J=1,2)
C
12120	FORMAT(/,' >> DEBUG1 <<  CONJOB :  DEBUG=',I2,
     1	' IACT=',I2,' IPOINT=',I2,/,
     2	'  NREC=',I5,' MVCNT=',I1,' ISAVE=',I1,
     3	' RATE=',F5.1,' FIXERR=',F5.2,' TEANG=',F7.3,/,
     4	'  BANG=',F7.3,' CANG=',F7.3,' EANG=',F7.3,
     5	' TANG=',F7.3,' PANG=',F7.3' DANG=',F7.4,/,
     6	'  NPK=',I2,' TIME=',F7.2,' NBG=',I2,' BKGTIM=',F7.2,
     7	' NPTPK=',I4,' IPT=',I2,' CNT(IPT)=',F8.0,/,
     8	('  ITRANS:  ',I4,19I3))
C
	GOTO 9999
C
C***********************************************************************
C
C  HE'S HAD ENOUGH.  EXIT BACK THROUGH MAIN.
C
13	CALL PUSH(9999,0)
C
C  LEAVE THE DIFFRACTOMETER AT 90. DEGREES
C
	RATE = 0.0
	ISAVE = 0
	TANG = 90.
	TANG = FIXANG(TANG)
C
	IF (CANG.NE.TANG) THEN
		CALL BGMOVE
		CALL POP(J1,J2)
		END IF
C
	GOTO 9999
C
C***********************************************************************
C***********************************************************************
C
C OPTION NOT IMPLEMENTED YET
C
9990	WRITE(ITYP,9991)
9991	FORMAT(/,'  >> OPTION NOT IMPLEMENTED <<')
C
C***********************************************************************
C
C ALL DONE HERE
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			TERMINAL CONTROL SUBROUTINE
C
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS SUBROUTINE PROCESSES INPUT FROM THE USERS TERMINAL.
C	   THE FUNCTION OF THIS PROGRAM IS TO OUTPUT THE MENU, INPUT THE
C	   USER REQUEST, TEST FOR VALIDITY, AND CALL THE SET UP ROUTINE
C	   TO ACTUALLY PERFORM THE CONSOL FUNCTIONS.  THE MENU IS
C	   PRINTED ONLY WHEN THE PASSED VALUE = 1.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE CONSOL(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
	DIMENSION MAP(20)
	DATA MAP/1,5,6,8,9,10,11,13,12,11*0/
C
C***********************************************************************
C
C	SUBSECTION:	MENU OUTPUT
C
C  IF MODE = 1 WRITE THE MENU TO THE TERMINAL DEVICE
C
	IF(MODE.NE.1) GOTO 20
C
C  PRINT OUT THE LIST OF OPTIONS
C
10	WRITE(ITYP,1000)
C
C1000	FORMAT(/,10X,'** AUTO CONTROL **'//
C     1 1H ,'ENTER ONE OF THE FOLLOWING OPTIONS :'//
C     2 5X,' 1 - GIVE THE DEVICE STATUS'/
C     3 5X,' 2 - STORAGE DEVICE DIRECTORY'/
C     4 5X,' 3 - TRANSFER A FILE'/
C     5 5X,' 4 - DELETE A FILE'/
C     6 5X,' 5 - INITILIZE THE INTERFACE AND SET THE 2-THETA'/
C     7 5X,' 6 - MOVE THE GONIOMETER'/
C     8 5X,' 7 - OPEN THE SHUTTER ON THE XRAY TUBE'/
C     9 5X,' 8 - CREATE A QUANTITATIVE ANALYSIS COMMAND FILE'/
C     + 5X,' 9 - QUALITATIVE ANALYSIS DATA COLLECTION'/
C     1 5X,'10 - QUANTITATIVE ANALYSIS DATA COLLECTION'/
C     2 5X,'11 - TERMINATE AN ACTIVE RUN'/
C     3 5X,'12 - SET THE DEBUG FLAG'/
C     4 5X,'13 - STOP')
C
C   MODIFIED MENU
C
1000	FORMAT(/,10X,'** AUTO CONTROL **'//
     1 1H ,'ENTER ONE OF THE FOLLOWING OPTIONS :'//
     2 5X,' 1 - GIVE THE DEVICE STATUS'/
     6 5X,' 2 - INITILIZE THE INTERFACE AND SET THE 2-THETA'/
     7 5X,' 3 - MOVE THE GONIOMETER'/
     9 5X,' 4 - CREATE A QUANTITATIVE ANALYSIS COMMAND FILE'/
     + 5X,' 5 - QUALITATIVE ANALYSIS DATA COLLECTION'/
     1 5X,' 6 - QUANTITATIVE ANALYSIS DATA COLLECTION'/
     2 5X,' 7 - TERMINATE AN ACTIVE RUN'/
     4 5X,' 8 - STOP')
C
C***********************************************************************
C
C  READ THE MENU OPTION CHARACTER IN DECIMAL
C
20	WRITE(ITYP,1010)
1010	FORMAT(/,'  ? ',$)
	READ(IRD,1020) ICODE
1020	FORMAT(I4)
C
C  WAS A LEGAL CODE ENTERED?
C
	IF(ICODE .GE. 1 .AND. ICODE .LE. 9) GOTO 30
	IF(ICODE.EQ.0) GOTO 10
	WRITE(ITYP,1030) ICODE
1030	FORMAT(/,' ILLEGAL OPTION:',I4,/)
	GOTO 20
C
C***********************************************************************
C
C  MAP THE INPUT TO THE PROPER CODE
C
30	ICODE = MAP(ICODE)
C
C  CALL THE ROUTINE TO DO THE ACTUAL FUNCTION SELECTED
C
	CALL CONJOB(ICODE)
C
C************************************************************************
C
C  ALL DONE - RETURN TO THE POLLING PROCEDURE OF MAIN
C
	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		AUTO SYSTEM DATE AND TIME ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE CONVERTS THE FORMAT OF THE DATE/TIME
C	   OF THE PDP-11/23 FROM DD-MMM-YY AND HH:MM:SS TO DIGITS.
C	   IT ASSUMES MMM IS THE FIRST 3 CHARACTERS OF THE GIVEN
C	   MONTH AND STORES:
C
C	MM IN IDAT(1)    DD IN IDAT (2)    YY IN IDAT(3) IN I FORMAT
C	HH IN ITIM(1)    MM IN ITIM(2)     SS IN ITIM(3) IN I FORMAT
C
C
C		USE OF COMMON STATEMENTS MAKES THIS SUBROUTINE
C	   DEPENDENT UPON THE AUTO SYSTEM. DELETION OF THE COMMON
C	   STATEMENTS AND PASSING ARRAYS IDAT AND ITIM AND AN
C	   ERROR VARIABLE IERROR WOULD ALLOW THE USE OF THIS
C	   SUBROUTINE IN ANOTHER SYSTEM.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE DATIM
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C
C***********************************************************************
C
C	VARIABLE DECLARATIONS:
C
	BYTE DAT(9),TIM(8),MO(36)
	DATA MO/'J','A','N','F','E','B','M','A','R','A','P','R',
     1	'M','A','Y','J','U','N','J','U','L','A','U','G',
     2	'S','E','P','O','C','T','N','O','V','D','E','C'/
C
C***********************************************************************
C
C  OBTAIN THE DATE FROM THE PDP-11 SYSTEM CLOCK
C
	CALL DATE(DAT)
C
C***********************************************************************
C
C  STORE THE DAY IN IDAT(2)
C
C	>>  MUST BE CONVERTED TO INTERNAL READ/WRITE FOR ANSF  <<
C
	DECODE(2,1010,DAT(1))IDAT(2)
C
C
C  CONVERT THE 3 CHARACTER PDP-11 MONTH TO DIGITS
C  AND STORE IN IDAT(1)
C
C  DETERMINE MONTH NO. BY COMPARING WITH ARRAY "MO"
C
	IDAT(1) = 0
	DO 100 I = 1,36,3
	IF(DAT(4).EQ.MO(I).AND.DAT(5).EQ.MO(I+1).AND.
     1	DAT(6).EQ.MO(I+2)) IDAT(1) = (I+2)/3
100	CONTINUE
C
C
C  STORE YEAR IN IDAT(3)
C
C	>>  MUST BE CONVERTED TO INTERNAL READ/WRITE FOR ANSF  <<
C
	DECODE(2,1010,DAT(8))IDAT(3)
C
C
C  IF DATE HAS NOT BEEN SET WARN USER OF THE CONSEQUENCES
C
	IF(IDAT(3).GT.83) GOTO 200
	WRITE(ITYP,1000)
1000	FORMAT(/,5X,'THE SYSTEM DATE IS NOT SET.  IF THIS IS',
     1  ' PROGRAM AUTO YOU MAY',/,' ABORT AND RESTART, ELSE',
     2	'  ACCEPT THE ZERO DATE',/)
C
1010	FORMAT(I2)
C
C***********************************************************************
C
C   STORE TIME IN RELEVANT VARIABLES
C
200	CALL TIME(TIM)
C
C	>>  MUST BE CONVERTED TO INTERNAL READ/WRITE FOR ANSF  <<
C
	DECODE(2,1020,TIM(1))ITIM(1)
	DECODE(2,1020,TIM(4))ITIM(2)
	DECODE(2,1020,TIM(7))ITIM(3)
1020	FORMAT(I2)
C
C***********************************************************************
C
C  SHOW  DATE/TIME CONVERSION (COMMENTED OUT FOR NORMAL SUBROUTINE USE)
C
C	WRITE(ITYP,1030)DAT,TIM,IDAT,ITIM
C1030	FORMAT(/,5X,'SYSTEM DATE AND TIME: ',9A1,2X,8A1,3X,
C     1	/,5X,'WAS CONVERTED TO: ',3I2,3X,3I2)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			FILE DELETION ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C	THIS ROUTINE DELETES A FILE VIA A SYSTEM ROUTINE.  PROMPT
C  FOR THE FILE NAME MAY BE SKIPPED IF IT IS ALREADY STORED IN
C  ARRAY NAME.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE DELETE(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(15)
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME, REPLY
	BYTE IDK1, IDK2, ICLN, IDOT, IBLK
	BYTE FILE(8),FILDEV(3)
C
	DATA IDK1/'D'/, IDK2/'K'/, ICLN/':'/, IDOT/','/, IBLK/' '/
C
C***********************************************************************
C***********************************************************************
C
C  DO WE WANT TO PROMPT FOR THE NAME ?
C
	IF (MODE.EQ.1) GOTO 200
C
C***********************************************************************
C
C  GET THE FILE NAME
C
	WRITE(ITYP,100)
100	FORMAT(/,' PLEASE ENTER THE FILE YOU WISH TO DELETE.')
C
	CALL FILNAM
C
C  VERIFY DELETE COMMAND
C
	WRITE(ITYP,110) (NAME(I),I=1,14)
110	FORMAT(/,' DELETE ',14A1,' (Y/N) ? ',$)
C
	READ(IRD,120) REPLY
120	FORMAT(A1)
	IF(REPLY .NE. 'Y') GOTO 9999
C
C***********************************************************************
C
C  FILE NAME TO BE DELETED IS STORED IN ARRAY NAME, CHARACTERS 1-15
C
C  TEST IF DEVICE WAS SPECIFIED.  IF NOT, DEFAULT TO DK:
C
200	IF ((NAME(3).EQ.ICLN) .OR. (NAME(4).EQ.ICLN)) GOTO 220
C
C  SLIDE NAME AND ADD DK:
C
	DO 210, I=10,1,-1
210	NAME(I+3) = NAME(I)
C
	NAME(1) = IDK1
	NAME(2) = IDK2
	NAME(3) = ICLN
C
C  DEFAULT DEVICE DRIVER IS ALWAYS LOADED SO SKIP LOAD
C
	GOTO 300
C
C***********************************************************************
C
C  LOCATE THE COLON TO STRIP THE DEVICE NAME OFF
C
220	IF (NAME(4).EQ.ICLN) GOTO 240
C
	DO 230, I=13,3,-1
230	NAME(I+1) = NAME(I)
	NAME(3) = IBLK
C
240	ENCODE(3,250,IDEVIC) (NAME(I),I=1,3)
250	FORMAT(3A1)
C
	CALL IRAD50(3,IDEVIC,HANDLR)
C
	I=IFETCH(HANDLR)
	IF (I.NE.0) GOTO 9000
C
C   ALLOCATE A CHANNEL TO DELETE FILE
C
	ICHANL=IGETC()
	IF (ICHANL.LT.0) GOTO 9020
C
C***********************************************************************
C
C   DELETE THE FILE, ENCODE AND IRAD50 ARE NEEDED IN THE PROCESS
C
C  FILL OUT THE REST OF THE STRING WITH SPACES, FIRST THE NAME
C
300	K = 0
	DO 310, I=1,14
	IF (NAME(I).EQ.IDOT) K=I
310	CONTINUE
	IF (K.EQ.0) K=11
C
	IF (K.EQ.11) GOTO 330
	DO 320, I=11,K,-1
	NAME(I+3) = NAME(I)
320	NAME(I) = IBLK
C
C  STRING IS NOW SET (FORM = AAA:AAAAAA.AAA)
C
330	ENCODE(12,340,FILDEV) (NAME(I),I=1,3),
     1	(NAME(I),I=5,10),(NAME(I),I=12,14)
340	FORMAT(12A1)
	CALL IRAD50(12,FILDEV,FILE)
C
C***********************************************************************
C
C  STRING IS STORED RAD50 SO NOW DELETE IT
C
400	K=IDELET(ICHANL,FILE)
C
	IF (K.EQ.2) GOTO 9040
	IF (K.NE.0) GOTO 9060
C
C  DELETION COMPLETED WITHOUT AN ERROR
C
410	WRITE(ITYP,420) (NAME(I),I=1,14)
420	FORMAT(/' FILE ',14A1,' WAS DELETED.'/)
C
C  FREE THE ALLOCATED CHANNEL AGAIN
C
	CALL IFREEC(ICHANL)
C
	GOTO 9999
C
C***********************************************************************
C
9000	WRITE(ITYP,9010)
9010	FORMAT(/' >> DELETE ERROR << - HANDLER UNAVAILABLE')
	GOTO 9999
C
9020	WRITE(ITYP,9030)
9030	FORMAT(/' >> DELETE ERROR << - CHANNEL NOT AVAILABLE')
	GOTO 9999
C
9040	WRITE(ITYP,9050)
9050	FORMAT(/' >> DELETE ERROR << - FILE WAS NOT FOUND')
	GOTO 9999
C
9060	WRITE(ITYP,9070)
9070	FORMAT(/' >> DELETE ERROR << - DELETE FAILED')
	GOTO 9999
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			COUNT COMPLETION ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C  THIS SUBROUTINE READS THE COUNTER FROM EITHER FIXED TIME OR FIXED
C  COUNT MODE.  IN EITHER FIXED TIME OR FIXED COUNT MODE OR DUAL MODE
C  THE DATA IS STORED AS FOLLOWS:
C
C	TIME  COMPLETION STORES COUNTS (+) IN CNT(IPT)
C	COUNT COMPLETION STORES TIME AS A NEGATIVE # IN CNT(IPT)
C
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE ENDCNT
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME
C
C***********************************************************************
C
C  DEBUG ENTRY NOTICE
C
D	IF (IDBUG.GE.2) THEN
D		WRITE(5,112)
D112		FORMAT(' >> DEBUG2 <<  ENDCNT - ENTRY.')
D		END IF
C
C  SET THE ACTIVITY FLAG
C
	IACT = 0
C
C***********************************************************************
C
C  READ THE STATUS FLAGS TO SEE WHAT COMPLETED
C
	ENCODE(2,100,IALPH) 'Q*'
100	FORMAT(A2)
	CALL IFOUTP(NBS,IALPH,2,IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
	IERROR = 2
	CALL IFINP(NBS,IALPH,9,IERROR)
	IF (IERROR.GE.0) GOTO 9000
C
	DECODE(5,110,IALPH) I1,I2,I3
110	FORMAT(I1,X,I1,X,I1)
C
D	IF (IDBUG.GE.3) THEN
D		WRITE(7,111) (IALPH(I), I=1,20),IERROR,I1,I2,I3
D111		FORMAT(' >> DEBUG3 <<  ENDCNT - IALPH = ',20A1,/,
D    1		' IERROR: ',I,/,' I1: ',I,' I2: ',I,' I3: ',I)
D		END IF
C
C***********************************************************************
C
C  CHOOSE WHICH VALUE TO STORE (COUNTS OR TIME)
C
	IF ((ISAVE.EQ.1).AND.(I1.EQ.1)) GOTO 200
	IF ((MVCNT.EQ.2).AND.(I1.EQ.1)) GOTO 200
	IF ((I2.NE.1).AND.(I3.NE.1)) GOTO 9000
	IF (I3.NE.1) GOTO 300
C
C***********************************************************************
C
C  READ AND STORE THE COUNTS (TIME LIMIT REACHED)
C
200	ENCODE(4,210,IALPH) 'R',MODULE(1),'*'
210	FORMAT(A1,I2,A1)
C
	CALL IFOUTP(NBS,IALPH,4,IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
	IERROR = 2
	CALL IFINP(NBS,IALPH,9,IERROR)
	IF (IERROR.GE.0) GOTO 9000
C
	DECODE(6,220,IALPH) CNT(IPT)
220	FORMAT(F6.0)
	GOTO 9999
C
C***********************************************************************
C
C  READ AND STORE THE TIME AS A NEG. NUMBER (COUNT LIMIT REACHED)
C
300	ENCODE(4,310,IALPH) 'R',MODULE(2),'*'
310	FORMAT(A1,I2,A1)
C
	CALL IFOUTP(NBS,IALPH,4,IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
	IERROR = 2
	CALL IFINP(NBS,IALPH,9,IERROR)
	IF (IERROR.GE.0) GOTO 9000
C
	DECODE(6,320,IALPH) CNT(IPT)
320	FORMAT(F6.2)
	CNT(IPT) = -CNT(IPT)
	GOTO 9999
C
C***********************************************************************
C
C  AN INTERFACE ERROR HAS OCCURED, COMMEMT IT AND ABORT.
C
9000	WRITE(ITYP,9010)
9010	FORMAT(/,'  >> ERROR << - INTERFACE ERROR IN ENDCNT, ABORTING')
C
	CALL PUSH(10,4)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		COMPLETION OF GONIOMETER MOVE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE COMPLETES THE MOVE ROUTINE WHEN IT
C	   IS CALLED OFF THE STACK ON A COMPLETION FROM THE
C	   INTERFACE.  COUNTS AND TIME ARE STORED IF NEEDED AND
C	   THE DIFFRACTOMETER ACTIVITY CODE IS RESET AND UPDATES
C	   CURRENT ANGLE VARIABLE.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE ENMOVE
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME, NMFIL
C
C***********************************************************************
C
D	IF (IDBUG.GE.2) THEN
D		WRITE(5,100)
D100		FORMAT(' >> DEBUG2 <<  ENMOVE - ENTRY.')
D		END IF
C
C  CALL ENDCNT TO COLLECT THE INTEGRATED DATA POINT IF NEEDED
C
	IF (ISAVE.EQ.1) CALL ENDCNT
C
C***********************************************************************
C
C  READ AXIS POSITIONER TO SET CURRENT ANGLE
C
300	ENCODE(4,310,IALPH) 'R',MODULE(3),'*'
310	FORMAT(A1,I2,A1)
	CALL IFOUTP(NBS,IALPH,4,IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
	IERROR = 2
	CALL IFINP(NBS,IALPH,8,IERROR)
	IF (IERROR.GE.0) GOTO 9000
C
D	IF (IDBUG.GE.3) THEN
D		WRITE(5,330) '3','R',(IALPH(K), K=1,20)
D330		FORMAT(' >> DEBUG',A1,' <<  ENMOVE (',A1,')',
D    1		' - IALPH = ',20(':',A1),':')
D		END IF
C
	DECODE(5,320,IALPH(1)) CANG
320	FORMAT(F6.0)
C
	CANG = CANG/PPD
C
	CANG = FIXANG(CANG)
	IF ((CANG.NE.TANG).AND.(.NOT.((CANG.EQ.FIXANG(TANG-.05)).AND.
     1	(IACT.EQ.3)))) THEN
		WRITE(ITYP,340) CANG, TANG, IACT
340		FORMAT(' >> ENMOVE <<  MOVE FAILURE: CANG = ',F9.4,
     1		' TANG = ',F9.4,' IACT = ',I2)
		END IF
C
	IF (ITR.EQ.4) ITR = 1
	IACT = 0
C
C***********************************************************************
C
C  THE STATUS FLAGS NEED TO BE CLEARED
C
	ENCODE(2,400,IALPH) 'Q*'
400	FORMAT(A2)
C
	CALL IFOUTP(NBS,IALPH,2,IERROR)
	IF (IERROR.NE.0) GOTO 9000
C
	IERROR = 2
	CALL IFINP(NBS,IALPH,9,IERROR)
	IF (IERROR.GE.0) GOTO 9000
C
D	IF (IDBUG.GE.4) THEN
D		WRITE(5,330) '4','Q',(IALPH(K), K=1,20)
D		END IF
C
490	GOTO 9999
C
C***********************************************************************
C
C  ABNORMAL TERMINATION SECTION
C  CALL FINIS IN MODE 5
C
9000	WRITE(ITYP,9010)
9010	FORMAT(/,'  >> ERROR << - ABNORMAL TERMINATION IN ENMOVE')
	CALL PUSH(10,4)
C
C***********************************************************************
C
C  ENMOVE IS DONE - RETURN TO CALLING PROGRAM
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C	QUALITATIVE ANALYSIS DATA INPUT COMPLETION ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE PICKS FROM QUAL UP AFTER THE INITIAL
C	   SLEW TO THE BEGINNING ANGLE IN COMPLETED AND PROMPTS TO
C	   MAKE SURE EVERYTHING IS READY.
C
C***********************************************************************
C
	SUBROUTINE ENQUAL
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
	BYTE IY, IALPH, NAME
	DIMENSION IGOTO(2)
C
C***********************************************************************
C
C  CHECK THAT SAMPLE IS MOUNTED AND THAT THE SHUTTER IS OPENED
C
100	WRITE(ITYP,110)
110	FORMAT(/,' LOAD SAMPLE AND OPEN SHUTTER.',
     1	//,' ENTER R FOR READY OR X FOR EXIT: ',$)
	READ(IRD,120) IY
120	FORMAT(A1)
C
	IF ((IY.NE.'X').AND.(IY.NE.'R')) GOTO 100
C
C***********************************************************************
C
C  CHECK THAT AN "R" WAS ENTERED
C
	IF (IY.NE.'R') GOTO 500
C
C  NOW WE BEGIN DATA COLLECTION BY CALLING STEP SCAN.
C
	CALL STPSCN(0)
C
	GOTO 9999
C
C***********************************************************************
C
C  EXIT: DELETE FILE AND THEN CALL FINIS
C
500	CONTINUE
C	CALL DELETE
C
	CALL PUSH(10,3)
C
	WRITE(ITYP,510)
510	FORMAT(/,'  QUALITATIVE RUN CANCELED')
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			COMPLETION TIME
C
C***********************************************************************
C
C	DESCRIPTION:
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***********************************************************************
C***********************************************************************
C
	SUBROUTINE ENTIM(RUN)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(0:20,2),	MVCNT
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
	BYTE NMFIL
C
C***********************************************************************
C
C  THE RESULT IS STORED IN THE ARRAY IENRN AS:
C
C		IENRN(1) = HOURS
C		IENRN(2) = MINUTES
C		IENRN(3) = MONTH
C		IENRN(4) = DAY
C		IENRN(5) = YEAR
C
C***********************************************************************
C
C  GET THE CURRENT DATE AND TIME
C
90	CALL DATIM
C
	IMON = IDAT(1)
	IDAY = IDAT(2)
	IYR  = IDAT(3)
C
C***********************************************************************
C
C  CONVERT RUN TIME TO HRS AND MIN
C
	IHR = INT(RUN/60.)
	IMN = INT(RUN-IHR*60) + 1
C
C  ADD THE HRS AND MIN TO THE CURRENT TIME  -  FIRST THE MINUTES
C
	IMN = ITIM(2) + IMN
	IF (IMN .LT. 60) GOTO 100
	IHR = IHR + 1
	IMN = IMN - 60
C
C  NEXT HOURS
C
100	IHR = ITIM(1) + IHR
110	IF (IHR .LT. 24) GOTO 200
	IDAY = IDAY + 1
	IHR = IHR - 24
	GOTO 110
C
C***********************************************************************
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
C***********************************************************************
C
C  JUMP TO A NEW YEAR IF NECESSARY
C
300	IF (IMON.LT.13) GOTO 400
	IYR = IYR + 1
	IMON = IMON - 12
	GOTO 300
C
C***********************************************************************
C
C  STORE INTO END RUN ARRAY IENRN
C
400	IENRN(1) = IHR
	IENRN(2) = IMN
	IENRN(3) = IMON
	IENRN(4) = IDAY
	IENRN(5) = IYR
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		PEAK AND BACKGROUND ESTIMATE ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C	   THIS SUBROUTINE MAKES A RAPID ESTIMATE OF THE PEAK AND
C	BACKGROUND INTENSITIES OF A LINE SO THAT THE PEAK AND
C	BACKGROUND COUNT TIMES CAN BE OPTIMIZED BY SUBROUTINE OPTIM.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE ESTIM(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
C		NONE
C
C***********************************************************************
C
C  MODE	= 0   FIRST ENTRY. 2THETA MUST BE AT BANG FOR BKG COUNT!
C	= 1   LOW BKG COUNT COMPLETED, SET UP PEAK COUNT
C	= 2   COMPLETE ESTIM BY CALCULATING THE REQUIRED COUNT TIMES
C	      FOR THE PEAK AND BACK GROUND
C
C***********************************************************************
C
C  BRANCH TO PROPER SECTION
C
	IF (MODE.EQ.1) GOTO 200
	IF (MODE.EQ.2) GOTO 300
C
C***********************************************************************
C
C  IF NO BACKGROUND POINTS ARE TO BE MEASURED SET CNT(1)=0 AND
C  SKIP TO PEAK ESTIMATION
C
	CNT(1) = 0
	IF (NBG.EQ.0) GOTO 200
C
C  WE ARE NOW AT THE LOW ANGLE BACKGROUND - COUNT FOR ONE SECOND
C
	TIME = 1.0
C
C  AT END OF COUNT WE MUST RETURN TO THE NEXT SECTION
C
	CALL PUSH(9,1)
C
C  COUNT COMPLETION COMES JUST BEFORE THAT
C
	IPT = 1
	CALL PUSH(4,-1)
C
C  WAIT FOR THE COUNT TO COMPLETE
C
	CALL PUSH(20,0)
C
C  GO DO THE JOB
C
	CALL BGCNT
C
	GOTO 9999
C
C***********************************************************************
C
C  COLLECT A PEAK COUNT OR SCAN VALUE
C
C
C  FIRST SET THE RETURN CALL TO COMPLETE THE ESTIM PROCEDURE
C
200	CALL PUSH(9,2)
C
	IPT = 2
	TIME = 1.0
C
C  WHICH COLLECTION TYPE DO WE WANT?
C
	IF (IPK.EQ.1) GOTO 250
C
C***********************************************************************
C
C  INTEGRATE OVER THE PEAK
C
C
C  SET UP FOR THE SCAN
C
	ISAVE = 1
	RATE = 50.0
	TANG = EANG
C
C  SKIP TO COMMON STARTING POINT
C
	GOTO 290
C
C***********************************************************************
C
C  MOVE TO THE PEAK AND COUNT
C
C
C  LAST THING FIRST, FINISH COUNT.
C
250	CALL PUSH(4,-1)
C
C  WAIT FOR THE COUNT TO COMPLETE
C
	CALL PUSH(20,0)
C
C  START THE COUNTING PROCEDURE
C
	CALL PUSH(3,0)
C
C  SET UP FOR THE MOVE
C
	ISAVE = 0
	RATE = 0.0
	TANG = PANG
C
C***********************************************************************
C
C  BEGIN THE MOVE
C
290	CALL BGMOVE
C
	GOTO 9999
C
C***********************************************************************
C
C  COMPLETE THE ESTIM OPERATION BY CALCULATING THE COUNT TIMES
C
C
C  FIRST CALCULATE THE AVG. CPS FOR AN INTEGRATED PEAK
C
300	IF (IPK.EQ.0) CNT(2)=CNT(2)/((60*(EANG-BANG))/RATE)
C
C  CHECK THE BACKGROUND FOR OVERFLOW AND ZERO
C
	IF (CNT(1).EQ.0) CNT(1) = 1.
	IF (CNT(1).LT.0) CNT(1) = 900000.
C
C  CHECK THE PEAK INTENSITY
C
	IF (CNT(2).EQ.0) CNT(2) = 1.
	IF (CNT(2).LT.0) CNT(2) = 900000.
C
C***********************************************************************
C
C  NOW OPTIMIZE THE PEAK AND BACKGROUND COUNT TIMES
C
400	CALL OPTIM
C
C  SET TIME AND BKGTIM AS REQUIRED BY INTERFACE
C
	TIME = FIXTIM(TIME)
	BKGTIM = FIXTIM(BKGTIM)
C
C***********************************************************************
C
C  SLEW BACK TO BANG BEFORE LEAVING ESTIM FOR THE LAST TIME
C
600	TANG = BANG
	ISAVE = 0
	RATE = 0.0
C
	CALL BGMOVE
C
C***********************************************************************
C
9999	CONTINUE
	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			GET THE FILE HEADER DATA
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS SUBROUTINE INPUTS THE USER'S NAME, RUN TITLE,
C	   AND DATA FILE NAME FOR OUTPUT TO THE SPECIFIED DATA FILE
C	   ALONG WITH THE CURRENT SYSTEM DATE AND TIME.
C
C***********************************************************************
C***********************************************************************
C
      SUBROUTINE FILEUP(ID)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C
	BYTE IALPH, NAME, NMFIL
C
	DATA IBLANK/'  '/
C
C********************************************************************
C
C  READ THE OPERATOR'S NAME
C
100	WRITE(ITYP,1000)
1000	FORMAT(/,' ENTER YOUR NAME (10A2):',$)
	READ(IRD,1010) (ITITLE(I),I=41,50)
1010	FORMAT(10A2)
C
	DO 110 , I=41,50
	IF (ITITLE(I).NE.IBLANK) GOTO 200
110	CONTINUE
C
	GOTO 100
C
C***********************************************************************
C
C  READ THE TITLE
C
200	WRITE(ITYP,1020)
1020	FORMAT(/,' ENTER THE RUN TITLE (40A2)',/,' :',$)
	READ (IRD,1030)(ITITLE(I),I=1,40)
1030	FORMAT(40A2)
C
C***********************************************************************
C
C  GET THE DATE AND TIME
C
	CALL DATIM
C
C  GET THE NAME OF THE OUTPUT FILE
C
	CALL FILNAM(ID)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		ROUTINE TO INPUT A LEGAL FILENAME
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE INPUTS A LEGAL FILENAME FOR THE
C	   RT11 OPERATING SYSTEM IN THE FORM:
C
C			LLN:AAAAAA.AAA
C
C	   WHERE L=LETTER, N=NUMBER, AND A=ALPHANUMERIC
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE  FILNAM(ID)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME, IDOT, ICLN, IBLK, IC0, IC9, ICA, ICZ, IDM
C
	DATA IDOT/'.'/
	DATA ICLN/':'/
	DATA IBLK/' '/
	DATA IC0/'0'/
	DATA IC9/'9'/
	DATA ICA/'A'/
	DATA ICZ/'Z'/
C
10	LCLN=0
	LDOT=0
	LEND=0
	LSTR=0
	DO 20 I=1,16
20	NAME(I)=IBLK
C
C***********************************************************************
C
C  THE ARGUMENT ID TELLS WHO CALLED FILENAME
C
C	ID = 0 GENERAL CALL, ANY FILE TYPE ALLOWED
C	ID = 1 CALL FOR A DATA FILE
C	ID = 2 CALL FOR A RUN FILE
C	ID = NEG - DON'T PRINT PROMPT
C
C********************************************************************
C
C  NOT ALL ASPECTS OF INPUT FILENAME ARE VERIFIED
C
C
C  FILE NAME STRUCTURE:
C
C  THE GENERAL STRUCTURE IS EG.: RK3:FLNAME.DAT
C
C	THE DEVICE SPECIFIER IS OPTIONAL.
C	FLNAME LENGTH IS FROM 1 TO 6 CHARACTERS.
C	IF NO FILE TYPE IS SPECIFIED IT DEFAULTS TO .DAT FOR
C	ID=1 AND .RUN FOR ID=2.
C
C***********************************************************************
C
C  TYPE THE INSTRUCTIONS FOR THE INPUT FORM
C
	IF (ID.LT.0) GOTO 200
C
	WRITE(ITYP,100)
100	FORMAT(/,' ENTER FILE NAME IN THE FORMAT LLN:AAAAAA.AAA',/,
     1	' ? ',$)
C
C***********************************************************************
C
C  INPUT THE NAME
C
200	ID = ABS(ID)
	READ(IRD,210) (NAME(I),I=1,14)
210	FORMAT(14A1)
C
C***********************************************************************
C
C  CHECK IF NAME IS LEGAL (GOTO 9000 = ERROR)
C
C
C  FIND ALL THE :'S, .'S, AND THE LENGTH OF THE NAME
C
	DO 300 I = 1,15
C  LOCATE COLONS
	IF(NAME(I).EQ.ICLN .AND. LCLN.NE.0) GOTO 9000
	IF(NAME(I).EQ.ICLN) LCLN = I
C  LOCATE PERIODS
	IF(NAME(I).EQ.IDOT .AND. LDOT.NE.0) GOTO 9000
	IF(NAME(I).EQ.IDOT) LDOT = I
C  LOCATE END OF STRING, FIRST BLANK
	IF(LSTR.NE.0 .AND. NAME(I).NE.IBLK) GOTO 9000
	IF(NAME(I).EQ.IBLK .AND. LSTR.EQ.0) LSTR = I
300	CONTINUE
C
C  IF THE STRING IS ZERO LENGTH NO SENSE GOING FURTHER
C
	IF(LSTR.EQ.0 .OR. LSTR.EQ.1) GOTO 9000
C
C  BEFORE THE COLON TWO CHARACTERS AND ONE OPTIONAL NUMBER
C  ARE ALLOWED IN THE FORM 'LLN:'
C
	IF(LCLN.EQ.0) GOTO 400
	IF(LCLN.NE.3 .AND. LCLN.NE.4) GOTO 9000
C
	IF(.NOT.((NAME(1).GE.ICA .AND. NAME(1).LE.ICZ)
     1	.AND. (NAME(2).GE.ICA .AND. NAME(2).LE.ICZ))) GOTO 9000
C
	IF(LCLN.EQ.4 .AND. .NOT.(NAME(3).GE.IC0 .AND.
     1	NAME(3).LE.IC9)) GOTO 9000
C
C  AFTER THE A COLON AND BEFORE A PERIOD A MAX OF SIX CHARACTERS
C  AND A MIN OF 1 ARE ALLOWED, FORM: 'AAAAAA'
C
400	LEND=LDOT
	IF(LDOT.EQ.0) LEND=LSTR
	IF((LEND-LCLN-1).GT.6 .OR. (LEND-LCLN-1).LT.1) GOTO 9000
C
	DO 500 I = LCLN+1,LEND-1
500	IF(.NOT.((NAME(I).GE.ICA .AND. NAME(I).LE.ICZ)
     1	.OR. (NAME(I).GE.IC0 .AND. NAME(I).LE.IC9))) GOTO 9000
C
C  AFTER A DOT A MAX OF THREE CHARACTERS ARE ALLOWED OF THE
C  FORM: '.AAA'
C
	IF(LDOT.EQ.0 .AND. ID.EQ.0) GOTO 800
	IF(LDOT.EQ.0) GOTO 700
C
	IF((LSTR-LDOT-1).GT.3) GOTO 9000
C
	DO 600 I = LDOT+1,LSTR-1
600	IF(.NOT.((NAME(I).GE.ICA .AND. NAME(I).LE.ICZ)
     1	.OR. (NAME(I).GE.IC0 .AND. NAME(I).LE.IC9))) GOTO 9000
	GOTO 800
C
C  ADD THE DEFAULT EXTENSION
C
700	IF(ID.NE.1) GOTO 750
	NAME(LSTR) = IDOT
	NAME(LSTR+1) = 'D'
	NAME(LSTR+2) = 'A'
	NAME(LSTR+3) = 'T'
	LSTR = LSTR + 4
	GOTO 800
C
750	NAME(LSTR) = IDOT
	NAME(LSTR+1) = 'R'
	NAME(LSTR+2) = 'U'
	NAME(LSTR+3) = 'N'
	LSTR = LSTR + 4
C
C   SET A NULL CHARACTER AFTER NAME
C
800	NAME(LSTR)=0
	GOTO 9999
C
C***********************************************************************
C
C  ILLEGAL NAME TRY AGAIN
C
9000	WRITE(ITYP,9010) (NAME(I), I=1,15)
9010	FORMAT(/,1H ,'ILLEGAL FILE NAME: ',15A1)
	GOTO 10
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			OPERATION COMPLETION ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C	     THIS ROUTINE COMPLETES NORMAL DATA COLLECTION
C	OPERATIONS OF THE AUTO SYSTEM AND PERFORMS DEBUG ROUTINES
C	AND SYSTEM REINITILIZATION ON AN ERROR.
C
C  THERE ARE FOUR MODES OF ACTION BASED ON THE FINIS MODE FLAG:
C
C     MODE =
C
C	1 - EMERGENCY HALT AND RESET
C
C		- IMMEDIATELY HALT THE GONIOMETER
C		- WRITE ANY REMAINING DATA TO THE OUTPUT FILE
C		- RESET ALL RUN PARAMETERS
C		- BEGIN A SLEW TO THE IDLE POSITION
C
C
C	2 - NORMAL TERMINATION OF A DATA COLLECTION OPERATION
C
C		- RESET THE RUN PARAMETERS
C		- BEGIN A SLEW TO THE IDLE POSITION
C
C
C	3 - QUAL OR QUANT OPERATOR EXIT TERMINATION
C
C		- RESET THE RUN PARAMETERS
C		- BEGIN A SLEW TO THE IDLE POSITION
C
C
C	4 - TERMINATION BECAUSE OF AN INTERFACE OR OTHER FATAL ERROR
C
C		- HALT THE GONIOMETER
C		- WRITE ANY REMAINING DATA TO THE OUTPUT FILE
C		- RESET ALL RUN PARAMETERS
C		- SET IACT = -1 (ERROR)
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE FINIS(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		STACK:		STACK POINTER
C
	COMMON /STACK/	IPOINT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
C		QUAN:		QUANT PARAMETERS
C
	COMMON /QUAN/	CONC,		LOOP,		LPK,
     1	NUM(20),	IREPT,		SCONC
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
	BYTE IALPH, NAME, NMFIL
C
C*************************************************************************
C
C  DON'T ALLOW A CALLING ERROR
C
	IF ((MODE.LT.1) .OR. (MODE.GT.4)) MODE = 4
C
C***********************************************************************
C
C  STOP THE AXIS POSITIONER BY ISSUING A RESET
C
100	IF (MODE.NE.1) GOTO 200
C
	IALPH(1) = '$'
	CALL IFOUTP(NBS,IALPH,1,IERROR)
C
C***********************************************************************
C
C  WRITE ANY REMAINING DATA TO THE OUTPUT FILE
C
200	IF ((MODE.NE.1) .AND. (MODE.NE.4)) GOTO 300
C
	CALL WRFILE
C
C***********************************************************************
C
C  ADD ENDFILE MARK TO DATA FILE AND CLOSE ALL OUTPUT FILES
C
300	ID = ISPEC
	CLOSE(UNIT=ID,ERR=310)
C
310	ID = IFIN
	CLOSE(UNIT=ID,ERR=320)
C
320	ID = IFOUT
	CLOSE(UNIT=ID,ERR=330)
C
330	ID = IDISK(1)
	CLOSE(UNIT=ID,ERR=340)
C
340	ID = IDISK(2)
	ENDFILE ID
	CLOSE(UNIT=ID,ERR=400)
C
	ID = 0
C
C***********************************************************************
C
C  RUN ANY SELECTED DEBUG ROUTINES
C
400	IF (IDBUG.LT.1) GOTO 500
C
C	NONE CURRENTLY USED
C
C***********************************************************************
C
C  CLEAR ALL RUN PARAMETERS
C
C  (WE LEAVE NMFIL ASSIGNED SO THAT WITH A STATUS REQUEST THE USER
C  CAN DETERMINE WHICH FILE NAME WAS LAST USED)
C
500	IRUN = 0
	IACT = 0
	ITR = 1
	TIME = 0.0
	BKGTIM = 0.0
	NREC = 0
C
	DO 510 I= 1,5
510	IENRN(I) = 0
C
	DO 520 I=1,20
	ITRANS(I,1) = 0
520	ITRANS(I,2) = 0
C
C***********************************************************************
C
C  TERMINATION DUE TO INTERFACE ERROR
C
600	IF (MODE.NE.4) GOTO 700
C
	IACT = -1
C
C***********************************************************************
C
C  CANCEL ANY RETURNS THROUGH BRANCH BY PUSHING A NOP
C
700	CALL PUSH(20,0)
C
C***********************************************************************
C
C  SLEW TO THE IDLE POSITION
C
800	IF (MODE.EQ.4) GOTO 9999
C
C	RATE = 0.0
C	TANG = 90.
C	TANG = FIXANG(TANG)
C	CALL BGMOVE
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			'FIX' THE ANGLE
C
C***********************************************************************
C
C	DESCRIPTION:
C		CORRECTS 'ANG' SO IT IS A MULTIPLE OF PULSES
C
C***********************************************************************
C
	FUNCTION FIXANG(ANG)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C***********************************************************************
C
D	A = ANG
C
C***********************************************************************
C
C  TRUNCATE THE VARIABLE TO HELP ELIMINATE ERROR
C
	ANG = JNINT(ANG*10000.) / 10000.
C
C***********************************************************************
C
C  FIX THE ANGLE SO THAT IT IS A MULTIPLE OF 1/PPD DEGREES
C
D	B = JNINT(ANG*PPD) / PPD
C
	FIXANG = JNINT(ANG*PPD) / PPD
C
C***********************************************************************
C
C  DEBUG OUTPUT
C
D	WRITE(5,100) A, B
D100	FORMAT(/,' >> DEBUG0 <<  FIXANG CONVERSION : ',F12.5,' TO ',
D    1	F12.5)
C
C***********************************************************************
C
	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			'FIX' THE TIME
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS FUNCTION ROUNDS THE INPUT TIME TO THE NEAREST
C	   WHOLE DIGIT MULTIPLE OF 1/100 SECOND.  THIS IS DONE BECAUSE
C	   THE CANBERRA 6326 COUNTER/TIMER CAN ONLY PRESET TIME AS
C	   ONE DIGIT TIMES A POWER OF TEN.
C
C***********************************************************************
C***********************************************************************
C
	FUNCTION FIXTIM(TIME)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C***********************************************************************
C
C   DEBUG OUTPUT
C
D	WRITE(5,100) TIME
D100	FORMAT(' >> DEBUG0 <<  INPUT TO FIXTIM =    ',F16.4)
C
C***********************************************************************
C
C   TRAP OBVIOUS ERROR CONDITIONS
C
	IF (TIME.LE.0.0) THEN
		I2 = 2
		I1 = 1
		ELSE
C
C***********************************************************************
C
C   GENERATE THE TIME CODE FOR THE CANBERRA INTERFACE
C
	IF (TIME.LT.0.1) THEN
		I2 = -1
		I1 =  1
		ELSE
		IF (TIME.LT.1.0) THEN
			I2 = -1
			I1 = INT(TIME*10.+0.2)
			ELSE
			I2 = INT(ALOG10(TIME))
			I1 = INT(TIME/(10.**I2)+0.2)
			END IF
		END IF
C
	END IF
C
C***********************************************************************
C
	IF (I1.LE.0) I1 = 1
	IF (I1.GT.9) THEN
		I1 = 1
		I2 = I2 + 1
		END IF
C
	A = I1*10.**I2
	FIXTIM = A
C
C***********************************************************************
C
C   DEBUG OUTPUT
C
D	WRITE(5,120) A
D120	FORMAT(' >> DEBUG0 <<  OUTPUT FROM FIXTIM = ',F16.4)
C
C***********************************************************************
C
	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			FILE OPEN/CREATION ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE OPENS OR CREATES A FILE IF IT DOES
C	   NOT EXIT ON LOGICAL UNIT NUMBER 'LU' AND WITH NAME AS
C	   STORE IN THE COMMONED VARIABLE 'NAME'.  TYPE IS
C	   "UNKNOWN" AND ACCESS IS "SEQUENTIAL".
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE FOPEN(LU,IERROR)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C
C  COMMON /BUFF/ IS USED TO PASS THE VARIABLE NAME.
C
C  THE FILE NAME IS OF THE TYPE FOR THE PDP-11: RK3:FLNAME.DAT
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME
C
C***********************************************************************
C
C  TO START WITH WE HAVE NO ERRORS
C
	IERROR = 0
C
C  NOW ATTEMPT TO OPEN/CREATE THE FILE
C
	OPEN(UNIT=LU,NAME=NAME,TYPE='UNKNOWN',ACCESS='SEQUENTIAL',
     1	CARRIAGECONTROL='LIST',ERR=100)
	REWIND LU
	GOTO 9999
C   
C  AN ERROR OCCURRED IN OPENING OF FILE
C
100	WRITE(ITYP,110) (NAME(I),I=1,15)
110	FORMAT(/,'  >> ERROR << - ON OPENING OF FILE: ',15A1)
	IERROR = 1
C
C***********************************************************************
C
9999	RETURN
        END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			RT11 DEVICE ATTACH ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE ATTACHS A DEVICE ASSIGNED TO IUNIT
C	   DURING RT11 SYSTEM GENERATION AND SETS UP FOR SIMPLE
C	   I/0, IE. ALL DATA IS PASSED AS RECIEVED AND WHEN
C	   RECEIVED.  THE PREVIOUS PARAMETERS ARE READ BUT ARE
C	   NOT CURRENTLY KEPT SINCE THIS IS NOT NECESSARY FOR
C	   A SINGLE USER SYSTEM.
C
C
C	     THE PASSED PARAMETERS ARE DEFINED AS FOLLOWS:
C
C		IUNIT:	THE NUMBER OF THE DEVICE TO ATTACH
C
C		IFLAG:	RETURNS AN ERROR VALUE
C
C			0 = NORMAL RETURN
C			3 = NONEXISTENT UNIT NUMBER
C			5 = UNIT ATTACHED BY ANOTHER JOB
C			6 = IN THE 'XM' MONITOR, THE OPTIONAL
C			    STATUS WORD ADDRESS IS NOT IN A
C			    VALID USER VIRTUAL ADDRESS SPACE
C
C
C	FOR FURTHER REFERENCE CONSULT SECTION '3.76 MTATCH' IN
C   THE DEC PROGRAMMERS REFERENCE MANUAL.
C
C	THE RSX SECTION PERFORMS A SIMILAR FUNCTION BUT THE FLAGS
C   RETURNED HAVE SLIGHTLY DIFFERENT MEANINGS.
C
C***********************************************************************
C
C	PROGRAMMER:
C
C		DALE C. EARL
C		ALFRED UNIVERSITY
C		ALFRED, NY  14802
C		5/24/84
C
C***********************************************************************
C
C	SYSTEM:
C
C	RUNS UNDER RT-11SJ (S) V04.00H, FORTRAN IV V02
C	ALSO UNDER RSX-11M V4.1, FORTRAN 77
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE IFATCH(IUNIT,IFLAG)
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	IMPLICIT INTEGER*2 (I-N)
	DIMENSION IOSB(2)
C
C***********************************************************************
C		RT11 SYSTEM VERSION
C-----------------------------------------------------------------------
C
C	DIMENSION IABLOK(4), IBBLOK(4)
C
C
C  THE STATUS WORD 1 IS SET AS FOLLOWS:
C
C	BIT:	 0 - DEVICE HAS HARDWARE TABS
C		 2 - DEVICE HAS HARDWARE FF'S
C		 6 - INHIBIT WAIT IF NO CHARACTERS ARE PRESENT
C		12 - SEND CHARACTERS AS RECIEVED
C		14 - DISABLE LOWER->UPPER CASE CONVERSION
C
C	IABLOK(1) = "050105
C
C  STATUS WORD 2:
C
C		 7 - READ PASS ALL
C		15 - WRITE PASS ALL
C
C	IABLOK(2) = "100200
C
C	FOR A MORE COMPLETE DESCRIPTION OF THE TERMINAL CONFIGURATION
C    WORD SEE SECTION '2.46 .MTGET' OF THE DEC PROGRAMMERS
C    REFERENCE MANUAL.
C
C
C  TEMPORARY VARIABLES AND CONSTANTS
C
C	IZERO  = 0
C	IJOB   = 0
C	IFLAG  = 0
C
C***********************************************************************
C
C  ATTACH TO IUNIT
C
C	IFLAG = MTATCH(IUNIT,IZERO,IJOB)
C
C	IF(IFLAG.NE.IZERO) GOTO 9999
C
C***********************************************************************
C
C  GET THE CURRENT STATUS WORDS AND 'SAVE'
C
C	IFLAG = MTGET(IUNIT,IBBLOK(1))
C
C	IF(IFLAG.NE.IZERO) GOTO 9999
C
C***********************************************************************
C
C  SET UP THE NEW CHARACTERISTICS TO OUTPUT
C
C   IABLOK(1) AND IABLOK(2) SET ABOVE IN VAR. DECLARATION SECTION
C
C	IABLOK(3) = IBBLOK(3)
C	IABLOK(4) = IBBLOK(4)
C
C***********************************************************************
C
C  SEND THE NEW 'BLOK'
C
C	IFLAG = MTSET(IUNIT,IABLOK(1))
C
C***********************************************************************
C		RSX VERSION
C-----------------------------------------------------------------------
C
C	RSX SYSTEM ATTACH ROUTINE. FOR VALUES OF IREAD SEE RSX-11M
C	I/O DRIVERS MANUAL PAGE B-4.
C
	CALL ATCH(IUNIT, IOSB, IDS)
C
C***********************************************************************
C
C	TEST IOSB FOR SUCCESSFUL COMPLETION OF THE ATTACHING OF THE 
C	DEVICE.
C
D	WRITE(5,1234) IOSB,IDS
D1234	FORMAT(' >> DEBUG0 <<  IFATCH - IOSB,IDS = ',2(I4,','),I4)
C
	IFLAG = 0
C 1 = OK, 248 = ALREADY ATTACHED BY YOU, 240 = ATTACHED BY SOMEONE ELSE
	IF ((IOSB(1).NE.1) .AND. (IOSB(1).NE.248))THEN
C
		WRITE(5,110)
110		FORMAT('  >> ERROR << - INTERFACE IS IN USE,',
	1	' TRY AGAIN LATER.',/,
	2	'                (NOTE: THIS TERMINAL WILL',
	3	' SELF DESTRUCT IN 10 SECONDS, BYE!)')
		IFLAG = 5
		CALL FINIS(4)
	END IF
C
C REF. JOE COLLINS.
C
9999	RETURN
	END

CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			RT11 DEVICE DISATTACH ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE RELEASES THE DEVICE ASSIGNED TO IUNIT
C	   THE PREVIOUS PARAMETERS ARE NOT RESTORED SINCE THIS IS
C	   NOT NECESSARY FOR A SINGLE USER SYSTEM.
C
C	THE PARAMETERS HAVE THE FOLLOWING USES:
C
C		IUNIT:	THE LOGICAL UNIT NUMBER OF THE
C			TERMINAL TO BE DETACHED
C
C		IFLAG:  ERROR CODE
C
C			0 = NORMAL RETURN
C			2 = INVALID UNIT NUMBER; TERMINAL IS
C			    NOT ATTACHED
C			3 = NONEXISTENT UNIT NUMBER
C
C
C	FOR FURTHER INFORMATION CONSULT SECTION '3.77 MTDTCH' OF
C   THE DEC PROGRAMMERS REFERENCE MANUAL
C
C	THE RSX SECTION PERFORMS A SIMILAR FUNCTION BUT THE FLAGS
C   RETURNED HAVE SLIGHTLY DIFFERENT MEANINGS.
C
C***********************************************************************
C
C	PROGRAMMER:
C
C		DALE C. EARL
C		ALFRED UNIVERSITY
C		ALFRED, NY  14802
C		5/24/84
C
C***********************************************************************
C
C	SYSTEM:
C
C	RUNS UNDER RT-11SJ (S) V04.00H, FORTRAN IV V02
C	ALSO UNDER RSX-11M V4.1, FORTRAN 77
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE IFDTCH(IUNIT,IFLAG)
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	IMPLICIT INTEGER*2 (I-N)
	DIMENSION IOSB(2), IPARAM(6)
C
C***********************************************************************
C		RT11 SYSTEM
C-----------------------------------------------------------------------
C
C	DIMENSION IABLOK(4),IBBL0K(4)
C
C  THE STATUS WORD 1 IS SET IN 'IFATCH' AS FOLLOWS:
C
C	BIT:	 0 - DEVICE HAS HARDWARE TABS
C		 2 - DEVICE HAS HARDWARE FF'S
C		 6 - INHIBIT WAIT IF NO CHARACTERS ARE PRESENT
C		12 - SEND CHARACTERS AS RECIEVED
C		14 - DISABLE LOWER->UPPER CASE CONVERSION
C
C	IABLOK(1) = "050105
C
C  STATUS WORD 2:
C
C		 7 - READ PASS ALL
C		15 - WRITE PASS ALL
C
C	IABLOK(2) = "100200
C
C
C***********************************************************************
C
C  RESTORE THE FORMER STATUS WORD
C
C			CURRENTLY NOT DONE
C
C***********************************************************************
C
C  DETACH THE UNIT
C
C	IFLAG = MTDTCH(IUNIT)
C
C***********************************************************************
C
C  IT'S AS SIMPLE AS THAT !
C
C***********************************************************************
C		RSX SYSTEM
C-----------------------------------------------------------------------
C
C	I/O ROUTINE FOR RSX SYSTEM TO DEATTACH A DEVICE.
C
	IREAD = 1024
C
	CALL QIO (IREAD,IUNIT,,,IOSB)
C
C***********************************************************************
C
9999	RETURN                                                         
	END

CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		RT11 DEVICE DATA OUTPUT ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE TRANSFERS DATA OUT THE DESIGNATED I/O
C	   LINE OF THE RT11 SYSTEM.  THE DATA STRING MAY BE OF ANY
C	   LENGTH REQUIRED.
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:	ARRAY TO STORE INPUT DATA
C
C	NUMBER:	THE NUMBER OF CHARACTERS TO OUTPUT, 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:	RETURNS AN ERROR VALUE AS FOLLOWS:
C
C			0 = NORMAL RETURN
C			1 = NO ROOM IN OUTPUT RING BUFFER OR
C			    ANY OTHER GENERAL PROGRAM ERROR
C			2 = UNIT NOT ATTACHED
C			3 = NONEXISTENT UNIT NUMBER
C			5 = IN THE 'XM' MONITOR, THE ADDRESS OF
C			    THE USER BUFFER IS OUTSIDE THE VALID
C			    PROGRAM LIMITS
C
C
C	FOR FURTHER REFERENCE CONSULT SECTION '3.80 MTOUT' IN THE
C   PROGRAMMERS REFERENCE MANUAL.
C
C	THE RSX SECTION PERFORMS A SIMILAR FUNCTION BUT THE FLAGS
C   RETURNED HAVE SLIGHTLY DIFFERENT MEANINGS.
C
C***********************************************************************
C
C	PROGRAMMER:
C
C		DALE C. EARL
C		ALFRED UNIVERSITY
C		ALFRED, NY  14802
C		5/24/84
C
C***********************************************************************
C
C	SYSTEM:
C
C	RUNS UNDER RT-11SJ (S) V04.00H, FORTRAN IV V02
C	ALSO UNTER RSX-11M V4.1, FORTRAN 77
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE IFOUTP(IUNIT,IODATA,NUMBER,IFLAG)
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	IMPLICIT INTEGER*2 (I-N)
C
	BYTE IODATA(132), TMPDAT(132)
C
C  CONSTANTS AND TEMPORARY VARIABLES
C
	NUMCHR = NUMBER
	NUMOUT = 0
	IZERO  = 0
	IONE   = 1
	IFLAG  = 0
C
C***********************************************************************
C
C  IF NUMCHR IS ZERO THEN WE'RE OUT OF A JOB, LEAVE.
C
	IF(NUMCHR.EQ.IZERO) GOTO 9999
C
C***********************************************************************
C			RT11 SYSTEM
C-----------------------------------------------------------------------
C
C  SEND OUT NUMCHR CHARACTERS OF THE DATA STRING IODATA ON UNIT #IUNIT
C
C	IFLAG = MTOUT(IUNIT,IODATA,NUMCHR,NUMOUT)
C
C***********************************************************************
C
C  NOW CHECK TO SEE THAT EVERYTHING WENT SMOOTHLY
C
C	IF (IFLAG.NE.IZERO) GOTO 9999
C
C***********************************************************************
C			RSX SYSTEM
C-----------------------------------------------------------------------
C
D	WRITE(5,1234) IODATA
D1234	FORMAT(' >> DEBUG0 <<  IFOUTP - IODATA: ',255A1)
C
	WRITE(IUNIT,110)(IODATA(I), I=1,NUMCHR)
110	FORMAT(X,255A1)
C
C***********************************************************************
C
C  EVERYTHING WAS OK SO CLEAR THE DATA STRING
C
	DO 100, I=1,NUMCHR
100	IODATA(I) = IZERO
	GOTO 9999
C
C***********************************************************************
C		      RSX SYSTEM - SIEMANS DACO-MP
C-----------------------------------------------------------------------
C
CD	WRITE(5,1234) IODATA
CD1234	FORMAT(' >> DEBUG0 <<  IFOUTP - IODATA: ',255A1)
C
C	CALL RAPR(IODATA,NUMCHAR,TMPDAT,L1,IODATA,L2)
C	IFLAG = -L2
C
C***********************************************************************
C
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:	ARRAY TO STORE INPUT DATA
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		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	THE RSX SECTION PERFORMS A SIMILAR FUNCTION BUT THE FLAGS
C   RETURNED HAVE SLIGHTLY DIFFERENT MEANINGS. ALSO THE CALL CODES
C   HAVE BEEN MODIFIED SOME.
C
C***********************************************************************
C
C	PROGRAMMER:
C
C		DALE C. EARL
C		ALFRED UNIVERSITY
C		ALFRED, NY  14802
C		5/24/84
C
C***********************************************************************
C
C	SYSTEM:
C
C	RUNS UNDER RT-11SJ (S) V04.00H, FORTRAN IV V02
C	ALSO UNTER RSX-11M V4.1, FORTRAN 77
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE IFINP(IUNIT,IODATA,NUMCHR,IFLAG)
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	IMPLICIT INTEGER*2 (I-N)
C
	DIMENSION IOSB(2), IPARAM(6)
	BYTE IODATA(132), TMPDAT(132)
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
	IPARAM(2) = NUMCHR
	CALL GETADR (IPARAM(1) , IODATA(1))	
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			RT-11 VERSION 
C-----------------------------------------------------------------------
C
C  QUIT IF WE ARE TOLD TO READ ZERO CHARACTERS
C
C	IF (NUMCHR.EQ.IZERO) GOTO 9999
C
C***********************************************************************
C
C  ZERO THE OUTPUT ARRAY TO ELIMINATE ANY OLD DATA
C
C	DO 100, I=1,NUMCHR
C100	IODATA(I) = IZERO
C
C***********************************************************************
C
C  GET CHARACTERS INDIVIDUALLY SO WE CAN COUNT THEM
C
C200	IFLAG = MTIN(IUNIT,ICHAR)
C
C  ON AN ERROR QUIT
C
C	IF (IFLAG.GT.IONE) GOTO 9999
C
C***********************************************************************
C
C  IF WE CAN'T WAIT FOREVER THEN INCREMENT THE NULL COUNTER IF
C  WE DONT GET ANYTHING,
C
C	IF ((IFLAG.EQ.IONE) .AND. ((IWAIT.EQ.IZERO) .OR.
C     1	(IWAIT.EQ.IONE))) ITRY = ITRY + IONE
C
C***********************************************************************
C
C  DID WE GET A CHARACTER (NULLS DON'T COUNT) ?
C
C	IF ((IFLAG.NE.IZERO) .OR. ((ICHAR.EQ.IZERO)
C     1	.OR. (ICHAR.EQ.128))) GOTO 300
C
C
C  WE GOT A CHARACTER!
C
C  FIRST, THAT REFRESHES OUR PATIENCE
C
C	ITRY = IZERO
C
C  SECOND, NOTE IT
C
C	IGOT = IGOT + IONE
C
C***********************************************************************
C***********************************************************************
C
C  >> NOTE <<	THE CANBERRA INTERFACE SENDS CHARACTERS WITH THE
C		HIGH ORDER BIT SET,  THIS LINE OF CODE ZEROS THIS
C		BIT IN ORDER TO PLACE THE CHARACTER IN THE NORMAL
C		ASCII CHARACTER SET RANGE.
C
C	ICHAR = ICHAR - "200
C
C***********************************************************************
C***********************************************************************
C
C  LASTLY, STORE IT
C
C	IODATA(IGOT) = ICHAR
C
C***********************************************************************
C
C  QUIT IF WE'VE TRIED 'NULMAX' TIMES WITH NO SUCCESS.
C
C300	IF ((ITRY.LT.NULMAX) .OR. ((IWAIT.NE.IZERO) .AND.
C     1	(IWAIT.NE.IONE))) GOTO 400
C
C  ITS BEEN LONG ENOUGH,  STORE THE NUMBER OF CHARACTERS
C  ACTUALLY RECEIVED, OR IF ZERO SET THE FLAG
C
C	IFLAG = -IGOT
C
C	IF (IFLAG.EQ.IZERO) IFLAG = IONE
C
C	GOTO 9999
C
C***********************************************************************
C
C  DID WE RECEIVE A FINAL ENDING CHARACTER ?
C
C400	IF (((IODATA(IGOT).NE.LASTCH) .OR. ((IWAIT.NE.IZERO)
C     1	.AND. (IWAIT.NE.ITWO))) .AND. IODATA(IGOT).NE.ERRCHR) GOTO 500
C
C  YES WE DID
C
C	IFLAG = -IGOT
C
C  IF IT WAS AN 'ERRCHR' THEN SET ERROR CONDITION
C
C	IF (IODATA(IGOT).EQ.ERRCHR) IFLAG = 4
C
C	GOTO 9999
C
C***********************************************************************
C
C  SEE IF WE'VE RECEIVED THE MAXIMUM NUMBER OF CHARACTERS
C
C500	IF (IGOT.LT.NUMCHR) GOTO 600
C
C	IFLAG = -IGOT
C
C	GOTO 9999
C
C***********************************************************************
C
C  NOBODY TOLD US TO QUIT, SO START FROM THE TOP
C
C600	GOTO 200
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  QUIT IF WE ARE TOLD TO READ ZERO CHARACTERS
C
	IF (NUMCHR.EQ.IZERO) GOTO 9999
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 .EQ. 0 ) THEN
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) .EQ. 0 ) THEN
			CALL WTQIO(IKILL,IUNIT,1)

D			WRITE(5,115)
D115			FORMAT(' >> DEBUG0 <<  IFINP - ',
D    1			'NO WAIT QIO ABORTED.')
C
			END IF
C
D		WRITE(5,130) (IODATA(K),K=1,NUMCHR)
D130		FORMAT(' >> DEBUG0 <<  IFINP - NO WAIT, IODATA: ',255A1)
C
		END IF			! INPUT WITHOUT WAIT
C
C***********************************************************************
C
C  WAIT FOR NUMCHR CHARACTERS UNLESS ERROR CHR RETURNED
C
	IF ( IWAIT .EQ. 2 ) THEN
C
C***********************************************************************
C
C  ISSUE A NONWAIT QIO SO WE CAN TEST FOR ERROR CHARACTERS
C
		CALL QIO (IREAD,IUNIT,1,,IOSB,IPARAM,)	
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 .NE. NULL) THEN
			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 .EQ. LASTCH) THEN
				IF (ICOUNT.LT.NUMCHR)
     1				CALL WTQIO(IKILL,IUNIT,1)
				GOTO 410
				END IF
			IF (ICHR .EQ. ERRCHR) GOTO 9000
			END IF
200		CONTINUE
C
C  IF WE DID NOT RECIEVE THE REQUIRED NUMBER OF CHARACTERS REPEAT IT
C
		IF (ICOUNT .LT. NUMCHR) GOTO 100

410		CONTINUE
D		WRITE(5,111) (IODATA(K),K=1,NUMCHR)
D111		FORMAT(' >> DEBUG0 <<  IFINP - IODATA WITH WAIT ',255A1)
C
		END IF			! 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
D	WRITE(5,112) 'WITH',(IODATA(K),K=1,NUMCHR)
D112	FORMAT(' >> DEBUG0 <<  IFINP - IODATA ',A7,' NULLS = ',
D    1	20(':',A1),':')
D	WRITE(5,114) (IODATA(K),K=1,NUMCHR)
D114	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) .NE. NULL) THEN
		IF (I .NE. NULFLG) THEN
			IODATA(NULFLG) = IODATA(I)
			IODATA(I) = NULL
			END IF
		NULFLG = NULFLG + 1
		END IF
D	WRITE(5,113) NULFLG, (IODATA(K),K=1,NUMCHR)
D113	FORMAT(' >> DEBUG0 <<  IFINP - NULFLG, IODATA = ',
D    1	I3,20(':',A1),':')
700	CONTINUE
C
D	WRITE(5,112) 'WITHOUT',(IODATA(K),K=1,NUMCHR)
D	WRITE(5,114) (IODATA(K),K=1,NUMCHR)
C
	IFLAG = -(NULFLG + 1)
	GOTO 9999
C
C***********************************************************************
C		     RSX VERSION - SIEMANS DACO-MP
C-----------------------------------------------------------------------
C
C	CALL RAPR(,,TMPDAT,L1,IODATA,NUMCHR)
C	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
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		INTERFACE INITILIZATION ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE CLEARS AND INITILIZES THE INTERFACE.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE IFINIT
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME, NMFIL
C
	DIMENSION NSTEP(2), IGOTO(2)
C
	BYTE IRESET, ISTART, IDONE, IFINIS, IERR
	DATA IRESET/'$'/
	DATA ISTART/'!'/
	DATA IFINIS/')'/
	DATA IERR/'/'/
C
	IERROR = 0
C
C***********************************************************************
C
C  OPEN COMMUNICATION TO INTERFACE
C
	CALL IFATCH(NBS,IERROR)
C
	IF (IERROR.NE.0) GOTO 9000
C
C  READ ANY OLD CHARACTERS TO GET RID OF THEM
C
C	IERROR = 0
C	CALL IFINP(NBS,IALPH,99,IERROR)
C
C***********************************************************************
C
C  INITILIZATION OF CANBERRA INTERFACE
C
C  RESET AND START
C
	IALPH(1) = IRESET
	IALPH(2) = ISTART
	CALL IFOUTP(NBS,IALPH,2,IERROR)
C
	IF (IERROR.NE.0) GOTO 9000
C
	IF (CANG.NE.0.0) GOTO 200
C
C***********************************************************************
C
	GOTO 200
C       skip reading the interface.
C  ESTABLISH THE CURRENT POSITION OF THE DIFFRACTOMETER, IE.,
C  GET THE CURRENT 2-THETA AND INITILIZE THE INTERFACE.
C
C  FIRST TRY TO READ IT.
C
	ENCODE(4,100,IALPH) 'R',MODULE(3),'*'
100	FORMAT(A1,I2,A1)
	CALL IFOUTP(NBS,IALPH,4,IERROR)
	IF (IERROR.NE.0) GOTO 200
C
	IERROR = 2
	CALL IFINP(NBS,IALPH,8,IERROR)
	IF (IERROR.GE.0) GOTO 200
C
	DECODE(5,110,IALPH(1)) CANG
110	FORMAT(F6.0)
C
	CANG = CANG/PPD
	CANG = FIXANG(CANG)
C
	IF (CANG.GT.0.0) GOTO 400
C
C***********************************************************************
C
C  ASK FOR THE CORRECT 2-THETA
C
200	WRITE(ITYP,210)
210	FORMAT(/,' ENTER THE CURRENT 2-THETA: ',$)
	READ(IRD,220) CANG
220	FORMAT(F7.3)
C
C***********************************************************************
C
C  SET THE CURRENT ANGLE INTO THE TRACKING COUNTER
C
C  GET THE CORRESPONDING NUMBER OF PULSES; THAT IS, THE
C  TOTAL NUMBER OF PULSES FROM 0 TO ANGLE
C
	TANG = FIXANG(CANG)
	CANG = 0.
	CALL CKANG(NSTEP(1),NSTEP(2),IERROR)
C
	IF (IERROR.NE.0) GOTO 9000
C
C  SEND COMMAND WITH PULSES
C
	ENCODE(11,230,IALPH) 'P',MODULE(3),'??',NSTEP(1),NSTEP(2),'*'
230	FORMAT(A1,I2,A2,I2,I3,A1)
	DO 240, I = 6,10
	IF (IALPH(I).EQ.' ') IALPH(I) = '0'
240	CONTINUE
	CALL IFOUTP(NBS,IALPH,11,IERROR)
C
	IF (IERROR.NE.0) GOTO 9000
C
C***********************************************************************
C
C  CHECK FOR EVERYTHING OK
C
300	IERROR = 2
	CALL IFINP(NBS,IALPH,1,IERROR)
C
C  AS AN ADDED FEATURE CLEAN UP ITRANS
C
310	CALL POP(IGOTO)
	IF (IGOTO(1).NE.0) GOTO 310
C
C DO WE HAVE AN ERROR OR A COMPLETION?
C
	IF (IALPH(1).NE.IFINIS) GOTO 9000
C
	CANG = TANG
C
C***********************************************************************
C
C  YES IT COMPLETED, SET ACTIVITY CODE TO SHOW IT AND SET CURRENT ANGLE
C
400	IACT = 0
C
	GOTO 9999
C
C***********************************************************************
C
C  SOMETHING WENT WRONG
C
9000	WRITE(ITYP,9010)
9010	FORMAT(/,'  >> ERROR << - IMPROPER INTERFACE COMPLETION')
	IACT = -1
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			PROGRAM INITILIZATION
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE INITILIZES SPECIAL FEATURES OF THE
C	   HOST SYSTEM AND THE INTERFACE FOR THE AUTO PROGRAM.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE INIT
C
C***********************************************************************   
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
C		QUAN:		QUANT PARAMETERS
C
	COMMON /QUAN/	CONC,		LOOP,		LPK,
     1	NUM(20),	IREPT,		SCONC
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME, NMFIL
C
C***********************************************************************
C
C  INITILIZE ERROR HANDLING AND OTHER SYSTEM PROCEDURES
C  (POWER FAIL ETC.)
C
C		NONE FOR RT11 SYSTEM OR RSX-11M
C
C***********************************************************************
C
C  INITIALIZE THE PROGRAM DATE & TIME FROM THE SYSTEM CLOCK
C
      CALL DATIM
C
C***********************************************************************
C
C  GET THE DEVICE NUMBERS OF THE DEVICES TO BE USED
C
C		CURRENTLY VALUES ARE FIXED AND INITIALLY SET
C	   IN THE COMMON BLOCK INTRFC BY THE BLOCK DATA STATMENTS
C
C***********************************************************************
C
C  INITILIZE THE INTERFACE
C
	CALL IFINIT
C
C***********************************************************************
C
C   EMPTY CONSOLE BUFFER AS A CHARACTER HERE WOULD BE LATER
C   INTERPRETED AS AN INTERRUPT FROM THE CONSOLE.  THIS IS DONE
C   USING A SYSTEM ROUTINE.
C
C   SAVE CONTENTS OF ADDRESS "44
C
C	IWORD =IPEEK("44)
C
C   SET BITS 12 AND 6 OF THE JOB STATUS WORD AT ADDRESS "44 TO
C   SET CONSOLE IN SPECIAL MODE AND TO INHIBIT WAIT FOR CARRIAGE RETURN
C
C	CALL IPOKE("44,"10100 .OR. IPEEK("44))
C
C   READ CHARACTERS UNTIL BUFFER IS EMPTY
C
C300	ICHAR=ITTINR()
C	IF(ICHAR .GE. 0) GOTO 300
C
C   BUFFER IS EMPTY - RESET JOB STATUS WORD
C
C	CALL IPOKE("44,IWORD)
C
C***********************************************************************
C	RSX MODIFICATIONS, ATTACH THE CONSOLE
C-----------------------------------------------------------------------
C
300	CALL IFATCH(IRD,IERROR)
C
C***********************************************************************
C
C  TAKE 'ER BACK JACK
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			CANBERRA SCAN SPEEDS
C
C***********************************************************************
C
C	DESCRIPTION:
C
C   THIS ROUTINE CONVERTS THE REQUESTED SCAN SPEED (DEG/MIN) INTO
C   THE SPEED CODE OF THE CANBERRA INTERFACE CORRESPONDING TO THE
C   NEAREST AVAILABLE SPEED.
C
C   MODIFIED FROM THE THESIS WORK OF C.H. MALLORY
C
C   THE CANBERRA SPEED CODES ARE AS FOLLOWS:
C
C	0	0.0625 (1/16)	(in DPM)
C	1	0.125  (1/8)
C	2	0.25   (1/4)
C	3	0.5
C	4	1
C	5	2
C	6	10
C	7	50
C	8	175    (SLEW)
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE ISCODE(DPM,ICODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	VARIABLE DECLARATION:
C
	DIMENSION SPEED(9)
	DATA SPEED/0.0625,0.125,0.25,0.5,1.,2.,10.,50.,175./
C
C***********************************************************************
C
C   SCAN AVAILABLE CODES
C
	DO 100, I = 8,0,-1
	IF (DPM.GE.SPEED(I+1)) GOTO 200
100	CONTINUE
	I = 7
200	ICODE = I
	DPM = SPEED(I+1)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		COUNT OPTIMIZATION ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
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
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE OPTIM
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
C		NONE
C
C***********************************************************************
C
C  DETERMINE THE NUMBER OF BACKGROUND POINTS TO BE COLLECTED
C
	NPTBG=NBG
	IF (EANG.GT.0.1) 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.LT.0.01) 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) THEN
D		WRITE(ITYP,210)
D210		FORMAT('  >> OPTIM <<  CONVERTED FROM FIXED ERROR '
D    1		'TO FIXED TIME MODE.')
D		END IF
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
	TIME = TOTIME/NPTPK
C
	BKGTIM = 0.0
	IF (NPTBG.EQ.0) GOTO 9999
	BKGTIM = TOTIME / (NPTBG * R)
C
C***********************************************************************
C
C  DEBUG PRINT OUT
C
9999	CONTINUE
C
D	WRITE(ITYP,510) CNT(1),CNT(2),FIXERR,
D    1	TIMLIM,NPTPK,NBG,TIME,BKGTIM
D510	FORMAT(' >> DEBUG0 <<  OPTIM RESULTS:',/,'  BKG CNTS:',4X,F8.0,
D    1	7X,'PEAK CNTS: ',3X,F8.0,/,'  COUNT ERROR:',5X,F6.2,5X,
D    2	'TIME LIMIT:',7X,F6.2,/,'  # PEAK PTS:',4X,I5,8X,
D    3	'# BKG PTS:',6X,I5,/,'  PEAK CNT TIME: ',F8.2,5X,
D    4	'BKG CNT TIME:',3X,F8.2)
C
C***********************************************************************
C
	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			PEAK LOCATOR ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
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 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.  THE GONIOMETER IS LEFT AT THE BEGINNING ANGLE
C	   AFTER THE ROUTINE COMPLETES.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE PKFIND(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
C
C  IPKFND IS RETURNED AS A FLAG WITH THE FOLLOWING MEANINGS:
C
C		= -1 PEAK NOT LOCATED.
C
C		=  0 PEAK LOCATED AT EXTREMES OF SEARCH RANGE,
C		     IE. IN THE UNSMOOTHED PORTION WHICH IS THE
C		     FIRST AND LAST 6 POINTS FOR THE 13 PT SMOOTH.
C
C		=  1 PEAK LOCATED WITHIN THE SMOOTHED REGION.
C		     IN THIS CASE UPDATE DELPK, THE LATEST PEAK
C		     SHIFT FROM INITIAL PANG.
C
C***********************************************************************
C
C  BRANCH TO THE PROPER SECTION
C	MODE = 0 :	INITIAL CALL
C	MODE = 1 :	RECURSIVE CALL TO FINISH THE PROCEDURE
C
	IF (MODE.EQ.1) GOTO 100
C
C***********************************************************************
C
C  SET UP TO COLLECT THE 50 DATA POINTS
C
C  PREPARE FOR RECURSION
C
	CALL PUSH(5,1)
C
C  SAVE THE TRUE ENDING ANGLE
C
	TEANG = EANG
C
C  SET UP FOR THE STEP SCAN
C
	EANG = PANG + 24.0*DANG
	TIME = 0.5
	CALL PUSH(7,1)
C
C  SLEW TO BEGINNING OF THE PEAK, STEPSCAN WILL BEGIN THERE
C
	TANG = PANG - 25.0*DANG
	RATE = 0.0
	CALL BGMOVE
C
C  INITILIZE THE POINT COUNTER
C
	IPT = 0
C
	GOTO 9999
C
C***********************************************************************
C
C  DATA COLLECTION IS NOW COMPLETED.  SMOOTH THE DATA.
C
100	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***********************************************************************
C
C  WAS A PEAK FOUND ?
C
	IPKFND = -1
	IF (AMAX.LT.10) GOTO 220
C
C  PEAK WAS FOUND. CALCULATE THE POSITION
C
	IPKFND = 0
	DEL = (IMAX - 26) * DANG
	PANG = PANG + DEL
C
C***********************************************************************
C
C  IS THE PEAK AT EXTREMES WHERE NO SMOOTHING WAS PERFORMED ?
C
	IF ((IMAX.LT.7) .OR. (IMAX.GT.44)) GOTO 220
C
C  PEAK LOCATED WITHIN SMOOTHED REGION,
C  UPDATE DELPK SINCE PEAK IS WELL DETERMINED
C
	IPKFND = 1
	DELPK = DEL
C
C***********************************************************************
C
C  RETURN TO BANG BEFORE PROCEEDING WITH ESTIM-OPTIM
C  RESTORE TRUE END ANGLE
C
220	TANG = BANG
	EANG = TEANG
	RATE = 0.0
	CALL BGMOVE
C
C***********************************************************************
C
C  DEBUG DISPLAY OF RESULTS
C
D	WRITE(ITYP,300) PANG, IPKFND, DELPK, IMAX, AMAX, TIME
D300	FORMAT(' >> DEBUG0 <<  PKFIND RESULTS: PANG = ',F9.4,
D    1	' IPKFND=',I3,/,'  PEAK DELTA=',F7.2,' PT #=',I3,
D    2	' PEAK CNTS=',F8.0,' TIME=',F7.2)
C
C***********************************************************************
C
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			PEAK COUNT ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C	     THIS ROUTINE COUNTS A PEAK EITHER BY A STEPSCAN OVER
C	THE PEAK AREA OR BY THE SPECIFIED NUMBER OF POINTS AT ONE
C	OR TWO BACKGROUNDS AND THE SPECIFIED NUMBER OF POINTS AT
C	THE PEAK POSITION.  COLLECTED VALUES ARE WRITTEN TO THE
C	DATA FILE.  THIS ROUTINE ASSUMES THE GOINIOMETER IS POSITIONED
C	AT THE STARTING ANGLE WHEN IT IS FIRST CALLED.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE PKSCAN(MODE)
C
C***********************************************************************
C
C  THE MODE FLAG HAS THE FOLLOWING MEANINGS:
C
C	0. ERROR CONDITION.
C
C	1. CALL TO PERFORM A STEPSCAN OVER THE PEAK.
C
C	2. CALL TO PERFORM PEAK AND BACKGROUND COUNTS.
C
C	3. RECURSIVE CALL TO SET UP PARAMETERS FOR THE SECOND PHASE
C	   OF OPTION 2.  SET VALUES FOR SLEW TO AND COUNT RANGE
C	   AT THE PEAK POSITION.
C
C	4. OPTIONAL RECURSIVE CALL TO SET UP PARAMETERS FOR THE
C	   THIRD PHASE OF OPTION 2.  SET VALUES FOR SLEW TO AND
C	   COUNT THE SECOND BACKGROUND VALUES.
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
C		NONE
C
C***********************************************************************
C
C  BRANCH BASED ON THE VALUE OF THE MODE FLAG
C
	IF ((MODE.LT.1) .OR. (MODE.GT.4)) GOTO 9000
C
	GOTO (200,200,300,400),MODE
C
C***********************************************************************
C
C  CALL TO DO A PEAK AND BACKGROUND COUNT
C
C  FIRST PUT ALL THE NEEDED ROUTINES ON THE STACK IN REVERSE ORDER,
C  THE RECURSIVE CALLS SET UP THE PROPER PARAMETERS SO WE DON'T HAVE
C  TO TOUCH THE STACK AGAIN.
C
C  SKIP THE ROUTINES FOR THE LAST BACKGROUND POINT IF NOT NEEDED
C
200	IF (EANG.EQ.0.0) GOTO 210
C
C  PUSH STPSCN, BGMOVE, PKSCAN ONTO STACK
C
	IF (NBG.EQ.1) THEN
		CALL PUSH(4,1)		! ENDCNT
		CALL PUSH(3,0)		! BGCNT (ONE POINT)
	ELSE
		CALL PUSH(7,0)		! STPSCN
		ENDIF
C
	CALL PUSH(1,0)			! BGMOVE
C
	CALL PUSH(6,4)			! PKSCAN MODE 4
C
C***********************************************************************
C
C  PUSH THE ROUTINES TO MOVE TO THE PEAK AND COUNT IT
C
210	CALL PUSH(7,0)			! STPSCN
C
	CALL PUSH(1,0)			! BGMOVE
C
	CALL PUSH(6,3)			! PKSCAN MODE 3
C
C***********************************************************************
C
C  BEGIN THE FIRST COUNTING SEQUENCE AT THE LOW BACKGROUND
C
220	TEANG = EANG
	EANG = BANG + DANG * (NBG-1)
	A = TIME
	TIME = BKGTIM
	BKGTIM = A
C
	IF (NBG.EQ.1) THEN
		CALL PUSH(4,1)		! ENDCNT
		IPT = 1
		CALL BGCNT		! BGCNT (ONE POINT)
	ELSE
		IPT = 0
		CALL STPSCN(0)		! STPSCN
		ENDIF
C
	GOTO 9999
C
C***********************************************************************
C
C  PHASE TWO OF OPTION 2.  SET VALUES FOR MOVE AND SCAN
C
C  SET UP THE TARGET ANGLE FOR THE MOVE in peak counting mode
C
300	IF(IPK .EQ. 0)GO TO 320
	I = NPK/2
	TANG = PANG - DANG * I
	RATE = 0.0
	A = TIME
	TIME = BKGTIM
	BKGTIM = A
C
C  SET THE ENDING ANGLE FOR THE PEAK POINTS
C
	EANG = PANG + DANG * (NPK-I-1)
	GOTO 9999
C
C  set up the angles for integrate mode
C
C320	TANG = CANG + DANG 
320	TANG = CANG ! JDW 19-DEC-84
	RATE = 0.0
	A = TIME
	TIME = BKGTIM
	BKGTIM = A
	EANG = FIXANG( TEANG - DANG * NBG )
	GO TO 9999
C
C***********************************************************************
C
C  PHASE 3 OF OPTION 2. COUNT THE SECOND BACKGROUND
C
400	TANG = TEANG - DANG * (NBG-1)
	EANG = TEANG
	RATE = 0.0
	A = TIME
	TIME = BKGTIM
	BKGTIM = A
	GOTO 9999
C
C***********************************************************************
C
C  ERROR IN CALLING MODE
C
9000	WRITE(ITYP,9010)
9010	FORMAT('  >> ERROR << - PKSCAN CALLED WITH AN INVALID MODE')
C
	CALL PUSH(10,3)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			POP - STACK TOP REMOVAL
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS SUBROUTINE POPS THE "GO TO" FLAG OUT OF THE STACK
C	   AND DECREMENTS THE POINTER DOWN ONE.  THE ENTRIES ON THE
C	   STACK CONSIST OF A FUNCTION CODE AND A MODE CODE (AS A
C	   LOGICALLY ASSOCIATED PAIR OF INTEGERS).
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE POP(INAME,IMODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
	COMMON /STACK/	IPOINT
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
C		NONE
C
C***********************************************************************
C
C  IF POINTER EQUALS ZERO THEN NOTHING TO DO
	IF (IPOINT.LE.0) GOTO 9999
C
C  GET THE TOP OF THE STACK
C
	INAME = ITRANS(IPOINT,1)
	IMODE = ITRANS(IPOINT,2)
C
C  ZERO THE ENTRY
C
	ITRANS(IPOINT,1) = 0
	ITRANS(IPOINT,2) = 0
C
C  DECREMENT THE POINTER IF NOT ALREADY ZERO (STACK EMPTY)
C
	IF (IPOINT.GT.0) IPOINT = IPOINT - 1
C
C***********************************************************************
C
C  END OF JOB
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			PUSH - STACK DATA ADDITION
C
C***********************************************************************
C
C	DISCRIPTION:
C
C		THIS PROGRAM ADDS A LOGICAL PAIR OF INTEGER DATA
C	   VALUES TO THE STACK.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE PUSH(INAME,IMODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		STACK:		STACK POINTER
C
	COMMON /STACK/	IPOINT
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
C		NONE
C
C***********************************************************************
C
C  CHECK IF SPACE IS LEFT ON THE STACK
C
	IF(IPOINT.LT.20) GOTO 10
C
C  TABLE IS FULL
C
	WRITE(ITYP,1000) (ITRANS(I,1),ITRANS(I,2),I=1,20)
1000	FORMAT('  ITRANS FULL - YOU FIGURE IT OUT: ',2(20I4))
C
C  CALL EXIT THROUGH THE STACK
C
	ITRANS(20,1) = 9999
	ITRANS(20,2) = 0
	GOTO 9999
C
C***********************************************************************
C
C  INCREMENT THE POINTER TO NEXT ELEMENT
C
10	IPOINT = IPOINT + 1
C
C  PUT THE NEW ENTRY ON TOP OF THE STACK
C
	ITRANS(IPOINT,1) = INAME
	ITRANS(IPOINT,2) = IMODE
C
C***********************************************************************
C
C  ALL DONE, BACK TO CALLER
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		QUALITATIVE ANALYSIS ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS SUBROUTINE SETS UP THE PARAMETERS FOR A
C	   QUALITATIVE ANALYSIS RUN.  IT THEN DIRECTS THE INITIAL
C	   CALLS TO BEGIN THE COLLECTION OF A STEP SCANNED POWDER
C	   PATTERN.
C
C***********************************************************************
C***********************************************************************
C
      SUBROUTINE QUAL
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
	BYTE IALPH, NAME, NMFIL, IY, NULL
	DATA IY/' '/, NULL/' '/
	DIMENSION ISTD(9),NSTEP(2)
C
C***********************************************************************
C
C  FIRST THING, PUSH THE QUAL COMPLETION ROUTINE ON THE STACK
C
	CALL PUSH(11,0)
C
C***********************************************************************
C
C  SAY HELLO
C
C  SET STATUS (ITR) TO QUALITATIVE ANALYSIS
C
100	ITR = 2
	IRUN = 1
	ITOT = 0
C
C  GET THE CURRENT DATE AND TIME
C
	CALL DATIM
C
C  WRITE OUT THE GREETING
C
	WRITE(ITYP,1000) ITIM, IDAT
1000	FORMAT(/,'           POWDER PATTERN DATA COLLECTION AT ',
     1	I2,':',I2.2,':',I2.2,' ON ',I2,'/',I2,'/',I2)
C
C  GET THE STARTING ANGLE FOR THE RUN
C
110	WRITE(ITYP,1005)
1005	FORMAT(/,' ENTER STARTING ANGLE AND ENDING ANGLE FOR THE ',
     1	'RUN (F)',/,' (DEFAULTS: 5.0,90.0) ? ',$)
	READ(IRD,1010) BANG,EANG
1010	FORMAT(F,F)
C
C***********************************************************************
C
C  CHECK THE ANGLES TO MAKE SURE THEY'RE OK
C
	BANG = FIXANG( BANG )
	EANG = FIXANG( EANG )
C
	IF (BANG.LT.0.001) BANG = 5.0
	IF (EANG.LT.0.001) EANG = 90.0
C
	IF (BANG.GE.EANG) GOTO 100
C
	TANG = BANG
	CALL CKANG(NSTEP(1),NSTEP(2),IERROR)
	IF (IERROR.NE.0) BANG = 5.0
C
	TANG = EANG
	CALL CKANG(NSTEP(1),NSTEP(2),IERROR)
	IF (IERROR.NE.0) EANG = 90.0
C
C  ASK IF THE RESULTS ARE ACCEPTABLE
C
	WRITE(ITYP,120) BANG,EANG
120	FORMAT(/,' SCAN FROM ',F7.3,' TO ',F7.3,' ? ',$)
	READ(IRD,130) IY
130	FORMAT(A1)
	IF ((IY.NE.'Y') .AND. (IY.NE.NULL)) GOTO 110
C
C***********************************************************************
C
C  BEGIN SLEWING TO THE STARTING ANGLE AND THEN CONTINUE TO
C  INPUT INFORMATION WHILE THE DIFFRACTOMETER IS MOVING
C
	RATE = 0.0
	TANG = BANG
	CALL BGMOVE
	CALL POP(J1,J2)
C
C  MOTOR IS NOW MOVING - GET THE RUN PARAMETERS
C
C
C  SET RUN PARAMETERS FOR FIXED TIME COUNTING
C  IN STEP SCAN MODE
C
200	IPK = 0
	FIXERR = 0.0
C
C  INPUT STEP SIZE, COUNT TIME AND SPEED
C
	WRITE(ITYP,1020)
1020	FORMAT(/,' ENTER STEPSIZE, COUNT TIME(SEC), METHOD, AND ',
     1	'MAXIMUM COUNTS',/,' (DEFAULTS: 0.020,3.0,1,900000.) ? ',$)
C
	READ(IRD,1022) DANG, TIME, MVCNT, CNTLIM
1022	FORMAT(F,F,I,F)
C
C***********************************************************************
C
C  SET THE DEFAULT VALUES
C
	IF (DANG.LT.0.001) DANG = 0.02
	IF (TIME.LT.0.01) TIME = 3.0
	IF (MVCNT.EQ.0) MVCNT = 1
	IF (CNTLIM.LT.1.0) CNTLIM = 900000.
C
C  SET ANGLES AND COUNT TIME TO MULTIPLES OF INTERFACE UNITS
C
	DANG = FIXANG( DANG )
	TIME = FIXTIM( TIME )
C
C  COMPUTE THE RUN TIME AND OUTPUT
C    NOTE: A PRECISE COMMUNICATION TIME FACTOR MUST BE MEASURED AND
C    INSERTED HERE. A TEMPORARY VALUE OF .22 SEC  WILL BE USED FOR NOW
C
	DELTA = (EANG - BANG) / DANG
	RUN = DELTA * (TIME+.22) / 60.
C
C***********************************************************************
C
C  READ THE CODES FOR THE INTERNAL STANDARDS USED
C
	WRITE(ITYP,1045)
1045	FORMAT(/,' ENTER 6 LETTER CODES FOR UP TO 3 INTERNAL',
     1	' STANDARDS',/,' IN THE FORM:AAAAAA  AAAAAA  AAAAAA',
     2	/,' :',$)
C
	READ(IRD,1048)ISTD
1048	FORMAT(3(3A2,2X))
C
C GET THE TITLE, OPERATORS NAME, AND OUTPUT FILE NAME
C
	CALL FILEUP(1)
C
C  CALCULATE THE HOUR THE RUN IS GOING TO END
C
	CALL ENTIM(RUN)
C
C***********************************************************************
C
C  PRINT OUT THE DATA JUST INPUT FOR FINAL SCRUTINY
C
	ID = ITYP
125	WRITE(ID,1000) ITIM,IDAT
C
	WRITE(ID,1031) (ITITLE(I),I=1,39)
1031	FORMAT(/,1H ,39A2)
	WRITE(ID,1035) (ITITLE(I),I=41,50)
1035	FORMAT(' OPERATOR: ',10A2)
C
	WRITE(ID,1032) NAME
1032	FORMAT(' OUTPUT FILE: ',15A1)
	WRITE(ID,1033) ISTD
1033	FORMAT(' STANDARDS:'3(2X,3A2))
C
	WRITE(ID,1030) BANG, EANG, DANG, TIME, MVCNT, CNTLIM, RUN, IENRN
1030	FORMAT(/,' BEGINNING ANGLE(DEG)= ',F10.3/
     1	' ENDING ANGLE(DEG)   = ',F10.3/
     2	' STEP SIZE(DEG)      = ',F10.3/
     3	' COUNT TIME(SEC)     = ',F10.3/
     4	' MVCNT METHOD        = ',I6/
     5	' MAX COUNTS          = ',F7.0/
     6	' RUN TIME(HRS)       = ',F10.3,
     7	'     TO END AT ',I2,':',I2.2,' ON ',I2,'/',I2,'/',I2)
C
	REWIND ID
C
C***********************************************************************
C
C  DOES 'HE' HAVE ANY CORRECTIONS TO MAKE
C
	IF(ID .EQ. IPRT) GOTO 140
C
	WRITE(ITYP,1034)
1034	FORMAT(/,' CORRECTIONS (Y/N) ? ',$)
	READ(IRD,1040) IY
1040	FORMAT(A1)
C
	IF ((IY.NE.'N') .AND. (IY.NE.NULL)) GOTO 200
C
	WRITE(ITYP,1042)
1042	FORMAT(/,' PRINT INPUT ON LINE PRINTER (Y/N) ? ',$)
	READ(IRD,1040) IY
C
	ID = IPRT
	IF(IY .EQ. 'Y') GOTO 125
C
C***********************************************************************
C
C  SET THE NUMBER OF PEAK AND BACKGROUND POINTS
C
140	NBG = 0
	NPK = IFIX(DELTA + 1.5 )
C
C  NOW ALLOCATE THE OUTPUT DATA FILE
C
	ID = IDISK(2)
	CALL ALOT(ID,ISIZE)
C
C  WRITE THE RUN PARAMETERS TO THE OUTPUT FILE
C
	WRITE(ID,1050) BANG, EANG, DANG, RATE,
     1	MVCNT, CNTLIM, ISTD, TIME
1050	FORMAT(F7.3,7X,2F7.3,F4.1,I1,12X,F7.0,9A2,48X,F7.2)
C
C  NUMBER OF RECORDS WRITTEN ON OUTPUT FILE
C
	NREC = 6
C
C***********************************************************************
C
C  WE'VE DONE DONE OUR DUTY, SO LETS SKEEEDADDLE
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		QUANTITATIVE ANALYSIS RUN TIME ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C	    THIS ROUTINE READS A RUNFILE AND DIRECTS THE QUANTITATIVE
C	DATA COLLECTION FOR EACH PEAK IN THE RUNFILE BY CALLS TO
C	PKSCAN OR STPSCN.
C
C
C	    THE "QUANT" DATA COLLECTION PACKAGE ALLOWS FOR FIVE
C	MODES OF DATA COLLECTION.  THREE ARE FOR QUANTITATIVE
C	ANALYSIS AND TWO ARE FOR SELECTED AREA DATA COLLECTION.
C	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
C	IS IDENTICAL. THE DIFFERENT IFLAG VALUES ARE ONLY FOR
C	PURPOSES OF ANALYSIS OF THE RAW DATA.  GENERALLY THE
C	PEAK AND INTEGRATED INTENSITY MODE WILL BE USED FOR
C	DETERMINATION OF RELATIVE INTENSITIES.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE RNQUAN(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
C		TEMP:		TEMPERATURE SENSOR FLAGS
C
	COMMON /TEMP/	IOFF,		ITEMP,		IADDTM
C
C		QUAN:		QUANT PARAMETERS
C
	COMMON /QUAN/	CONC,		LOOP,		LPK,
     1	NUM(20),	IREPT,		SCONC
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
	BYTE IALPH, NAME, NMFIL, IY, NAM(6)
C
	DIMENSION JKL(3)
C
	ID1 = IDISK(1)
	ID2 = IDISK(2)
C
C  GENERAL FORMATS FOR USE THROUGHOUT THE ROUTINE
C
10000	FORMAT(A1)
10010	FORMAT(128A1)
10020	FORMAT(F7.3)
C
C***********************************************************************
C
C  BRANCH TO APPROPRIATE SECTION BASED ON THE MODE FLAG
C
	IF ((MODE.LT.1) .OR. (MODE.GT.5)) GOTO 9000
C
	GOTO(1000,2000,3000,4000,5000),MODE
C
C***********************************************************************
C
C  	BEGIN THE QUANTITATIVE ANALYSIS
C
C  WE START BY INITIATING A LOOP OF IFLAG(6) MOUNTINGS
C  AND IFLAG(5) REPETIONS OF THE UNKNOWN OR STANDARD
C
1000	LOOP = 0
C
2000	LOOP = LOOP + 1
C
C***********************************************************************
C
C  REQUEST MOUNTING OF SAMPLE AND OPENING OF THE SHUTTER
C
2010	WRITE(ITYP,2020) LOOP
2020	FORMAT(/,' PLEASE PLACE SAMPLE #',I2,' IN THE DIFFRACTOMETER '
     1	'AND OPEN',/,' THE SHUTTER.  THEN TYPE R FOR READY OR '
     2	'X TO EXIT.',/,' ? ',$)
C
	READ(IRD,10000) IY
C
C  DO WE EXIT WITHOUT FURTHER SAMPLE MOUNTS?
C
	IF (IY .NE. 'X') GOTO 2050
C
C  EXIT FROM QUANT REQUESTED
C  DELETE DATA FILE IF NO DATA HAS BEEN COLLECTED.
C
	IF (LOOP.NE.1) GOTO 2040
C
	DO 2030 I=1,15
2030	NAME(I) = NMFIL(I)
C	CALL DELETE
C
	WRITE(ITYP,2032)
2032	FORMAT(/' QUANTITATIVE ANALYSIS RUN CANCELED.')
C
2040	CALL PUSH(10,3)
	GOTO 9999
C
C  TEST THAT USER INDICATED THAT SAMPLE AND SHUTTER IS READY
C
2050	IF (IY .NE. 'R') GOTO 2010
C
C***********************************************************************
C
C  RESET DELPK SINCE THIS IS THE BEGINING OF DATA COLLECTION FOR
C  THIS MOUNTING.
C
	DELPK = 0.0
C
C  REQUEST WT FRACTION OF REFERENCE OR SPIKING PHASE
C
	CONC = 1.0
	IF ((IFLAG(3).NE.1) .AND. (IFLAG(3).NE.3)) GOTO 2150
C
C  INTERNAL STANDARD OR SPIKING METHOD - ENTER CONCENTRATION OF PHASE
C
2100	WRITE(ITYP,2110)
2110	FORMAT(/,' ENTER WT FRACTION OF REFERENCE OR SPIKING PHASE'
     1	'(F7.3)',/,' ? ',$)
C
	READ(IRD,10020) CONC
	IF ((CONC.LT.0.0). OR. (CONC.GT.1.0)) GOTO 2100
C
C  IF THIS IS A STANDARD RUN GET THE CONCENTRATION OF THE STANDARD
C
2150	IF (IFLAG(2).NE.2) GOTO 2200
	IF (IFLAG(3).EQ.2) GOTO 2170
C
	WRITE(ITYP,2160)
2160	FORMAT(/,' ENTER THE CONCENTRATION OF THE STANDARD BEING RUN'
     1	,/,' ? ',$)
C
	READ(IRD,10020) SCONC
	GOTO 2200
C
2170	IF (IFLAG(4).EQ.1) GOTO 2200
	WRITE(ITYP,2180)
2180	FORMAT(/,' ENTER THE MASS ABSORPTION COEFF. OF THE STANDARD'
     1	,/,' ? ',$)
C
	READ(IRD,10020) SCONC
C
C***********************************************************************
C
C  INITIALIZE THE REPETION COUNTER
C
2200	IREPT = 0
C
C***********************************************************************
C
C  INITIALIZE THE POINTER OF THE NEXT LINE TO BE ANALYSED
C
3000	IREPT = IREPT + 1
	LPK = 0
C
C  IN RE-RUNNING A SAMPLE WE REWIND THE RUN FILE AND RE EXECUTE IT
C
	REWIND ID1
C
C  SKIP OVER THE FIRST RECORD IN THE RUN FILE
C
	READ(ID1,10000)
C
C  WE ARE NOW READY TO ANALYSE THE NEXT LINE ON THE RUN FILE
C
3100	LPK = LPK + 1
C
C  ZERO THE COUNTER OF THE POINT NUMBER BEING MEASURED
C
	ITOT = 0
C
C  READ A LINE FROM THE RUN FILE.
C
	READ(ID1,3110,END=5100) BANG, PANG, EANG, DANG, RATE, MVCNT,
     1	TIMLIM, FIXERR, CNTLIM, NAM, JKL, KODE, IOVLP, IPK, NPK, NBG,
     2	FREL, SIGREL, STD, SIGSTD
3110	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  IS THIS LINE TO BE MEASURED?
C  (FOR I-REL OR CALIBRATION RUNS MEASURE ALL THE LINES)
C
	J=0
	DO 3120 I=1,20
	IF (LPK.EQ.NUM(I)) J=1
3120	CONTINUE
C
	IF ((J.EQ.0) .AND. (IFLAG(3).LE.3)) THEN
		READ(ID1,10000)		! SKIP THE CHEMISTRY RECORD
		GOTO 3100
		END IF
C
C***********************************************************************
C
C  YES, MEASURE THIS LINE.  SET THE NECESSARY CALLS INTO THE
C  STACK, BEGIN THE MOVE, AND RETURN.
C
C  MASSAGE THE ANGLES (ROUND OFF ELIMINATION...  HOPEFULLY)
C
	BANG = FIXANG(BANG)
	PANG = FIXANG(PANG)
	EANG = FIXANG(EANG)
	DANG = FIXANG(DANG)
C
C  AFTER COMPLETION RETURN TO RNQUAN
C
	CALL PUSH(8,4)
C
C  DO THE COUNT TIME ESTIMATION (ESTIM)
C
	CALL PUSH(9,0)
C
C  IF WE NEED TO FIND THE PEAK ADD THAT ALSO
C
	IF (IPK.EQ.1) CALL PUSH(5,0)
C
C  CALL THE SLEW ROUTINE TO GET THE WHOLE OPERATION UNDER WAY
C
	TANG = BANG
	RATE = 0.0
	CALL BGMOVE
C
C  FOR PEAK INTENSITY DATA COLLECTION SHIFT PANG BY THE LAST SHIFT
C
	IF (IPK.EQ.1) PANG = PANG + DELPK
C
	GOTO 9999
C
C***********************************************************************
C
C  RETURNED FROM ESTIM-OPTIM.  THE COUNTING TIMES ARE NOW KNOWN.
C
C  WRITE THE DATA RECORD.
C
4000	WRITE(ID2,4010) BANG, PANG, EANG, DANG, RATE, MVCNT,
     1	TIMLIM, FIXERR, CNTLIM, NAM, JKL, KODE, IOVLP,
     2	IPK, NPK, NBG, FREL, SIGREL, STD, SIGSTD, CONC, TIME,
     3	BKGTIM, IPKFND, SCONC
4010	FORMAT(3F7.3,F7.4,F4.1,I1,F5.1,F5.2,F7.0,6A1,3I2,3I1,
     1	2I2,F6.1,F4.1,F9.4,F8.4,F7.3,2F7.2,I2,F7.3)
C
C  READ THE ASSOCIATED OVERLAP AND CHEMISTRY RECORD AND WRITE IT.
C
	READ(ID1,10010) (IALPH(I),I=1,128)
C
	WRITE(ID2,10010)(IALPH(I),I=1,128)
C
C  NUMBER OF OUTPUT RECORDS
C
	NREC=NREC+2
C
C***********************************************************************
C
C  RESET IPT AND ITOT AS THEY WERE USED BY ESTIM
C
	IPT = 0
	ITOT = 0
C
C  STORE THE RETURN TO RNQUAN ON THE STACK
C
	CALL PUSH(8,5)
C
C  STORE THE FINAL CALL TO WRFILE TO SEND OUT ANY DATA THAT IS LEFT
C
	CALL PUSH(12,0)
C
C  STORE PKSCAN WITH MODE = 0 FOR STPSCN, = 1 FOR PKSCAN
C
	MODE = IPK + 1
	CALL PUSH(6,MODE)
C
	GOTO 9999
C
C***********************************************************************
C
C  DO WE PERFORM ANOTHER LOOP OR JUST FALL THROUGH TO END ?
C	(NOTE: EOF ON LINE READ RETURNS TO 5100)
C
5000	GOTO 3100				! GET THE NEXT LINE
5100	IF (IREPT.LT.IFLAG(5)) GOTO 3000
	IF (LOOP.LT.IFLAG(6)) GOTO 2000
C
C***********************************************************************
C
C  END QUANT DATA COLLECTION - CALL FINIS FOR NORMAL TERMINATION
C
	CALL PUSH(10,2)
C
	CALL DATIM
	WRITE(ITYP,5010) (ITIM(I), I=1,3)
5010	FORMAT(/,'  QUANTITATIVE ANALYSIS COMPLETION AT ',
     1	I2,':',I2.2,':',I2.2)
C
	GOTO 9999
C
C***********************************************************************
C
C  ERROR HANDLER
C
9000	WRITE(ITYP,9010)
9010	FORMAT('  >> ERROR << - IN RNQUAN')
	GOTO 9999
C
C***********************************************************************
C
C  CALL FOR CURRENT TEMPERATURE ENCODING
C
C9999	CALL BGTEMP
C
C  THAT'S ALL SHE WROTE ....
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C		QUANTITATIVE ANALYSIS COMMAND FILE CREATION
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
	SUBROUTINE RUNFIL(MODE)
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
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C	>> WARNING << THIS ROUTINE MAY BE EXECUTED DURING A RUN SO
C   VARIABLES FROM THE COMMON BLOCK QUAN, ANG, TIM, PROB, AND COUN
C   HAVE BEEN USED AS LOCAL VARIABLES FOR CLARITY BUT THE CURRENT
C   RUN SHOULD NOT BE AFFECTED.
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IGALF(10),	ITIM(3),
     1	ITITLE(50)
C
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IALPH, NAME, IBLK
	BYTE IPHASE(6), IPHAS2(6), IPHAS3(6), NMTEMP(15)
	DIMENSION IFLAG(10)
C
C  INITILIZE THE IFLAG ARRAY
C
	DATA IFLAG/0,0,0,0,0,0,0,0,0,0/
	DATA IFLAG(1)/2/, IFLAG(2)/2/
	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
	IF (MODE.GT.0) GOTO 80
	CALL DATIM
	WRITE(ITYP,1000) ITIM, IDAT
1000	FORMAT(//,'    QUANTITATIVE ANALYSIS COMMAND FILE BUILDING AT '
     1	I2,':',I2.2,':',I2.2,' ON ',I2,'/',I2.2,'/',I2.2,/)
C
C***********************************************************************
C
C  INPUT THE NAME OF THE RUN FILE
C
80	CALL FILEUP(2)
C
	DO 90, I=1,15
90	NMTEMP(I) = NAME(I)
C
	NREC=1
C
C***********************************************************************
C
C  WHAT TYPE OF ANALYSIS DOES HE WANT ?
C
	WRITE(ITYP,1010)
1010	FORMAT(/,' METHOD OF ANALYSIS (I1) ? ',//
     1	'      1 - INTERNAL STANDARD       2 - INTENSITY RATIO',/
     2	'      3 - SPIKING                 4 - REL. INT.(DEFAULT)',/
     3	'      5 - PROFILE',//,' CHOICE : ',$)
C
	READ(IRD,1020) IFLAG(3)
1020	FORMAT(I1)
C
C  IF ONLY A RETURN WAS INPUT SET THE DEFAULT, ALSO SET THE RUN TYPE
C  DESCRIPTOR FLAGS IF NECESSARY
C
	IF (IFLAG(3).EQ.0) IFLAG(3) = 4
	IF (IFLAG(3).EQ.4) IFLAG(2) = 3
C jdw	IF (IFLAG(3).EQ.5) IFLAG(1) = 4
C
C  IF SPIKING, RELATIVE INTENSITY, OR PROFILE ANALYSIS, THEN
C  CHEMISTRY IS NOT USED
C
	IF (IFLAG(3).GE.3) GOTO 100
C
	WRITE(ITYP,1030)
1030	FORMAT(//,' WILL CHEMICAL COMPOSITION BE ENTERED Y/N ?',$)
C
	READ(IRD,1040) IY
1040	FORMAT(A1)
C
	IFLAG(4) = 0
	IF (IY.EQ.'Y') IFLAG(4) = 1
C
C***********************************************************************
C
C  ALLOCATE THE RUN FILE AND WRITE THE TITLE RECORD (RECORD #1)
C	(NOTE: UNDER RT-11 ISIZE SERVES NO FUNCTION)
C
C  SEND THE FLAGS BY WAY OF IALPH ARRAY
C
100	DO 110, I=1,10
110	ENCODE(1,120,IALPH(112+I)) IFLAG(I)
120	FORMAT(I1)
C
	ID = IFOUT
	ISIZE = 0
	CALL ALOT(ID,ISIZE)
C
	DO 130, I = 1,128
130	IALPH(I) = IBLK
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)(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(IRD,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) ? ',$)
	READ(IRD,1090) IY
1090	FORMAT(A1)
	IF (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  1 = STEPSCAN (DEFAULT) 2 = INTEGRATE'//
     9	'          PK 2-TH BKGL2TH BKGH2TH STPWDTH CNT MAX #PK  #BKG M'/
     *	' DEFAULT:   0.0     0.0     0.0    0.01   900000.    5   10 1'/
     1	' FORMAT:  NNN.NNN NNN.NNN NNN.NNN NN.NNNN NNNNNN. NNNN NNNN N'/
     2	' ------------------------------------------------------------'/
     3	' INPUT:   ',$)
C
	READ(IRD,1110) PANG,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
	PANG = FIXANG(PANG)
	BANG = FIXANG(BANG)
	EANG = FIXANG(EANG)
	DANG = FIXANG(DANG)
	IF (DANG.LT.0.001) DANG = .01
C
	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	IF (MVMODE.LT.1) MVMODE = 1		! INT. MVCNT DISALLOWED
	MVMODE = 1
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(IRD,1130) PANG,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) ? ',$)
	READ(IRD,1150) IY
1150	FORMAT(A1)
	IF (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)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) 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) 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) ? ',$)
	READ(IRD,1290) IY
1290	FORMAT(A1)
	IF (IY.EQ.'N') GOTO 240
C
C***********************************************************************
C
C  NOW PROCEED TO WRITE RECORD 2 OF THE RUN FILE
C
300	WRITE(ID,1300)BANG,PANG,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 8 WILL BE SUPPLIED
C  BY THE PROCESSING PROGRAM FROM THE INFO CONTAINED IN RECORD 6
C  AS READ BY QUANT
C
	WRITE(ID,1310) (IALPH(I),I=1,128)
1310	FORMAT(128A1)
	NREC=NREC+2
C
C***********************************************************************
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 ID
	CLOSE(UNIT=ID,ERR=9000)
C
C  PASS BACK THE NAME OF THE FILE JUST CREATED
C
	DO 410, I=1,15
410	NAME(I) = NMTEMP(I)
C
C  SKIP THE SUMMARY MESSAGE IF WE WEREN'T CALL EXPLICITLY
C
	IF (MODE.GT.0) GOTO 430
	WRITE(ITYP,420) (NMTEMP(I),I=1,14),NREC
420	FORMAT(/,'  RUN FILE ',14A1,' CONTAINS ',I3,' RECORDS.')
430	GOTO 9999
C
C***********************************************************************
C
C   PRINT ERROR MESSAGE IF ERROR ON CLOSING OF FILE
C
9000	WRITE(ITYP,9010)
9010	FORMAT(/,'  >> ERROR << - ON CLOSING OF FILE IN RUNFIL')
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			PEAK SMOOTHING ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
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
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE SMTH13
C
C***********************************************************************
C
C
C  COMMON VARIABLES USED:
C
C     CNT = ARRAY OF INTENSITY VALUES TO BE SMOOTHED.  THE SMOOTHED
C           VALUES ARE TO BE RETURNED IN DATA
C
C  LOCAL VARIABLES:
C
C     SAVE = A SCRATCH ARRAY FOR SAVING DATA VALUES SO THAT THE
C            SMOOTHED VALUES CAN BE PLACED BACK INTO THE DATA ARRAY.
C
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	DIMENSION SAVE(6)
C
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***********************************************************************
C
C  TOP OF THE SMOOTHING LOOP
C
	DO 30 I=1,38
C
C***********************************************************************
C
C	CALCULATE THE SMOOTHED POINT
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
	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
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
C***********************************************************************
C
	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			STEP SCANNING ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C  SUBROUTINE STEP SCAN COLLECTS FIXED TIME COUNT DATA STARTING
C  AT CANG AND ENDING AT EANG STEPPING BY DANG BETWEEN POINTS.
C  IN MODE=0, AFTER EACH SET OF 16 DATA POINTS ARE COLLECTED THEY
C  ARE WRITTEN TO THE OUTPUT DISK FILE AND FINIS IS CALLED WHEN
C  EANG IS REACHED TO COMPLETE THE OPERATION.  IN MODE=1, COUNTS
C  ARE ONLY STORED IN THE COUNT ARRAY AND FINIS IS NOT CALLED.
C
C***********************************************************************
C***********************************************************************
C
      SUBROUTINE STPSCN(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		RNDT:		RUN, DATE, AND TIME PARAMETERS
C
	COMMON /RNDT/	NREC,		NMFIL(16),	ITR,
     1	IENRN(5)
C
C		PROB:		RUN IDENTIFIERS
C
	COMMON /PROB/	IDAT(3),	IFLAG(10),	ITIM(3),
     1	ITITLE(50)
C
C		ANG:		COLLECTION UNIT POSITION
C
	COMMON /ANG/	BANG,		CANG,		DANG,
     1	EANG,		IRATE,		PANG,		RATE,
     2	TANG,		IZRST,		NPTPK,		PPD
C
C		SCAN:		PEAK SEARCH MODES
C
	COMMON /SCAN/	IPKFND,		TEANG,		DELPK
C
C		COUN:		COUNTS RECEIVED
C
	COMMON /COUN/	CNT(50),	IPT,		ITOT,
     1	CNTLIM,		ISAVE,		SIMTIM
C
C		TIM:		TIME LIMITS AND VALUES
C
	COMMON /TIM/	BKGTIM,		FIXERR,		IPK,
     1	NBG,		NPK,		TIME,		TIMLIM
C
	BYTE NMFIL
	DIMENSION NSTEP(2)
C
C***********************************************************************
C
C  IF THE CURRENT ANGLE IS ABOVE THE ENDING ANGLE THE JOB IS COMPLETE.
C
	IF (CANG.GT.EANG+0.0001) GOTO 500
C
C  INCREMENT TARGET ANGLE
C
	TANG = FIXANG(CANG + DANG)
	CALL CKANG(NSTEP(1),NSTEP(2),IERROR)
	IF (IERROR.EQ.1) GOTO 9000
C
C***********************************************************************
C
C  START THE COUNTING WHILE WE SET UP TO COMPLETE IT AND THE NEXT MOVE
C
200	CALL BGCNT
C
C
C   THE LAST THING TO BE CALLED IS PUSHED FIRST. THIS CALL IS RECURSIVE
C   BACK TO STPSCN.
C
	CALL PUSH(7,MODE)
C
C   JUST PREVIOUS TO THE STEPSCAN CALL WE WANT TO MOVE TO THE NEXT
C   POINT (BEGIN MOVE PUSHES END MOVE ON THE STACK TO COMPLETE ITSELF)
C
	CALL PUSH(1,0)
C
C   NOW THE FIRST THING WE WANT DONE, END THE COUNTING PROCEDURE.
C
	CALL PUSH(4,0)
C
C  BUT WE DON'T WANT TO START UNTIL THE COMPLETION CHARACTER
C  IS RECIEVED, SO, RETURN US TO THE INTERRUPT LOOP.
C
	CALL PUSH(20,0)
C
C***********************************************************************
C
C  NOW GET READY TO RECEIVE THE NEXT POINT!
C
C  SKIP THE WRITE TO FILE IF WE'RE KEEPING THESE COUNTS INTERNALLY
C
300	IF (MODE.EQ.1) GOTO 310
C
C   IF WE HAVE 16 POINTS ALREADY CLEAR THEM OUT BY WRITING THEM
C   TO THE OUTPUT FILE
C
	IF (IPT.LT.16) GOTO 310
	CALL WRFILE
C
C   INCREMENT THE COUNTERS FOR THE NEW POINT
C
310	ITOT = ITOT + 1
	IPT  = IPT  + 1
	IF (IPT.GT.50) IPT = 50
C
C   ... AND GO GET IT.
C
	GOTO 9999
C
C***********************************************************************
C
C  COMPLETED THE SCAN
C
C  WRITE BUFFERED DATA TO COMPLETE DATA RECORD IF REQUIRED
C
500	IF ((MODE.EQ.1) .OR. (IFLAG(3).NE.0)) GOTO 510
	CALL WRFILE
C
C  PUSH FINIS ON THE STACK TO CLEAN UP
C
	CALL DATIM
	WRITE(ITYP,505) ITIM(1),ITIM(2)
505	FORMAT(/,' QUALITATIVE ANALYSIS RUN COMPLETED AT 'I2,':',I2.2)
	CALL PUSH(10,2)
C
510	GOTO 9999
C
C***********************************************************************
C
C  ERROR LET THE OPERATOR KNOW IT
C
9000	IF (MODE.NE.1) CALL WRFILE
C
	WRITE(ITYP,9010)
9010	FORMAT(/,'  >> ERROR << - STPSCN ERROR, ABORTING')
C
C  CALL FINIS FOR MOP UP.
C
C
	CALL PUSH(10,4)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			INTERFACE TEST ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE TESTS FOR THE OCCURANCE OF A
C	   COMPLETION ON THE INTERFACE DEVICE.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE TINTFC(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C		CNTL:		PROGRAM CONTROL VARIABLES
C
	COMMON /CNTL/	IACT,		IDBUG,		INTR,
     1	IRUN,		ITRANS(20,2),	MVCNT
C
C		BUFF:		SCRATCH ARRAYS
C
	COMMON /BUFF/	IALPH(128),	NAME(16)
C
C		INTRFC:		INTERFACE MODULE ADDRESSES
C
	COMMON /INTRFC/	MODULE(4),	ISTATS
C
C
C***********************************************************************
C
C	VARIABLE DECLARATION:
C
	BYTE IDONE, IFINIS, IALPH, NAME
	DATA IDONE,IFINIS /')','/'/
C
	MODE = 0
C
C***********************************************************************
C
C  THIS SECTION CHECKS FOR AN INTERFACE COMPLETION
C
C
C   READ A CHARACTER FROM THE INTERFACE
C
	NFLAG = 0
	CALL IFINP(NBS,IALPH,1,NFLAG)
C
C   SET FLAG IF IT'S A COMPLETION
C
	IF (IALPH(1).EQ.IDONE) MODE = 1
C
C   IF THERE IS NO ERROR CONDITION THEN RETURN
C
	IF (NFLAG.LT.2) GOTO 9999
C
C***********************************************************************
C
C   IMPROPER INTERFACE COMPLETION - ABORT
C
C   WRITE MESSAGE TO INDICATE IMPROPER COMPLETION
C
100	WRITE(ITYP,110)
110	FORMAT(/,' >> ERROR <<  IMPROPER INTERFACE COMPLETION.')
C
C   SET REPLY FLAG AND CALL FINIS
C
	MODE = -1
	CALL FINIS(5)
C
C***********************************************************************
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C			TERMINAL POLL ROUTINE
C
C***********************************************************************
C
C	DESCRIPTION:
C
C		THIS ROUTINE TESTS TO SEE IF A KEY HAS BEEN HIT ON THE
C	   TERMINAL.  IF SO THEN IT RETURN WITH THE MODE FLAG TRUE AND
C	   CONSOL WILL BE CALLED FROM MAIN.
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE TTERM(MODE)
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C
C	SUBSECTION:	COMMON BLOCKS
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IO/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
	CHARACTER ISTAT*10, ESC*1
	DATA ISTAT/'          '/, ESC/27/
	DIMENSION IOSB(2),IPARAM(6)
	CALL GETADR (IPARAM(1),ISTAT)
	IPARAM(2) = 10
	IREAD = 536
	IKILL = 10
C
C***********************************************************************
C		RT11 INSTRUCTIONS
C-----------------------------------------------------------------------
C
C  SEE IF AN INTERRUPT WAS MADE FROM THE CONSOLE
C
C  SET BITS 12 AND 6 OF THE PDP11 JOB STATUS WORD IN ORDER TO USE THE
C  SYSTEM ROUTINE ITTINR TO DETECT THE INTERRUPT FROM THE CONSOLE.
C
C  STORE THE PRESENT CONTENTS IN IWORD
C
C	IWORD = IPEEK("44)
C
C  SET THE JSW
C
C	CALL IPOKE("44,"10100.OR.IPEEK("44))
C
C  TEST FOR CONSOLE INTERRUPT
C
C	MCHAR = ITTINR()
C
C  RESET JSW TO ITS PREVIOUS VALUE
C
C	CALL IPOKE("44,IWORD)
C
C***********************************************************************
C		RSX INSTRUCTIONS
C-----------------------------------------------------------------------
C
C	THIS CODE CONTAINS A WAIT PERIOD THAT ADDS THE THE MAIN LOOP
C   INTERVAL.  DURING THIS TIME AN ESCAPE WILL BE DETECTED.  IF THE
C   SYSTEM BUFFERS CHARACTERS PROPERLY THEN A KEY PRESS AT ANOTHER TIME
C   WILL ALSO BE DETECTED WHEN CONTROL RETURNS TO THIS ROUTINE.  THE
C   READ REQUEST IS PURPOSELY GREATER THAN 1 CHARACTER TO CLEAR THE
C   BUFFER OF ANY EXTRA CHARACTERS.  MODE IS SET TRUE (=1) IF AN ESC
C   (ASCII 27) IS RECEIVED.
C	
	MODE = 0
	ISTAT = '          '
C
	CALL QIO(IREAD,IRD,,,IOSB,IPARAM,)
C
	CALL WAIT(500,1)
C
	CALL WTQIO(IKILL,IRD,1)
	IF (INDEX(ISTAT,ESC) .NE. 0) MODE = 1
C
C***********************************************************************
C
C  EVERYTHING IS SET. RETURN TO MAIN FOR CALL TO CONSOL.
C
9999	RETURN
	END
CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C                 FILE WRITE ROUTINE
C
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
C***********************************************************************
C***********************************************************************
C
      SUBROUTINE WRFILE
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C     SUBSECTION: COMMON BLOCKS
C
C
C           IO:         INPUT/OUTPUT UNIT NUMBERS
C
      COMMON /IO/ NBS,        IDT,        ICLOCK,
     1      ISPEC,            IRD,        IPRT,       ITYP,
     2      IDISK(2),   IFIN,       IFOUT
C
C           CNTL:       PROGRAM CONTROL VARIABLES
C
      COMMON /CNTL/     IACT,       IDBUG,            INTR,
     1      IRUN,       ITRANS(20,2),     MVCNT
C
C           PROB:       RUN IDENTIFIERS
C
      COMMON /PROB/     IDAT(3),    IFLAG(10),  ITIM(3),
     1      ITITLE(50)
C
C           RNDT:       RUN, DATE, AND TIME PARAMETERS
C
      COMMON /RNDT/     NREC,       NMFIL(16),  ITR,
     1      IENRN(5)
C
C           ANG:        COLLECTION UNIT POSITION
C
      COMMON /ANG/      BANG,       CANG,       DANG,
     1      EANG,       IRATE,            PANG,       RATE,
     2      TANG,       IZRST,            NPTPK,            PPD
C
C           SCAN:       PEAK SEARCH MODES
C
      COMMON /SCAN/     IPKFND,           TEANG,            DELPK
C
C           COUN:       COUNTS RECEIVED
C
      COMMON /COUN/     CNT(50),    IPT,        ITOT,
     1      CNTLIM,           ISAVE,            SIMTIM
C
C
C***********************************************************************
C
C	SUBSECTION:	VARIABLE DECLARATION
C
	BYTE NMFIL
C
C***********************************************************************
C
C  IS THERE ANY DATA IN THE BUFFER TO BE WRITTEN? IF NOT THEN RETURN
C
      IF(IPT.EQ.0) GOTO 9999
C
C***********************************************************************
C
C  START THE TEMPERATURE CONVERSION (COMMENTED OUT)
C
C     CALL BGTEMP
C
C  GET THE TIME
C
      CALL DATIM
C
C  GET THE CURRENT TEMPERATURE
C
C     CALL ENTEMP
C
C***********************************************************************
C
C  WRITE THE DATA TO THE OUTPUT FILE. CANG IS ONE STEP PAST THE
C  ANGLE OF THE LAST DATA POINT.
C
      IFILE = IDISK(2)
      WRITE(IFILE,300) CANG-DANG,ITIM(1),ITIM(2),ITEMP,
     1      (CNT(I),I=1,IPT)
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
      DO 500 I=1,IPT
      SUM=SUM+CNT(I)
500   CNT(I) = 0
C
      IPT = 0
C
C  IF THE SUM IS ZERO TYPE A WARNING
C
      IF (SUM.NE.0) GOTO 9999
      WRITE(ITYP,510)
510   FORMAT(/,'  >> WARNING << - COUNT ARRAY IS FILLED WITH ZEROS!')
C
C***********************************************************************
C
C  ALL DONE (NOTE: FINIS WILL WRITE FILE MARK AT THE END OF THE FILE)
C
9999  RETURN
      END
