C PROGRAM TO INDEX CUBIC POWDER PATTERNS
	CHARACTER*40 NFILE, MFILE
      DIMENSION THET2(200),D(200),DS(200),DSS(200),INTEN(200),
     1 DELTA(200),HKL(200)
      RAD=6.283184/360.
      ITYP = 6
      IREAD = 5
      WRITE(ITYP,1)
    1 FORMAT(//' Program to Index Cubic Powder Patterns'//)
C
C  GET THE INPUT FROM THE GENERAL INPUT d-I FILE FORMAT
C
	CALL ADRIN(D, THET2, INTEN, N, NFILE)
C
C  OUTPUT TO A FILE OR TERMINAL?
C
	WRITE(ITYP,10)
10	FORMAT(/'$List output on <0> terminal, <1> a file :')
	IO30 = 6
	READ(IREAD,20)IO
20	FORMAT(I)
	IF(IO .EQ. 0)GO TO 70
	IO30 = 30
C
C  GET NAME OF THE FILE
C
	DO 30 I=1,13
	IF(NFILE(I:I) .EQ. '.')GO TO 40
30	CONTINUE
40	NFILE(I+1:I+3) = 'CUB'
	WRITE(ITYP,50)NFILE(1:13)
50	FORMAT(/'$Enter the name of the output file (default=',A13,'):')
	READ(IREAD,60)MFILE
60	FORMAT(A40)
	IF(MFILE(1:4) .NE. '    ')NFILE = MFILE
C
C  OPEN THE ADR FILE
C
	OPEN(UNIT=IO30, NAME=NFILE, TYPE='NEW',FORM='FORMATTED')
70      HOLD = 0.0
      SMALL = 1E30
      DO 80 I = 1,N
	DS(I) = 1.0/D(I)
      DSS(I) = DS(I)*DS(I)
      DELTA(I) = DSS(I) - HOLD
      IF(SMALL.GT.DELTA(I))SMALL = DELTA(I)
      HOLD = DSS(I)
80	CONTINUE
      ICNT = 0
      SUM = 0.0
      DO 90 I = 1,N
      IF(SMALL+.01.LT.DELTA(I)) GO TO 90
      ICNT = ICNT + 1
      SUM = SUM + DELTA(I)
90	CONTINUE
      SMALL = SUM/ICNT
      ICNT = 1
      ASS = SMALL
      IFLAG = 0
	JFLAG = 0
100	DO 110 I=1,N
      HKL(I) = DSS(I)/SMALL
      AJ = INT(HKL(I) + .5)
      IF(AJ+.20.LT.HKL(I).OR.AJ-.20.GT.HKL(I)) IFLAG = 1
110	CONTINUE
      A = 1./SQRT(SMALL)
      WRITE(IO30,120) SMALL, A
120	FORMAT(/' a* squared = ',F10.6/' a = ',F10.4,
     1' angstroms'///
     2'   2-theta     d        d*       d* sqr    delta       n')
      DO 140 I = 1,N
      WRITE(IO30,130)THET2(I),D(I),DS(I),DSS(I),DELTA(I),HKL(I)
130	FORMAT(2F10.4,3F10.6,F10.3)
140	CONTINUE
      IF(IFLAG.EQ.0) GO TO 905
      ICNT = ICNT + 1
      IF(ICNT .GE. 4)GO  TO 900
      WRITE(IO30,150)ICNT
150	FORMAT(//' Solution after dividing (a*)**2 by',I3,':')
      SMALL = ASS/ICNT
      GO TO 100
900	IF( JFLAG .GT. 0)GO TO 920
905	WRITE(IO30,910)
910	FORMAT(//' Examine these solutions for trends in the delta d* ',
     1' squared column.  The least'/' common denominator of d*',
     2' squared will be a* squared, if the system is cubic.'//
     3' WARNING: The computer always picks the lowest delta d* squared.',
     4/' A false peak (eg a beta line) or a systematic shift in 2-',
     5'theta'/' will cause this value to be',
     5' incorrect - making the solution appear false.')
	JFLAG = 1
	ICNT = 4
	IFLAG = 1
920	WRITE(ITYP,930)
930	FORMAT(//'$Try another',
     6' value for a* squared (or return to exit): ')
	READ(IREAD,940)SMALL
940	FORMAT(G)
	IF(SMALL .GT. 0.0)GO TO 100
999	CALL EXIT
      END

       SUBROUTINE ADRIN( DUNK, THUNK, INUNK, NUMDI, NFILE)
C
C  THIS IS A GENERAL SUBROUTINE READ TO THE d-I INFORMATION
C  FROM AN ADR FILE. THE ADR INPUT FORMAT FOR SIEMENS FILES IS:
C  RECORD  1: BLANK
C  RECORD  2: BLANK
C  RECORD  3: BLANK
C  RECORD  4: ADR HEADER RECORD
C  RECORD  5: ALFRED UNIVERSITY HEADER RECORD
C  RECORD  6: DATE AND TIME OF PROCESSESING WITH ADR
C	(1X,'DATE:',1X,9A1,5X,'TIME: ',1X,8A1)
C	FOR INPUT: (7X,9A1,12X,8A1)
C  RECORD  7: OUTPUT FILE NAME
C	(' OUTPUT FILE NAME:'40A1) - (18X,10A1)
C  RECORD  8: TITLE OF RUN
C	('TITLE OF RUN:',80A1) - (13X,80A1)
C  RECORD  9: DATE OF RUN
C	(' DATE OF RUN: ',9A1) - (14X,9A1)
C  RECORD 10: BLANK
C  RECORD 11: STARTING ANGLE AND COUNT TIME (17X,F9.4,4X,F7.2)
C  RECORD 12: ENDING ANGLE AND X SIGMA (17X,F9.4,4X,F7.2)
C  RECORD 13: ANGLE INCREMENT AND Y SIGMA (17X,F9.4,4X,F7.2)
C  RECORD 14: POINTS FOR SMOOTH AND MAXIMUM FWHM
C  RECORDS 15-?: EXTRA RUN PARAMETERS
C  RECORD 16: d-I HEADER
C	(' PEAK',....)
C  RECORD 17: PK. #, 2-THETA, *, d, RELI, DELTA d, ABS I, FWHM
C	(1XI3,1XF9.4,A1,F8.3,F8.2,10X,F6.4,F9.1,F9.4)
C  OPTIONAL INFO ON d-I RECORD: IN PLACE OF 10X - hkl's in 3I3,1X
C
	CHARACTER*40 NFILE
	CHARACTER*1 IDOT, IBL, NAST, IAST
	CHARACTER*80 TITLE
	DIMENSION DUNK(200), THUNK(200), INUNK(200), IT(2), IPE(2)
	DATA IO5,IO6,IO7,IO10,IO20,IO30/5,6,6,10,20,30/
	DATA IDOT, IBL, IAST, IPE/'.', ' ', '*','PE','AK'/
C
C   INITIALIZE NUMDI - ZERO MEANS NO DATA ON FILE OR NO SUCH FILE
C
	NUMDI = 0
C
C  ALFRED OR SIEMENS FORMAT?
C
	WRITE(IO7,530)
530	FORMAT(/' Input must be from a d-I file.  If your d''s and',
     1' I''s are not',/' on a file exit this program and ',
     2'RUN XRAY:FILMOD OR XRAY:VAXCONVto create'/
     1' the required file',
     1' from typed input.  The normal format is Siemens'//
     1 ' ENTER your d-I file type: '/
     1 ' <0>=Diffrac 11 (Default), <1>=',
     1 'Alfred, <2>=Siemens, <3>=EXIT: ')
	READ(IO5,535) IFMT
535	FORMAT(I)
	IF(IFMT .GE. 3)STOP 'TYPE RUN POWD:[POWDER.GENRAL]FILMOD'
        IFMT = 3
	IF(IFMT .EQ. 1) IFMT = 2
	IF(IFMT .EQ. 2) IFMT = 1
C
C  GET NAME OF THE FILE
C
	WRITE(IO7,540)
540	FORMAT(/'$Enter the name of the ADR d-I file :')
	READ(IO5,550)NFILE
550	FORMAT(A40)
C
C  OPEN THE DIFFRAC 11 FILE
C
       IF(IFMT .NE. 3)GO TO 5555
       NTIN = IO30
       OPEN ( UNIT=NTIN, NAME=NFILE, TYPE='OLD', 
     +	  SHARED,READONLY, FORM='UNFORMATTED', ACCESS='DIRECT', 
     &    RECORDSIZE=1, ASSOCIATEVARIABLE=NEXT)
C  Read title, operator, time & date
	NEXT=1
	DO 9110,I=1,45,4
9110	READ(NTIN'NEXT) TITLE(I:I+3)
	TITLE(26:28)='   '
	DO 9120,I=1,18
	 IF(' '.LE.TITLE(I:I) .AND. TITLE(I:I).LE.'~') GOTO 9120
C  Non ascii garbage detected in first twelve
C  records so this is not Diffrac-11 format.
	 WRITE(6,9101)
9101	FORMAT(' File not in Diffrac 11 format!')
       CALL EXIT
C
C  Read number of peaks
9120	READ(NTIN'13) ALO
	READ(NTIN'14) AHI
	READ(NTIN'15) STEP
	READ(NTIN'16) TIME
	READ(NTIN'19) PWL
	READ(NTIN'21) NUMDI
	NEXT = 41
C
C  READ DIFFRAC 11 FORMAT
C
        DO 5002 I=1,NUMDI
	READ(NTIN'NEXT) DUNK(I)
	READ(NTIN'NEXT) AINT
     	INUNK(I) = AINT
        THUNK(I) = ASIN(PWL / (2.*DUNK(I)) ) / 0.017453293 
	NEXT = NEXT + 4
5002    CONTINUE
       	GO TO 830
C
C  OPEN THE ADR FILE
C
5555	OPEN(UNIT=IO30, NAME=NFILE, TYPE='OLD',FORM='FORMATTED',
     1 READONLY)	
C
C  SKIP OFF THE FIRST SEVEN BLANK RECORDS
C
	DO 556 I=1,7
556	READ(IO30,555)
555	FORMAT(1X)
C
C  READ HEADER RECORDS AND GET THE TITLE
C
	GO TO (560,580), IFMT
560	READ(IO30,570,END=710) TITLE
570	FORMAT(11X,A80)
	GO TO 600
580	READ(IO30,590,END=710) TITLE
590	FORMAT(12X,A80)
C
C  SKIP THE NEXT TWO RECORDS
C
600	READ(IO30,555)
	READ(IO30,555)
C
C  GET SCAN LIMITS AND MEAS. CONDITIONS.
C
	GO TO (610,630), IFMT
610	READ(IO30,620,END=710) ALO,TIME,AHI,STEP
620	FORMAT(17X,F8.4,19X,F6.1/16X,F9.4/17X,F8.4)
	GO TO 650
630	READ(IO30,640,END=710) ALO,TIME,AHI,STEP
640	FORMAT(18X,F8.4,19X,F6.1/17X,F9.4/18X,F8.4)
C
C  SEARCH FOR THE RECORD WITH "PEAK" STARTING IN COLUMN 1 OR 2
C
650	DO 700 I=1,50
	GO TO (660,680), IFMT
660	READ(IO30,670,END=710)(IT(J),J=1,2)
670	FORMAT(2A2)
	GO TO 695
680	READ(IO30,690,END=710) (IT(J),J=1,2)
690	FORMAT(1X,2A2)
695	IF( IT(1).EQ.IPE(1) .AND. IT(2).EQ.IPE(2) )GO TO 750
700     CONTINUE
C
C **	FILE IN WRONG FORMAT
C
710	STOP ' ????? File in wrong format'
C
C  FILE IS IN CORRECT FORMAT
C
C  READ THE TWO-THETA AND INTENSITIES
C
750	GO TO (760,780),IFMT
760	READ(IO30,770,END=830) THETA,NAST,TEMP0,TEMP1
770	FORMAT(3X,1XF9.5,A1,1XF7.4,1XF7.2,16X,F9.1,F9.4)
	GO TO 800
780	READ(IO30,790,END=830) THETA,NAST,TEMP0,TEMP1
790	FORMAT(4X,1XF9.5,A1,1XF7.4,1XF7.2,16X,F9.1,F9.4)
800	IF( TEMP0 .EQ. 0 )GO TO 830
C
C  ELIMINATE ALPHA 2 PEAK FROM INPUT LIST
C
        IF(IAST.EQ.NAST)GO TO 750
	NUMDI = NUMDI + 1
	THUNK(NUMDI) = THETA
	DUNK(NUMDI) = TEMP0
	INUNK(NUMDI) = TEMP1 + 0.5
	IF( NUMDI .LT. 200 )GO TO 750
        WRITE(IO7,810)
810    FORMAT(/1X,'Input d-I list truncated to 200 values')
830	RETURN
        END

