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