C23456789012345678901234567890123456789012345678901234567890123456789012
************************************************************************
*       PROGRAM TO SELECT REFLECTIONS FOR PSI DATA COLLECTION          *
************************************************************************
	CHARACTER*1 FILE1*12,OPT
	COMMON/ABS1/ WAVE,R11,R12,R13,R21,R22,R23,R31,R32,R33
	WRITE(*,*)' PLEASE TYPE FULL NAME OF THE INPUT FILE:'
	READ(*,'(A12)')FILE1
	OPEN(UNIT=1,STATUS='OLD',FILE=FILE1,ERR=10,FORM='FORMATTED')
	GOTO 11
10      WRITE(*,*)'  FILE OPEN ERROR !!!'
	STOP
11      CONTINUE
	WRITE(*,*)' PLEASE INPUT MINIMUM CHI CUTOFF (DEFAULT=80):'
	READ(*,'(F5.0)',ERR=11)CUT
	IF(CUT.EQ.0.0.OR.CUT.GE.90.0) CUT=80.0
	CALL ACS1
	WRITE(*,*)' '
101     WRITE(*,*)' DO YOU WANT TO SEARCH H,-K,L OCTANT?(Y/N)'
	READ(*,'(A1)')OPT
	IF(OPT.EQ.'Y') OPT1=1
	IF(OPT.EQ.'N') OPT1=0
	IF(OPT.NE.'Y'.AND.OPT.NE.'N') GOTO 101
102     WRITE(*,*)' DO YOU WANT TO SEARCH H,K,-L OCTANT?(Y/N)'
	READ(*,'(A1)')OPT
	IF(OPT.EQ.'Y') OPT2=1
	IF(OPT.EQ.'N') OPT2=0
	IF(OPT.NE.'Y'.AND.OPT.NE.'N') GOTO 102
103     WRITE(*,*)' DO YOU WANT TO SEARCH H,-K,-L OCTANT?(Y/N)'
	READ(*,'(A1)')OPT
	IF(OPT.EQ.'Y') OPT3=1
	IF(OPT.EQ.'N') OPT3=0
	IF(OPT.NE.'Y'.AND.OPT.NE.'N') GOTO 103
	WRITE(*,1007)
 1007   FORMAT(/1X,'    H    K    L',5X,'NPI',3X,'  LB   COUNT ',
     1  '  RB   ',2X,'  INT  ',2X,'  CHI  ',2X,'THETA'/)
	CALL ACS2(CUT,OPT1,OPT2,OPT3)
	STOP ' '
	END
************************************************************************
	SUBROUTINE ACS1
	COMMON/ABS1/ WAVE,R11,R12,R13,R21,R22,R23,R31,R32,R33
	WAVE=0.71073
1       READ(1,10,ERR=1)NUM,R11,R12,R13,R21,R22,R23
 10     FORMAT(I6,3F9.0,2X,3F9.0)
	IF(NUM.NE.31) GOTO 1
2       READ(1,10,ERR=2)NUM,R31,R32,R33
	IF(NUM.NE.32) GOTO 2
C        WRITE(*,'(3F11.6)')R11,R12,R13,R21,R22,R23,R31,R32,R33
	REWIND 1
	RETURN
	END
************************************************************************
	SUBROUTINE ACS2(CUT,OPT1,OPT2,OPT3)
	INTEGER H,K,L,RB
	REAL KAPPA
	RTD=57.29577951
	DTR=1.0/RTD
	SINA=SIN(50.0*DTR)
	NUM=0
99      READ(1,1102,ERR=99,END=2000)H,K,L,PPHI,NPI,LB,INT,RB
 1102   FORMAT(10X,3I5,7X,F7.2,1X,I3,I6,I7,I6)
	IF(NPI.EQ.0.AND.INT.EQ.0) GOTO 99
	READ(1,*,ERR=99,END=2000)NDUM,NDUM1,THETA,PPSI,OMK,KAPPA
	FFF=(INT-2.0*(LB+RB))/(1.0*NPI)
 1100   CONTINUE
C        CHI=2.0*RTD*ASIN(SINA*SIN(KAPPA*DTR*0.5))
	CALL ANGLE(H,K,L,CHI)
	IF(NPI.GT.10.OR.FFF.LT.100) GOTO 99
	IF(ABS(CHI).LT.CUT) GOTO 1200
	WRITE(*,1008)H,K,L,NPI,LB,INT,RB,FFF,CHI,THETA
 1008   FORMAT(1X,3I5,5X,I3,2X,I6,I7,I6,2X,F8.0,2X,F7.2,2X,F6.2)
	NUM=NUM+1
1200    CONTINUE
	IF(NUM.GE.20) GOTO 1500
	IF(OPT1.EQ.1.AND.K.NE.0) THEN
	LK=-K
	CALL ANGLE(H,LK,L,CHI)
	IF(ABS(CHI).LT.CUT)  GOTO 1201
	WRITE(*,1008)H,LK,L,NPI,LB,INT,RB,FFF,CHI,THETA
	NUM=NUM+1
	ELSE
	ENDIF
1201    CONTINUE
	IF(OPT2.EQ.1.AND.L.NE.0) THEN
	LL=-L
	CALL ANGLE(H,K,LL,CHI)
	IF(ABS(CHI).LT.CUT)  GOTO 1202
	WRITE(*,1008)H,K,LL,NPI,LB,INT,RB,FFF,CHI,THETA
	NUM=NUM+1
	ELSE
	ENDIF
1202    IF(OPT3.EQ.1.AND.K.NE.0.AND.L.NE.0) THEN
	LK=-K
	LL=-L
	CALL ANGLE(H,LK,LL,CHI)
	IF(ABS(CHI).LT.CUT)  GOTO 99
	WRITE(*,1008)H,LK,LL,NPI,LB,INT,RB,FFF,CHI,THETA
	NUM=NUM+1
	ELSE
	ENDIF
	GOTO 99
1500    CONTINUE
	WRITE(*,*)' DO YOU WANT TO CONTINUE?(Y/N):'
	READ(*,'(A1)')OPT
	NUM=0
	IF(OPT.EQ.'Y') GOTO 1200
	IF(OPT.NE.'N') GOTO 1500
2000    CONTINUE
	STOP ' '
	END
************************************************************************
	SUBROUTINE ANGLE(H,K,L,CHI)
	INTEGER H,K,L
	COMMON/ABS1/ WAVE,R11,R12,R13,R21,R22,R23,R31,R32,R33
	RTD=57.29577951
	DTR=1.0/RTD
	XP=H*R11+K*R12+L*R13
	YP=H*R21+K*R22+L*R23
	ZP=H*R31+K*R32+L*R33
	D=SQRT(XP*XP+YP*YP+ZP*ZP)
	STETA=0.5*WAVE*D
	TETA=ASIN(STETA)*RTD
	RP=SQRT(XP*XP+YP*YP)
	CHI=ATAN2(ZP,RP)*RTD
	RETURN
	END
************************************************************************