CBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C
C     *****CONFIG*****CONFIG*****CONFIG*****CONFIG*****CONFIG*****
C
C***********************************************************************
C
C     THIS ROUTINE READS AND/OR CREATES THE UNIT CONFIGURATION FILE.
C
C	IBRNCH	= 1   CREATE FILE
C		= 2   ACTIVATE, READ, AND LIST CONTENTS
C
C	JFLAG	= 0  FILE CREATION MODE
C		= 1  FILE REVISION MODE
C		= 2  FILE READING MODE (REVISION POSSIBLE
C		     FOLLOWING READ)
C
C***********************************************************************
C***********************************************************************
C
	SUBROUTINE CONFIG
C  JIM WALKER MADE THIS A SUBROUTINE 17-NOV-87.  RANAMED COMMON /IO/
C  TO AVOID A COLLISION WITH THE REST OF THE NEW VAX AUTO PACKAGE.
C  SET UNIT NUMBERS TO READ ON 5, TYPE ON 6, PRINT ON 7.
C
C***********************************************************************
C
	IMPLICIT INTEGER*2 (I-N)
C
C	SUBSECTION:	COMMON BLOCKS
C
C  COMMONS ARE IDENTICAL WITH THOSE USED IN AUTO
C
C
C		IO:		INPUT/OUTPUT UNIT NUMBERS
C
	COMMON /IOCFG/	NBS,		IDT,		ICLOCK,
     1	ISPC,		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(15)
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(15),	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
C
	DIMENSION XCALIB(6),ICALIB(6),XMAT(15)
	DIMENSION ISPEC(64)
	DATA IBLNK/'  '/
C
C***********************************************************************
C
C   OPEN FILE CONFIG.DAT AND ATTACH TO IDISK(1)
C
	ID = IDISK(1)
	OPEN(UNIT=ID,NAME='CONFIG.DAT',TYPE='UNKNOWN',ACCESS=
     *  'SEQUENTIAL',CARRIAGECONTROL='LIST')
C
C  READ SYSTEM CLOCK TO GET CURRENT DATE AND TIME
C
	CALL DATIM
C
C***********************************************************************
C
C  READ FUNCTION DESIRED (1=CREATE, 2=READ)
C
	WRITE(ITYP,10) IDAT,ITIM
10	FORMAT(10X,'Configuration file creation and updating routine',
     *	//,15X,'Run on ',I2,2(1H/,I2),2X,I2,2(1H:,I2)/
     *' IMPORTANT: Push "CAPS LOCK" on your terminal'/
     *	' INPUT FUNCTION DESIRED (1=CREATE  OR  2=READ/UPDATE) :',$)
C
	IBRNCH=READX(IW,N,2,IRD,ITYP,IEOF)
C
C-----BRANCH DEPENDING ON WHO CALLED (OR PURPOSE)
C
	IF(IBRNCH.EQ.2) GOTO 400
	IF(IBRNCH.NE.1) GOTO 999
C
C***********************************************************************
C
C     SET FLAG FOR INITIAL ENTRY (=0)
C
	JFLAG = 0
C
C  ENTER UNIT NAME INTO ISPEC ARRAY
C
100	WRITE(ITYP,1010)
1010	FORMAT(/,' ENTER NAME FOR UNIT (A4) : ',$)
	READ(IRD,1020) (ISPEC(I),I=1,2)
1020	FORMAT(2A2)
C
C     STORE CURRENT DATE (6 CHARACTERS)
C
	ENCODE(6,125,ISPEC(3)) (IDAT(I),I=1,3)
125	FORMAT(3I2)
C
C     WHO IS ENTERING CONFIG INFORMATION
C
	WRITE(ITYP,130)
130	FORMAT(1X,'ENTER YOUR INITIALS (A2)',$)
	READ(IRD,110) ISPEC(6)
110	FORMAT(A2)
C  FOR UPDATE BRANCH TO ECHO LINE  **NA**
	IF(JFLAG.EQ.1) GOTO 600
C
C     TARGET, LINE, WAVELENGTH, FOCAL SPOT, TAKE OFF ANGLE
C
140	WRITE(ITYP,141) (ISPEC(I),I=1,2)
141	FORMAT(/1X,'ENTER IN FREE FORMAT FOR UNIT ',2A2/
     *	1X,'TUBE TARGET, LINE, LAMBDA, TYPE, TAKE OFF'/
     *	1X,'    A2        A2    F6.4    A2     F4.1  ')
C     TARGET (A2)
	IDUM=READX(IW,N,2,IRD,ITYP,IEOF)
	ISPEC(7)=IW
C     CHARACTERISTIC LINE FROM TARGET (A2)
	IDUM=READX(IW,N,1,IRD,ITYP,IEOF)
	ISPEC(8)=IW
C     WAVELENGTH (F6.4 = 3A2)
	XLAM = READX(IW,N,1,IRD,ITYP,IEOF)
	ENCODE(6,142,ISPEC(9)) XLAM
142	FORMAT(F6.4)
C     FOCAL SPOT CODE (A2)
	IDUM = READX(IW,N,1,IRD,ITYP,IEOF)
	ISPEC(12)=IW
C     TAKE OFF ANGLE (F4.1=2A2)
	TOF = READX(IW,N,1,IRD,ITYP,IEOF)
	ENCODE(4,146,ISPEC(13)) TOF
146	FORMAT(F4.1)
C  FOR UPDATE BRANCH TO ECHO LINE  **TG**
	IF (JFLAG .EQ. 1) GO TO 620
C
C     DIV SLIT CODE AND ANGLE (DEG) OR LENGTH (MM)
C     GONIOMETER RADIUS IN MM
C     INCIDENT AND DIFFRACTED BEAM SOLLER SLIT ANGLES
C     RECEIVING SLIT ANGLE (DEG)
C
160	WRITE(ITYP,161)(ISPEC(I),I=1,2)
161	FORMAT(1H0,'ENTER IN FREE FORMAT FOR UNIT ',2A2,/,
     &	' DIV SLIT TYPE, ANG/LEN, RADIUS, IN SOLLER, OUT SOLLER, REC'
     &	' SLIT',/,
     &	'      A2          F6.1    F6.1      F4.2       F4.2      ',
     &	' F4.2')
C      DIVERGENT SLIT TYPE: FX=FIXED/TC=THETA-COMP
	IDUM = READX(IW,N,2,IRD,ITYP,IEOF)
	ISPEC (15)=IW
C     DIVERGENT SLIT ANGLE(FX) OR
C     IRRADIATED LENGTH IN MM (TC)
	ANG=READX(IW,N,1,IRD,ITYP,IEOF)
	ENCODE(6,164,ISPEC(16)) ANG
164	FORMAT(F6.1)
C     GONIOMETER CIRCLE RADIUS IN MM
	RAD=READX(IW,N,1,IRD,ITYP,IEOF)
	ENCODE(6,164,ISPEC(19)) RAD
C     GET INCIDENT SOLLER,DIFF SOLLER AND RECEIVING SLIT ANGLES
	DO 190 J=1,3
	ANG = READX(IW,N,1,IRD,ITYP,IEOF)
	I = 20 + J * 2
	ENCODE(4,180,ISPEC(I)) ANG
180	FORMAT(F4.2)
190	CONTINUE
C  FOR UPDATE BRANCH TO ECHO LINE  **SL**
	IF (JFLAG.EQ.1) GO TO 630
C
C     MONOCHROMATOR CODE: GR=GRAPHITE/NN=NONE
C     DETECTOR CODE     : SC=SCINTILLALIOR
C     DEAD TIME PARAMETER IN MICROSECONDS
C
200	WRITE(ITYP,201)(ISPEC(I),I=1,2)
201	FORMAT(/1X,'ENTER IN FREE FORMAT FOR UNIT ',2A2/1X,
     &	'MONO CODE, DETECTOR CODE, DEAD TIME, INT. STABILITY% '/
     &	'    A2          A2            F4.2      F4.2')
C     MONO CODE
	IDUM=READX(IW,N,2,IRD,ITYP,IEOF)
	ISPEC(28)=IW
C     DETECTOR CODE
	IDUM = READX(IW,N,1,IRD,ITYP,IEOF)
	ISPEC(29)=IW
C     DEAD TIME
	TAU = READX(IW,N,1,IRD,ITYP,IEOF)
	ENCODE(4,205,ISPEC(30)) TAU
205	FORMAT(F4.2)
C     INSTRUMENT STABILITY IN PERCENT
	STAB = READX(IW,N,1,IRD,ITYP,IEOF)
	ENCODE(4,205,ISPEC(32)) STAB
C
C-----BLANK FILL REMAINDER OF 128 BYTE RECORD
C
	DO 290 I=34,64
290	ISPEC(I)=IBLNK
C  FOR UPDATE BRANCH TO ECHO LINE  **DT**
	IF (JFLAG.EQ.1) GO TO 640
C
C   SET UP CALIBRATION RECORD FLAGS
C
	WRITE(ITYP,292) (ISPEC(I),I=1,2)
292	FORMAT(/1X,'ENTER CALIBRATION FLAGS FOR UNIT ',2A2,/,1X,
     1	'0/1 FOR (DO NOT)/(DO) APPLY FLAT SPEC, AXIAL DIV,'
     2	' LORENTZ CORRECTIONS')
	DO 294 I=1,6
	ICALIB(I)=0
294	CONTINUE
	ICALIB(1) = READX(IW,N,2,IRD,ITYP,IEOF)
	ICALIB(2) = READX(IW,N,1,IRD,ITYP,IEOF)
	ICALIB(3) = READX(IW,N,1,IRD,ITYP,IEOF)
C
C  SET UP CALIBRATION RECORD(128 BYTES)
C
300	WRITE(ITYP,310)(ISPEC(I),I=1,2)
310	FORMAT(/1X,'ENTER CALIBRATION CONSTANTS FOR UNIT ',2A2,
     1	/,1X,'ZERO OFFSET, A0, A1, A2, A3, A4')
C     ZERO CALIB ARRAY
	DO 320 I=1,6
320	XCALIB(I)=0.0
	XCALIB(1) = READX(IW,N,2,IRD,ITYP,IEOF)
	DO 330 I=2,6
	XCALIB(I)=READX(IW,N,1,IRD,ITYP,IEOF)
	IF (N.EQ.0) GO TO 330
	XCALIB(I)=0.0
	GO TO 340
330	CONTINUE
C  FOR UPDATE BRANCH TO ECHO LINE  **CL**
340	IF (JFLAG.EQ.1) GO TO 650
C
C  SET UP THE INVERSE MATRIX
C
360	WRITE(ITYP,362) (ISPEC(I),I=1,2)
362	FORMAT(/1X,'ENTER FOR UNIT ',2A2,' INVERSE MATRIX ELEMENTS: 00',
     *	' 01 02 03 04 11 ... 34 44')
	DO 370 I=1,15
370	XMAT(I) = 0.0
	XMAT(1) = READX(IW,N,2,IRD,ITYP,IEOF)
	DO 380 I=2,15
	XMAT(I) = READX(IW,N,1,IRD,ITYP,IEOF)
	IF(N.EQ.0)GO TO 380
	XMAT(I) = 0.0
	GO TO 390
380	CONTINUE
C  FOR UPDATE BRANCH TO ECHO LINE **MX**
390	IF(JFLAG.EQ.1) GOTO 650
C
C   ECHO INPUT
C
	GOTO 600
C
C*******************************************************************
C     ACTIVATE CONFIG DATA FILE AND READ IT
C**********************************************************************
C
C     READ CONFIG FILE FOR INSTRUMENT SPECIFICATIONS AND CALIBRATION
C
400	 CONTINUE
C   READ CONFIG FILE FOR INSTR. SPECIFICATIONS AND CALIBRATION
C
500	READ(ID,510,ERR=540)(ISPEC(I),I=1,64)
510	FORMAT(64A2)
C
C   STORE CURRENT DATE
C
	DO 512 I=1,3
	KK=I+2
512	ISPEC(KK)=IDAT(I)
	READ(ID,520,ERR=540)(ICALIB(I),I=1,6),(XCALIB(I)
     *	,I=1,6)
520	FORMAT(6I1,F10.3,5E16.8)
	READ(ID,524,ERR=540)(XMAT(I),I=1,15)
524	FORMAT(8E16.7)
	JFLAG=2
	GO TO 600
C-----ERROR DETECTED
540	WRITE(ITYP,550)ID
550	FORMAT(1H0,'***ERROR ON LOGICAL UNIT= ',I1,'  TERMINATING')
	CALL EXIT
C********************************************************************
C     ECHO INSTRUMENT SPECIFICATIONS
C*******************************************************************
600	WRITE(ITYP,610)(ISPEC(J),J=1,6)
610	FORMAT(1H0,'**NA**',2X,'UNIT',3X,'NAME',4X,'DATE',3X,'INIT'/
     *	(9X,'na',4X,2A2,3X,3A2,3X,A2))
	IF (JFLAG.EQ.1) GO TO 700
620	WRITE(ITYP,621)(ISPEC(J),J=7,14)
621	FORMAT(1H0,'**TG**',2X,'UNIT',3X,'TARGET',3X,'LINE',3X,'LAMBDA',
     *	3X,'TYPE',3X,'TOA'/
     *	(9X,'na',6X,A2,6X,A2,4X,3A2,4X,A2,4X,2A2))
	IF (JFLAG.EQ.1) GO TO 700
630	WRITE(ITYP,631)(ISPEC(J),J=15,27)
631	FORMAT(1H0,'**SL**',2X,'UNIT',3X,'DIV SLIT',3X,'RADIUS',4X,
     *	'SOLLERS',3X,'REC SLIT'
     *	/(9X,'na',5X,A2,3A2,3X,3A2,3X,2A2,1X,2A2,3X,2A2))
	IF (JFLAG.EQ.1) GO TO 700
640	WRITE(ITYP,641)(ISPEC(J),J=28,33)
641	FORMAT(1H0,'**DT**',2X,'UNIT',3X,'MONO',3X,'DETECTOR',3X,
     *	'DEAD TIME,  INT. STABILITY'/(9X,'na',4X,A2,7X,A2,10X,2A2,
     *	10X,2A2,1H%))
	IF (JFLAG.EQ.1) GO TO 700
650	WRITE(ITYP,652)(ICALIB(J),J=1,3),(XCALIB(K),K=1,6)
652	FORMAT(1H0,'**CL**',2X,'UN FS AX LZ OFFSET   A0',5X,'A1',
     *	10X, 'A2',10X,'A3',10X,'A4'/(9X,'na',3(1X,I2),F6.2,F6.3,4E12.5))
	IF(JFLAG.EQ.1) GOTO 700
670	WRITE(ITYP,672) (XMAT(J),J=1,15)
672	FORMAT(1H0,'**MX**  UNIT'/
     *	(9X,'na',2X,5E12.5/25X,4E12.5/37X,3E12.5/
     *	49X,2E12.5 /61X,E12.5//))
C****************************************************************
C     ALLOW FOR CORRECTION
C*******************************************************************
C
C-----WHAT LINE? SET UPDATE FLAG
C
700	WRITE(ITYP,731)
731	FORMAT(1H0,'TO EDIT ENTER LINE CODE (A2) , "OP",
     1	"TY", OR "OK"')
738	READ(IRD,740,ERR=749) (IALPH(K),K=1,2),IUNIT
740	FORMAT(2A1,I1)
	IF(IALPH(1).EQ.'O'.AND.IALPH(2).EQ.'K') GOTO 800
C-----DO WE LIST OPTIONS?
	IF(IALPH(1).EQ.'O'.AND.IALPH(2).EQ.'P') GOTO 760
C  ALLOW FOR COMPLETE LISTING
	JFLAG=0
	IF(IALPH(1).EQ.'T'.AND.IALPH(2).EQ.'Y')GO TO 600
C  AFTER REENTRY OF DATA LIST ONLY THE LINE INPUT (JFLAG=1)
	JFLAG=1
C
C  CHECK FOR VALID CODE
C
	IF (IALPH(1).EQ.'N'.AND.IALPH(2).EQ.'A') GO TO 100
	IF (IALPH(1).EQ.'T'.AND.IALPH(2).EQ.'G') GO TO 140
	IF (IALPH(1).EQ.'S'.AND.IALPH(2).EQ.'L') GO TO 160
	IF (IALPH(1).EQ.'D'.AND.IALPH(2).EQ.'T') GO TO 200
	IF (IALPH(1).EQ.'C'.AND.IALPH(2).EQ.'L') GO TO 300
	IF (IALPH(1).EQ.'M'.AND.IALPH(2).EQ.'X') GOTO 360
749	WRITE(ITYP,750)
750	FORMAT(1H ,'**ILLEGAL CODE ENTERED**TRY AGAIN**')
C
C  LIST EDIT CODE OPTIONS
C
760	WRITE(ITYP,770)
770	FORMAT(/1X,'LEGAL OPTIONS ARE:  NA, TG, SL, DT, CL, MX'/
     1	1X,'             PLUS: TY TO LIST ALL'/
     2	1X,'                   OP TO LIST OPTIONS'/
     3	1X,'                   OK TO TERMINATE EDIT')
	GOTO 700
C*******************************************************************
C     WRITE CALIB FILE (JFLAG = 0,1) TO ID
C     PRINT CALIB FILE TO IPRT
C*******************************************************************
800	IF(JFLAG.EQ.2) GO TO 999
	WRITE(ITYP,810)
810	FORMAT(1H0,
     * 'WRITE/PRINT SPECIFICATION FILE? (Y/N/W) DEFAULT=Write only')
	READ (IRD,820)IALPH(1)
820	FORMAT(A1)
	IF (IALPH(1).EQ.'N') GO TO 999
	REWIND ID
	WRITE(ID,830)(ISPEC(J),J=1,64),(ICALIB(L),L=1,6),
     *	(XCALIB(K),K=1,6),(XMAT(M),M=1,15)
   	IF (IALPH(1).EQ.'Y') THEN
     	  WRITE(IPRT,831) (ISPEC(J),J=1,64),(ICALIB(L),L=1,6),
     *	  (XCALIB(K),K=1,6), (XMAT(M),M=1,15)
831	 FORMAT(1H0,64A2/1X,6I1,F10.3,5E16.8/1X,8E16.8/1X,7E16.8)
	  CLOSE(UNIT=IPRT,DISP='PRINT/DELETE')
	ENDIF
830	FORMAT(64A2/6I1,F10.3,5E16.8/8E16.8/7E16.8)
C
C  PROGRAM COMPLETION
C
	WRITE(ITYP,9999) ID
9999	FORMAT(/1X,'FILE "CONFIG.DAT" WRITTEN TO LOGICAL UNIT ',I2)
999	CLOSE(ID)
	RETURN
	END

	FUNCTION READX(IWORD,N,NP,NTTYI,NTTYO,IEOF)
C
C   THIS ONLY SERVES TO INTERPRET DELIMITERS IN THE DATALIST
C   THIS HOUSEKEEPING IS NORMALLY DONE BY THE SYSTEM AND
C   IS ACTUALLY UNNECESSARY ON THE PDP-11
C   IT WAS, HOWEVER, NEEDED ON THE NBS SYSTEM AND IS RETAINED HERE
C
C $$$$$$$$$$  VERSION OF MAR 9,1977 $$$$$$$$$$
C
C  FUNCTION READX USUALLY RETURNS THE NEXT DECIPHERIBLE NUMBER ON THE
C    INPUT FILE =NTTYI= AS THE VALUE OF THE VARIABLE READX.
C    ANY OUPUT, SUCH AS ERROR MESSAGES OR THE PROMPT CHARACTER,
C    IS ON UNIT NTTYO.
C
C  IW= ALPHANUMERIC INFORMATION OF THE FIRST 1 OR 2 ILLEGAL NON-NUMERICAL
C    INFORMATION ON INPUT FILE NTTYI.
C  N=0 MEANS NUMERICAL INFORMATION SUCCESSFULLY PROCESSED.
C  N=1 CHECK IW WORD FOR NON-NUMERICAL INFORMATION.
C        (READX=1. IN THIS CASE).
C  NP=1  SEND ! AS A PROMPT CHARACTER WHEN NEW RECORD REQUIRED.
C NP=2  READ NEW RECORD.     NP=4  RE-READ WITH START & STOP
C NP=3  OTH OF ABOVE.       NP=5  READ WITH START & STOP TO READER.
C  NTTYI=  INPUT UNIT
C  NTTYO=  OUTPUT UNIT FOR PROMPT CHARACTER AND ERROR MESSAGES.
C  IEOF=0   END OF FILE NOT YET REACHED ON UNIT NTTYI.
C  IEOF=1  END OF FILE FOUND ON NTTYI.
C
C  ILLEGAL INFORMATION:
C
C  IF FIRST CHARACTER IS NOT A BLANK, COMMA, POINT, MINUS, OR
C    A NUMBER, THE FIRST 2 ILLEGAL CHARACTERS ARE RETURNED IN =IW=.
C
C  LEGAL INFORMATION*
C
C  LEADING BLANKS ARE IGNORED.
C  LEADING COMMAS ARE IGNORED.
C  DECIMAL POINTS AND EXPONENTIAL TYPE NUMBERS ARE TREATED CORRCECTLY.
C  $ ON THE INPUT FILE IS PRESUMED TO PRECEED AN IN-LINE COMMENT AND
C    CAUSES READING OF A NEW RECORD.
C  NUMBERS ARE TERMINATED BY A BLANK, COMMA, OR BY THE END OF A RECORD.
C
C
C  READX WAS ORIGINALLY WRITTEN BY FRANK MCCRACKIN (NBS) AND WAS MODIFIED
C    BY FRED MOPSIK AND BY BRIAN DICKENS.  (JAN 1977)
C
C
C
	IMPLICIT INTEGER*2 (I-N)
	INTEGER BRANCH
	INTEGER*2 CD,DEC,IW2,N1,J,IEXP,IEXP1
	LOGICAL ISIGNE
	DIMENSION CD(80),DEC(10),TEN(10),TENTEN(10)
	DATA DEC/'0','1','2','3','4','5','6','7','8','9'/
	DATA TEN/1.,1.E1,1.E2,1.E3,1.E4,1.E5,1.E6,1.E7,1.E8,1.E9/
	DATA TENTEN/1.,1.E10,1.E20,1.E30,1.E38,1.E38,1.E38,3*1.E38/
	DATA N1/81/
	IF (NP.EQ.2.OR.NP.EQ.3) N1 = 81
	IF(NP.EQ.5) N1=81
	IEOF = 0
	N = 0
	SIGN = 1.
	X = 0.
	Y = 1.
	YJ = 0.
C
C   FIND FIRST CHARACTER
C
15	IF (N1.GT.80) GO TO 1000
	IF (CD(N1).EQ.'$') GO TO 1000
	ASSIGN 16 TO BRANCH
	GO TO 2000
16	GO TO (40,100,30,20,20,300),IP
20	N1 = N1+1
	GO TO 15
C   SET SIGN
30	SIGN = -1.
	N1 = N1+1
	GO TO 15
C
C   CALCULATE NUMBER
C
40	X = J
50	N1 = N1+1
	IF (N1.GT.80) GO TO 270
	IF (CD(N1).EQ.'E') GO TO 50
	ASSIGN 70 TO BRANCH
	GO TO 2000
70	GO TO (75,100,205,200,270,270),IP
75	X = X*10.+J
	GO TO 50
C
C   CALCULATE FRACTION
C
100	CONTINUE
110	N1 = N1+1
	IF (N1.GT.80) GO TO 270
	IF (CD(N1).EQ.'E') GO TO 110
	ASSIGN 125 TO BRANCH
	GO TO 2000
125	GO TO (130,3055,205,200,270,270),IP
130	YJ = 10.*YJ+J
	Y = 10.*Y
	GO TO 110
C
C   CALCULATE EXPONENT IEXP
C
200	ISIGNE = .FALSE.
	IEXP = 1
	IEXP1 = 1
	GO TO 210
205	ISIGNE = .TRUE.
	IEXP = 1
	IEXP1 = 1
210	N1 = N1+1
	IF (N1.GT.80) GO TO 250
	ASSIGN 220 TO BRANCH
	GO TO 2000
220	GO TO (230,250,250,250,250,250),IP
230	IEXP1 = IEXP
	IEXP = J+1
	GO TO 210
250	IF (ISIGNE) GO TO 260
	READX = SIGN*(X+YJ/Y)*TEN(IEXP)*TENTEN(IEXP1)
	N = 0
	RETURN
260	READX = SIGN*(X+YJ/Y)/(TEN(IEXP)*TENTEN(IEXP1))
	N = 0
	RETURN
270	READX = SIGN*(X+YJ/Y)
	N = 0
	RETURN
C
C   RETURN ALPHA ARG
C
300	IW2 = CD(N1)
	N1 = N1+1
	ENCODE(2,310,IWORD) IW2,CD(N1)
310	FORMAT(2A1)
302     N1=N1+1
	N=1
	READX = 1.
	RETURN
3055	WRITE (NTTYO,3056)N1
3056	FORMAT(' 2D . AT COL.',I3)
	GO TO 270
1000	N1 = 1
	IF (NP.EQ.1.OR.NP.EQ.3) WRITE (NTTYO,1020)
1020	FORMAT($' !')
	IF(NP.EQ.4 .OR. NP.EQ.5) WRITE(NTTYO,1021)
1021	FORMAT('  ')
	READ (NTTYI,1010,END = 9000) CD
1010	FORMAT(80A1)
	IF(NP.EQ.4 .OR. NP.EQ.5) WRITE(NTTYO,1023)
1023	FORMAT('  ')
	GO TO 15
C
C   CHARACTER INTERP. ROUTINE
C
2000	DO 2010 J = 1,10
	IF (CD(N1).EQ.DEC(J)) GO TO 2020
2010	CONTINUE
	IP = 6
	IF (CD(N1).EQ.'.') IP = 2
	IF (CD(N1).EQ.'-') IP = 3
	IF (CD(N1).EQ.'+') IP = 4
	IF (CD(N1).EQ.' ' .OR. CD(N1).EQ.',') IP = 5
	IF(CD(N1).EQ.' ') IP = 5
	GO TO 2030
2020	IP = 1
	J = J-1
2030	GO TO BRANCH
9000	IEOF = 1
	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 /IOCFG/	NBS,		IDT,		ICLOCK,
     1	ISPEC,		IRD,		IPRT,		ITYP,
     2	IDISK(2),	IFIN,		IFOUT
C
C***********************************************************************
C
C  BLOCK DATA INITILIZATION OF COMMON /IOCFG/
C
	DATA NBS,IDT,ICLOCK,ISPEC,IRD,IPRT,ITYP,IDISK,IFIN,IFOUT
     1	/1,2,3,4,5,7,6,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		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 /IOCFG/	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
