C   DATLST
C                       INSTRUCTIONS
C                       ------------
C   DESCRIPTION OF DATLST, VERSION OF 9 OCTOBER, 1964, REVISED FOR 6600
C   ON 15 AUGUST, 1966.
C    REVISED FOR XDS SIGMA 5 6/72
C
C        DATLST IS A GENERAL PROGRAM DESIGNED TO PRODUCE A LIST OF POSSI
C   REFLECTIONS, TOGETHER WITH (SIN THETA/LAMBDA) AND , IF DESIRED , THE
C   THE WEISSENBERG EQUI-INCLINATION LP FACTOR IN AN ORDER CHOSEN BY THE
C   ITS SPECIFIC OUTPUT FORMAT INCLUDES SPACES ON WHICH TO RECORD THE IN
C   -S FROM FIVE (5) MULTIPLE FILMS.  EACH REFLECTION IS ASSIGNED A NUMB
C     AND THERE IS AN OPTION IN THE PROGRAM TO PUNCH OUT CARDS H,K,L. ON
C   PUNCHED CARDS THE REFLECTION NUMBER APPEARS AT THE FAR RIGHT AND SHO
C   AID THE KEYPUNCHER IN KEEPING THE CORRECT INTENSITIES ON THE
C   CORRESPONDING CARDS.
C
C   THE PROGRAM CONSISTS OF THE MAIN PROGRAM -DATLST- TOGETHER WITH THRE
C   SUBROUTINES- ROTATE, ROTE, AND REJECT-.
C
C
C
C   ***INPUT DATA***
C   ----------------
C   ----------------
C   CARD 1 $   FORMAT (12A6) $   ANY DESIRED HOLLERITH INFORMATION  .
C
C   CARD 2$ FORMAT (6F10.6) $ CELL CONSTANTS A,B,C,COS ALPHA,COS BETA, C
C
C   CARD 3   $    FORMAT    (2F10.5,  2I10)      $
C       COLUMNS 1-10  WAVELENGTH OF RADIATION USED (W).
C        COLUMNS 11-20  THE MAXIMUM BRAGG ANGLE (TMAX), IN DEGREES ,
C                       WITHIN WHICH ONE WANTS THE REFLECTIONS LISTED.
C        COLUMN 30   IPCH    = 0 NO PUNCHED CARD OUTPUT,PRINTED OUTPUT
C                            = 1 PUNCHED CARD OUTPUT,NO PRINTED OUTPUT
C                            = 2  BOTH PUNCHED AND PRINTED OUTPUT.
C        COLUMN 40  LP  , IF PUNCHED WITH A NON-ZERO NUMBER IT WILL PRIN
C                         WEISSENBERG EQUI-INCLINATION FACTOR.
C
C   CARD 4$ FORMAT (6I1)  $ J1,K1,L1,,M1,M2,M3.
C             J1,K1,L1 DETERMINE THE RANGE OF H,K,L, RESPECTIVELY.
C             THUS, PUNCH J1=0 FOR VALUES FROM 0 TO HMAXIMUM AND PUNCH J
C             VALUES FROM -HMAXIMUM TO +HMAXIMUM. SIMILARLY FOR K AND L.
C             THE PROGRAM IS WRITTEN SO  THE SLOWEST VARYING INDEX IS AL
C             POSITIVE. HENCE, ONLY 2 OF THESE INTEGERS WILL POSSIBLY BE
C
C             THE INTEGERS M1,M2, AND M3 REFER TO THE SLOWEST, NEXT SLOW
C              AND FASTEST VARYING INDICES.  HERE THE NUMBER 1 REFERS TO
C             2 TO K, AND 3 TO L. THUS, IF M1,M2,M3 IS 123, THEN H VARIE
C             MORE SLOWLY THAN K, AND K VARIES MORE SLOWLY THAN L
C             IF IT IS 231, K VARIES MORE SLOWLY THAN L AND L VARIES MOR
C             THAN H.
C
C   *** OUTPUT DATA ***
C   -------------------
C   -------------------
C   PRINTED OUTPUT-  THE REFLECTION NUMBER,H,K,L,SPACE FOR RECORDING INT
C   TIES FROM 5 FILMS, SIN THETA/LAMBDA, AND IF LP= NON-ZERO, THE LP FAC
C   PUNCHED OUTPUT- H,K,L, THE REFLECTION  NUMBER  IN FORMAT (3I5,60XI5)
C
C
C        THE PROGRAM GENERATES ALL REFLECTIONS WITHIN THE RANGE DETERMIN
C   BY TMAX AND THE CELL CONSTANTS AND LIMITING INTEGERS J1,K1,L,.  FOR
C   REASON A SUBROUTINE  ** REJECT (J,K,L,SL,NRJCT) *** HAS BEEN ADDED T
C   PROGRAM SO THAT THE USER MAY BY WRITING HIS OWN PATCH ELIMINATE ANY
C   REFLECTIONS, E.G. 0K(-L) IN THE MONOCLINIC SYSTEM.  THE PATCH IS CAL
C   BEFORE THE PRINT-OUT AND HENCE IF REFLECTIONS ARE REJECTED THE NUMBE
C   THOSE PRINTED STILLS STAYS CONTINUOUS.  IN THE CALLING SEQUENCE OF T
C   PATCH J,K,L REFER TO THE INDICES AS THEY WOULD BE PRINTED, SL IS,(SI
C   LAMBDA)/2 AND NRJCT DETERMINES WHETHER THE REFLECTION IS KEPT OR NOT
C   WANT TO KEEP THE REFLECTION MAKE NRJCT=0, IF YOU WANT TO REJECT IT M
C   NRJCT=1.
C   A SAMPLE SUBROUTINE USED TO REJECT 0K(-L) IS GIVEN**
C     SUBROUTINE REJECT(J,K,L,SL,NRJCT)
C     IF(J)1,2,1
C   2 IF(L)3,1,1
C   3 NRJCT=1
C     GOTO4
C   1 NRJCT=0
C   4 RETURN
C     END
C
C
C
C                       PROGRAM LISTING
C                       ---------------
C        RECOMPILATION OF  9OCTOBER64 VERSION FOR 6600 - AUGUST 16,1966
CDATLST
	DIMENSION T(12)
	READ  100,(T(J),J=1,12)
100	FORMAT(12A4)
	PRINT 101,(T(J),J=1,12)
101	FORMAT(1H112A4)
	READ  102,A,B,C,CA,CB,CG
102	FORMAT(6F10.6)
	PRINT 103,A,B,C,CA,CB,CG
103	FORMAT(15H0CELL CONSTANTS//3H A=F10.6, 3H B=F10.6, 3H C=F10.6,
	2  11H COS ALPHA=F10.6,  10H COS BETA= F10.6,  11H COS GAMMA=F10.6)
	READ  104,W,TMAX,IPCH,LP
104	FORMAT(2F10.5,2I10)
	PRINT 105,W,TMAX
105	FORMAT(12H0WAVELENGTH=F10.6, 18H MAX BRAGG ANGLE =F10.6)
	IF(IPCH)1,2,1
1	PRINT 106
106	FORMAT(22H0CARDS WILL BE PUNCHED)
2	IF(LP)13,12,13
13	PRINT 111
111	FORMAT(56H0EQUI-INCLINATION WEISSENBERG LP FACTORS WILL BE PRINTED
	2)
12	READ  107,J1,K1,L1,M1,M2,M3
107	FORMAT(6I1)
	PRINT  108,M1,M3
108	FORMAT(15H0SLOWEST INDEX I2,15H FASTEST INDEX I2)
	IJZ=0
	NJ=1
	SA=SQRTF(1.0-CA**2)
	SB=SQRTF(1.0-CB**2)
	SG=SQRTF(1.0-CG**2)
	V=A*B*C*SQRTF(1.0+2.0*CA*CB*CG-CA**2-CB**2-CG**2)
	AS=B*C*SA/V
	BS=A*C*SB/V
	CS=A*B*SG/V
	CAS=(CB*CG-CA)/(SB*SG)
	CBS=(CG*CA-CB)/(SG*SA)
	CGS=(CA*CB-CG)/(SA*SB)
	STOLM=SINF(TMAX/57.2958)/W
	JMAX=2.0*STOLM/AS
	KMAX=2.0*STOLM/BS
	LMAX=2.0*STOLM/CS
	IF(CA )2000,2001,2000
2001	IF(CG )2000,2002,2000
2002	IF(CB )2004,2005,2004
2000	IF(JMAX-10)500,501,501
501	JMAX=JMAX+10
	GO TO 502
500	JMAX=2*JMAX
502	IF(KMAX-10)503,504,504
504	KMAX=KMAX+10
	GO TO 505
503	KMAX=2*KMAX
505	IF(LMAX-10)506,507,507
507	LMAX=LMAX+10
	GO TO 2005
506	LMAX=LMAX*2
	GO TO 2005
2004	IF(JMAX-10)510,511,511
511	JMAX=JMAX+10
	GO TO 512
510	JMAX=2*JMAX
512	IF(LMAX-10)513,514,514
514	LMAX=LMAX+10
	GO TO 2005
513	LMAX=2*LMAX
2005	IF(J1)3,4,3
4	JMIN=0
	GO TO 5
3	JMIN=-JMAX
	IOT=1
	PRINT 9007,IOT
9007	FORMAT( 7H0INDEX I1,17H WILL GO NEGATIVE)
5	IF(K1)6,7,6
7	KMIN=0
	GO TO 8
6	KMIN=-KMAX
	IOT=2
	PRINT 9007,IOT
8	IF(L1)9,10,9
10	LMIN=0
	GO TO 11
9	LMIN=-LMAX
	IOT=3
	PRINT 9007,IOT
11	IF(M1-2)30,31,32
30	IF(M2-2)40,33,34
31	IF(M2-2)35,40,36
32	IF(M2-2)37,38,40
40	PRINT 1116
1116	FORMAT(21H0ERROR IN AXIAL ORDER)
	CALL EXIT
34	CALL ROTATE(BS,CS,CBS,CGS,KMAX,LMAX,KMIN,LMIN)
	GO TO 33
35	CALL ROTATE(AS,BS,CAS,CBS,JMAX,KMAX,JMIN,KMIN)
	GO TO 33
36	CALL ROTATE(BS,CS,CBS,CGS,KMAX,LMAX,KMIN,LMIN)
	CALL ROTATE(AS,CS,CAS,CGS,JMAX,LMAX,JMIN,LMIN)
	GO TO 33
37	CALL ROTATE(AS,CS,CAS,CGS,JMAX,LMAX,JMIN,LMIN)
	CALL ROTATE(BS,CS,CBS,CGS,KMAX,LMAX,KMIN,LMIN)
	GO TO 33
38	CALL ROTATE(AS,CS,CAS,CGS,JMAX,LMAX,JMIN,LMIN)
33	I=-1
	PRINT 110
407	I=I+NJ
	IF(I)700,701,700
701	I= ABSF(I)
700	IF(JMAX-I)201,200,201
201	AJ=I
	SMU=0.5*AJ*W/(BS*CS*SQRTF(1.0-CAS**2)*V)
	IK=1
	NSK=0
	KC=-1
410	DO 300 KK=1,KMAX
	M=IK*(KK-1)-NSK
	AK=M
	IL=1
	NSL=0
	LC=-1
405	DO 301 LL=1,LMAX
	N=IL*(LL-1)-NSL
	AL=N
	L=N
	K=M
	J=I
	SL=0.5*SQRTF((AJ*AS)**2+(AK*BS)**2+(AL*CS)**2+2.0*(AJ*AS)*(AK*BS)*
	2 CGS+2.0*(AJ*AS)*(AL*CS)*CBS+2.0*(AK*BS)*(AL*CS)*CAS)
	IF(STOLM-SL)301,302,302
302	IF(LP)303,304,303
303	SR=W*SL
	COSR=SQRTF(1.0-SR**2)
	PL=4.0*COSR*(SQRTF(SR**2-SMU**2))/(1.0+(1.0-2.0*SR**2)**2)
304	IF(M1-2)630,631,632
630	IF(M2-2)40,633,634
631	IF(M2-2)635,40,636
632	IF(M2-2)637,638,40
634	JJQ=J
	KKQ=L
	LLQ=K
	GO TO 639
635	JJQ=K
	KKQ=J
	LLQ=L
	GO TO 639
636	JJQ=L
	KKQ=J
	LLQ=K
	GO TO 639
637	JJQ=K
	KKQ=L
	LLQ=J
	GO TO 639
638	JJQ=L
	KKQ=K
	LLQ=J
	GO TO 639
633	JJQ=J
	KKQ=K
	LLQ=L
639	CALL REJECT(JJQ,KKQ,LLQ,SL,NRJCT)
	IF(NRJCT)301,139,301
139	JESUS=JESUS+1
	IJZ=IJZ+1
	IF(IJZ-1)9100,9101,9100
9101	NTAG=1
9105	JS=J
	KS=K
	LS=L
	GO TO 9102
9100	IF(J-JS)9103,9104,9103
9103	NTAG=4
	GO TO 9105
9104	IF(K-KS)9107,9108,9107
9107	NTAG=3
	GO TO 9105
9108	IF(L)9109,9101,9101
9109	IF(LS)9101,9110,9110
9110	NTAG=2
	GO TO 9105
9102	IF(M1-2)130,131,132
130	IF(M2-2)40,133,134
131	IF(M2-2)135,40,136
132	IF(M2-2)137,138,40
134	CALL ROTE(K,L)
	GO TO 133
135	CALL ROTE(J,K)
	GO TO 133
136	CALL ROTE(K,L)
	CALL ROTE(J,K)
	GO TO 133
137	CALL ROTE(J,L)
	CALL ROTE(K,J)
	GO TO 133
138	CALL ROTE(J,L)
133	IF(IPCH-1)807,400,807
807	IF(JMAX-I)8005,200,8005
200	PRINT 109,JESUS
109	FORMAT(30H0TOTAL NUMBER OF REFLECTIONS = I4)
	IF(IPCH-1)9008,8001,9008
8001	CALL EXIT
9008	PRINT 110
	NN=0
	NTAG=5
8005	IF(NTAG-5)9111,9112,9111
9112	CALL EXIT
9111	IF(NTAG-1)9113,9113,9114
9113	IF(NN-47)9115,9115,9116
9116	NN=0
	PRINT110
9115	PRINT 112,JESUS,J,K,L,SL,PL
112	FORMAT(I5,2X3I3,31H+     +     +     +     +     +F8.5,F9.5)
	PRINT 113
113	FORMAT(47H                +     +     +     +     +     +)
	NN=NN+2
	GO TO 400
9114	IF(NTAG-3)9117,9118,9116
9117	NN=NN+2
	PRINT 115
115	FORMAT(1H0)
	GO TO 9113
9118	NN=NN+4
	PRINT 119
119	FORMAT(1H0/1H0)
	GO TO 9113
400	IF(IPCH-1)301,8002,8002
8002	PUNCH114,J,K,L,JESUS
114	FORMAT(3I5,60XI5)
301	CONTINUE
	LC=LC+1
	IF(LC)300,601,300
601	IF(LMIN)403,300,403
403	IL=-1
	NSL=1
	GO TO 405
300	CONTINUE
	KC=KC+1
	IF(KC)407,602,407
602	IF(KMIN)406,407,406
406	IK=-1
	NSK=1
	GO TO 410
110	FORMAT(74H1NUMBER  H  K  L FILM1 FILM2 FILM3 FILM4 FILM5  SINTOL
	2   LP     COMMENTS//)
8010	CALL EXIT
	END
	SUBROUTINE ROTATE(A1,A2,B1,B2,I1,I2,J1,J2)
	S1=A1
	S2=B1
	JS1=I1
	JS2=J1
	A1=A2
	A2=S1
	B1=B2
	B2=S2
	I1=I2
	I2=JS1
	J1=J2
	J2=JS2
	RETURN
	END
	SUBROUTINE ROTE(IS,IT)
	ISV=IS
	IS=IT
	IT=ISV
	RETURN
	END
	SUBROUTINE REJECT(J,K,L,SL,NRJCT)
	NRJCT=0
C SAMPLE SUBROUTINE TO REJECT H+K = 2N IN HKL (C CENTERED)
C  AND TO REJECT L=2N IN H0L AND K=2N IN 0KL
C     NP=J+K
C     IF(L)1,2,1
C   2 ANP=NP
C     INP=ANP/2.
C      IF(NP-2*INP)11,1,10
C  11 PRINT12
C  12 FORMAT(32H SUBROUTINE REJECT IS SCREWED UP)
C   1 IF(K)3,4,3
C   4 AL=L
C     IRL=AL/2.
C     IF(L-2*IRL)11,3,10
C   3 IF(J)6,5,6
C   5 AK=K
C     IRK=AK/2.
C     IF(K-2*IRK)11,6,10
C  10 NRJCT=1
6	RETURN
	END
