	IMPLICIT REAL*8(A-H,O-Z)
C
C  CUBIC 2-THETA AND HKL FINDER
C
	INTEGER H
	DIMENSION T1(1000),D1(1000),I1(1000),I2(1000),I3(1000)
	WAVE = 1.5405981
	RTD = 3.141592654 / 180.
	WRITE(6,1000)
1000	FORMAT(/' CUBIC HKL AND 2 THETA COMPUTATION FOR INTCAL'//
     1' INPUT THE LATTICE PARAMETER: ')
	READ(5,1010)A
1010	FORMAT(G)
	WRITE(6,1011)
1011	FORMAT(/' INPUT hk and l MAXIMUM VALUES')
	READ(5,1012)JM,KM,LM
1012	FORMAT(3I3)
	WRITE(6,1013)
1013	FORMAT(3X,'H  K  L    2-THETA     D')
	N = 0
	DO 200 L=1,LM
	DO 200 K=0,KM
	DO 200 H=0,JM
C
C  TEST FOR F CENTERING CONDITION
C
C	J = JMOD(H,2) + JMOD(K,2) + JMOD(L,2)
C	IF(J.EQ.0.OR.J.EQ.3)GO TO 100
C	GO TO 200
C
C  TEST FOR I CENTERING
C
C	J = JMOD(H+K+L,2)
C	IF(J.NE.0)GO TO 200
100	D = SQRT(A**2 / (H**2 + K**2 + L**2))
	T2 = WAVE / (2.0 * D)
	IF(T2.GT.1.0)GO TO 200
C
C  HAS THIS D ALREADY BEEN FOUND?
C
	IF(N.EQ.0)GO TO 160
	DO 150 I=1,N
	IF(D1(I).EQ.D)GO TO 200
150	CONTINUE
160	N = N + 1
	IF(N.GT.1000)GO TO 250
	D1(N) = D
	I1(N) = H
	I2(N) = K
	I3(N) = L
	T2 = ASIN( T2 ) / RTD * 2.0
	T1(N) = T2
200	CONTINUE
250	DO 220 I=1,N-1
	DO 220 J=I+1,N
	IF(D1(I).GT.D1(J))GO TO 220
	T = D1(I)
	D1(I) = D1(J)
	D1(J) = T
	T = T1(I)
	T1(I) = T1(J)
	T1(J) = T
	IT = I1(I)
	I1(I) = I1(J)
	I1(J) = IT
	IT = I2(I)
	I2(I) = I2(J)
	I2(J) = IT
	IT = I3(I)
	I3(I) = I3(J)
	I3(J) = IT
220	CONTINUE
	DO 300 I=1,N
	WRITE(6,1020)I1(I),I2(I),I3(I),T1(I),D1(I)
1020	FORMAT(1X,3I3,2F10.5)
300	CONTINUE
	WRITE(50,1040)(T1(I),I=1,N)
1040	FORMAT(100(5X,'1',7(F8.4,',')/))
	CALL EXIT
	END
