      DIMENSION ANG(3),CONST(10),H(10)
      INTEGER PC1,PC2
      DATA IYES,INO,IREAD,IWRIT/'Y','N',5,6/
      DATA FOCUS/60./
      RAD=6.283184/360.
      WRITE(IWRIT,3001)
 3001 FORMAT(//' PROGRAM CELDIM'/
     1' ANSWER ALL QUESTIONS EITHER YES OR NO'/
     2' ENTER ALL DATA AS FLOATING POINT NUMBERS WITH DECIMAL'/
     3' SEPERATED WITH COMMAS'/)
 1111 WRITE(IWRIT,3002)
 3002 FORMAT('  WOULD YOU LIKE THE INSTRUCTIONS LISTED?'/)
      READ (IREAD,25) INSTR
      IF (INSTR .EQ. IYES)  GO TO 27
      IF (INSTR .EQ. INO)  GO TO 19
      WRITE(IWRIT,3003)
 3003 FORMAT(//' BAD FIRST CHARACTER, PLEASE RETYPE.'//)
      GO TO 1111
   19 WRITE(IWRIT,3004)
 3004 FORMAT('  WOULD YOU LIKE THE PROGRAM CODES LISTED?'/)
      READ (IREAD,25) LIST
   25 FORMAT(A1)
      IF (LIST .EQ. IYES)  GO TO 27
      GO TO 2
   27 WRITE(IWRIT,3005)
 3005 FORMAT(//,22X,'PROGRAM CODES'//'  1   CALCULATE CELL DIMENSIONS FO
     1R PRECESSION DATA'/'  2   FOR CONE AXIS DATA'/'  3   TO CALCULATE
     2PRECESSION UPPER LAYER SETTINGS'/'  4   CALCULATE CELL DIMENSIONS
     3FOR WEISSENBURG DATA'/'  5   FOR OSCILLATION DATA'/'  6   GENERATE
     5 EQUIINCLINATION SETTINGS')
      WRITE(IWRIT,3006)
 3006 FORMAT(' 5,6  TO USE OSCILLATION DATA FOR EQUIINCLINATION SETTINGS
     1'/'  7   CALCULATE A,B, AND C FROM D OR D*'/'  8   CALCULATE V AND
     2 Z'/' 7,8  USE A,B, AND C TO CALCULATE V AND Z'/'  9   TO CALCULAT
     3E X-RAY DENSITY'/' 7,8  USE A,B, AND C TO OBTAIN X-RAY DENSITY BY
     4GUESSING'/' 7,9  USE A,B, AND C TO CALCULATE X-RAY DENSITY'/' 10
     5 CALCULATE AVERAGE D VALUES FROM 2*THETA VALUES')
      WRITE(IWRIT,3007)
 3007 FORMAT(' 11   CALCULATE THETA, SIN THETA, 2*THETA AND SINT/L FROM
     1D OR D*'/' 12   CALCULATE TOTAL NUMBER OF REFLECTIONS OCCURRING IN
     2 TORE OF'/'        REFLECTION'/' 13   TO CALL EXIT'/' 14   TO CHAN
     3GE THE WAVELENGTH AND/OR ANGLES'////)
      IF (INSTR .EQ. INO)  GO TO 2
      WRITE(IWRIT,3008)
 3008 FORMAT(//,26X,'PROGRAM INSTRUCTIONS'//'      THIS PROGRAM IS A COL
     1LECTION OF CALCULATIONS FOR ANALYZING VARIOUS'/' X-RAY DATA.  TO S
     2ELECT A CALCULATION, ENTER PROGRAM CODE, EXACTLY AS'/' IT IS LISTE
     3D ABOVE AT LEFT, WHEN THE COMPUTER TYPES "ENTER PROGRAM'/' CODE."
     4 ALL OF THE CALCULATIONS ARE CLOSED LOOPS.  TO EXIT FROM A CAL-'/'
     5 CULATION, ENTER ANY NON-ZERO NUMBER TO THE RIGHT OF COLUMN 50.'/
     6' OR ENTER 5 COMMAS FOLLOWED BY A 1 (IE ,,,,,1)'/
     7' ALL INPUT NUMBERS ARE FLOATING POINT IN FIELDS OF 10'/
     8' YOU MAY EITHER SPACE YOUR INPUT OR SIMPLY SEPERATE NUMBERS'/
     9' WITH COMMAS'/)
      WRITE(IWRIT,3010)
 3010 FORMAT('      IF YOU HAVE ANY SUGGESTIONS FOR IMPROVING THE CLARIT
     1Y OF THESE'/' INSTRUCTIONS, SEE DR. SNYDER.')
    2 WRITE (IWRIT,12)
   12 FORMAT(//'  TYPE LAMBDA AND ALPHA, BETA, GAMMA (IF OTHER THAN 90.0
     1) IN 4F10.6 .')
      READ (IREAD,15) ELAM,(ANG(I),I=1,3)
	IF(ELAM .EQ. 0)ELAM = 1.54178
      DO4 I=1,3
      IF(ANG(I))4,5,4
    5 ANG(I)=90.0
    4 ANG(I)=ANG(I)*RAD
    1 WRITE (IWRIT,11)
   11 FORMAT (//'  ENTER PROGRAM CODE.'/)
      READ (IREAD,6)   PC1,PC2
C  JDW 21-JAN-86 CHANGED (2G) TO (2I)
    6 FORMAT(2I)
      I=PC1
      GO TO(100,200,300,400,500,600,700,800,900,1000,1100,1200,999,2),I
C PRECESSION DATA
  100 WRITE(IWRIT,17)
   17 FORMAT(/' PRECESSION DATA'/)
  101 WRITE (IWRIT,14)
   14 FORMAT(' TYPE N AND DISTANCE FROM SPOT +N TO -N IN MM.(2F10.6)')
      READ (IREAD,15)   AN,DIST,D,D,D,RESTRT
   15 FORMAT(5F10.6,G)
      IF (RESTRT  .NE. 0.0)  GO TO 1
      WRITE (IWRIT,18)
   18 FORMAT(//)
      DSA=DIST/(2.0*AN*FOCUS*ELAM)
      DSRLU=DIST/(2.0*AN*FOCUS)
      D=1.0/DSA
      WRITE(IWRIT,16) DSA,DSRLU,D
   16 FORMAT('  D*=',F10.6,'    RECIPROCAL ANGSTROMS'/'  D*=',F10.6,' RL
     1U'/'  D= ',F10.6,' ANGSTROMS'//)
      GO TO 101
C  CONE AXIS DATA
  200 WRITE(IWRIT,23)
   23 FORMAT(/' CONE AXIS DATA'/)
  202 WRITE (IWRIT,20)
   20 FORMAT(' TYPE IN SCREEN SETTING ,MU,N, AND DIAMETER OF CONE N IN M
     1M.(4F10.6)')
      READ (IREAD,15) S,UM,AN,DIST,D,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      WRITE(IWRIT,18)
  201 DIST=DIST/2.0
      DSRLU=(COS(UM*RAD)-COS(ATAN(DIST/S)))/AN
      CONST(1)=ELAM/DSRLU
      D=CONST(1)
      DSA=1.0/D
      WRITE (IWRIT,21) CONST(1)
   21 FORMAT('CELL    CONSTANT =',F10.6,' ANGSTROMS'/' IF THE SYSTEM IS
     1ORTHOGONAL THE FOLLOWING APPLY'/)
      WRITE (IWRIT,16) DSA,DSRLU,D
      IF (PC2 .EQ. 3)  GO TO 301
      GO TO 202
C  TO CALCULATE UPPER LEVEL SETTINGS FOR PRECESSION CAMERA
  300 WRITE(IWRIT,35)
   35 FORMAT(/' UPPER LEVEL SETTINGS FOR PRECESSION CAMERA'/)
  305 WRITE (IWRIT,30)
   30 FORMAT(' TYPE D*(RLU), LAYER NO. AND MU DESIRED(3F10.6).')
      READ (IREAD,15) DSRLU,AN,UM,D,D,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
  301 DIST=DSRLU*AN
      WRITE (IWRIT,31) AN
   31 FORMAT(//'        SETTING FOR LEVEL'F4.0)
      WRITE(IWRIT,32)
   32 FORMAT(  '   MU   RS   SCREEN    CAMERA')
      RS=5.0
  302 RS=RS+5.0
      UM=UM*RAD
      CO=COS(UM)-DIST
      SI=SQRT(1-CO**2)
      CO=ATAN(SI/CO)
      S=RS/(SIN(CO)/COS(CO))
      CAM=FOCUS*DIST
      UM=UM/RAD
      WRITE(IWRIT,33) UM,RS,S,CAM
   33 FORMAT(F5.1,F5.0,2F10.6)
      IF(RS-30.0)302,303,303
  303 IF (PC1 .EQ. 2)  GO TO 200
      GO TO 305
C  WEISSENBERG DATA
  400 WRITE(IWRIT,40)
   40 FORMAT(/' WEISSENBERG DATA'/)
  401 WRITE (IWRIT,14)
      READ (IREAD,15) AN,DIST,D,D,D,RESTRT
      WRITE(IWRIT,18)
      IF (RESTRT  .NE. 0.0)  GO TO 1
      THETA=SIN(ATAN(2.0))*RAD*DIST/2.0
      DSRLU=2.0*SIN(THETA)/AN
      DSA=DSRLU/ELAM
      D=1.0/DSA
      WRITE(IWRIT,16) DSA,DSRLU,D
      GO TO 401
C  OSCILLATION DATA
  500 WRITE(IWRIT,51)
   51 FORMAT(/' OSCILLATION DATA'/)
  501 WRITE(IWRIT,50)
   50 FORMAT('TYPE N AND DISTANCE FROM OSCILLATION ROW +N TO -N IN MM.(2
     1F10.6)')
      READ(IREAD,15) AN,DIST,D,D,D,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      WRITE(IWRIT,18)
      DIST=DIST/2.0
      PNU=ATAN(DIST/28.647895)
      CONST(1)=AN*ELAM/SIN(PNU)
      DSRLU=ELAM/CONST(1)
      DSA=1.0/CONST(1)
      D=CONST(1)
      WRITE(IWRIT,21) CONST(1)
      WRITE (IWRIT,16) DSA,DSRLU,D
      IF (PC2 .EQ. 6)  GO TO 600
      GO TO 501
C  TO GENERATE EQUIINCLINATION WEISSENBURG SEETINGS
  600 WRITE(IWRIT,65)
   65 FORMAT(/' GENERATE WEISSENBERG SETTINGS'/)
  601 WRITE (IWRIT,60)
   60 FORMAT('TYPE CELL DIMENSION PARELLEL TO SPINDEL(F10.6)')
      READ (IREAD,15) CONST(1),D,D,D,D,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      WRITE(IWRIT,63)
   63 FORMAT('     N          MU               SCREEN SETTING')
      RS=25.5
      DO605 I=1,100
      SMU=I*ELAM/(2.0*CONST(1))
      AMU=ATAN(SMU/SQRT(1-SMU**2))
      DIST=RS*SIN(AMU)/COS(AMU)
      AMU=AMU/RAD
      IF(AMU-45.0)606,606,607
  606 WRITE(IWRIT,64) I,AMU,DIST
   64 FORMAT(I3,6XF10.6,10XF10.6)
  605 CONTINUE
  607 WRITE(IWRIT,18)
      IF (PC1 .EQ. 5)  GO TO 500
      GO TO  601
C  TO CALCULATE A,B, AND C FROM D OR D*
  700 WRITE(IWRIT,78)
   78 FORMAT(/' CALCULATE A,B AND C FROM D OR D*'/)
  720 WRITE (IWRIT,70)
   70 FORMAT(' TYPE EITHER D OR D*(RECIPROCAL ANGSTROMS)100, 010, AND001
     1 IN 3F10.6)')
      READ (IREAD,15) (CONST(I),I=1,3),D,D,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      WRITE (IWRIT,73)
   73 FORMAT('  TYPE IN 1 TO CHANGE LAMBDA.')
      READ (IREAD,701) ICHANG
  701 FORMAT(I1)
      IF (ICHANG .EQ. 1)  GO TO 710
      GO TO 711
  710 WRITE (IWRIT,12)
      READ (IREAD,15) ELAM,(ANG(I),I=1,3)
      DO715 I=1,3
      IF(ANG(I))715,714,715
  714 ANG(I)=90.0
  715 ANG(I)=ANG(I)*RAD
  711 WRITE (IWRIT,18)
      DO 702 I=1,3
      IF(CONST(I)-1.0)704,704,703
  703 CONST(I)=1.0/CONST(I)
  704 GO TO(705,706,707),I
  705 DSA=CONST(I)
      DSRLU=ELAM*CONST(I)
      D=1.0/CONST(I)
      CONST(1)=1.0/(CONST(1)*SIN(180.*RAD-ANG(2))*SIN(ANG(3)))
      WRITE (IWRIT,16) DSA,DSRLU,D
      WRITE (IWRIT,75) CONST(I)
   75 FORMAT('      A=',F10.6,' ANGSTROMS'//)
      GO TO 702
  706 DSA=CONST(I)
      DSRLU=ELAM*CONST(I)
      D=1.0/CONST(I)
      CONST(2)=1.0/(CONST(2)*SIN(180.*RAD-ANG(3))*SIN(ANG(1)))
      WRITE (IWRIT,16) DSA,DSRLU,D
      WRITE (IWRIT,76) CONST(I)
   76 FORMAT('      B=',F10.6,' ANGSTROMS'//)
      GO TO 702
  707 DSA=CONST(I)
      DSRLU=ELAM*CONST(I)
      D=1.0/CONST(I)
      CONST(3)=1.0/(CONST(3)*SIN(180.*RAD-ANG(1))*SIN(ANG(2)))
      WRITE (IWRIT,16) DSA,DSRLU,D
      WRITE (IWRIT,77) CONST(I)
   77 FORMAT('      C=',F10.6,' ANGSTROMS'//)
  702 CONTINUE
      IF (PC2 .EQ. 8)  GO TO 803
      IF (PC2 .EQ. 9)  GO TO 902
      GO TO 720
C  TO CALCULATE VOLUME AND Z
  800 WRITE(IWRIT,85)
      WRITE (IWRIT,80)
   85 FORMAT(/' CALCULATE VOLUME AND Z'/)
   80 FORMAT('TYPE A,B,C,DENSITY AND MOL. WT. IN 5F10.6')
      READ (IREAD,15) (CONST(I),I=1,3),RO,WM,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      GO TO 802
  803 WRITE(IWRIT,86)
   86 FORMAT(/' TO ESCAPE FROM THIS LOOP, ENTER DENSITY OF 0.0 .'/)
  801 WRITE(IWRIT,82)
   82 FORMAT(/'TYPE DENSITY AND MOL. WT. IN 2F10.6')
      READ(IREAD,15) RO,WM
      IF (RO) 802,804,802
  804 IF (PC1 .EQ. 7)  GO TO 700
      GO TO 1
  802 S=ANG(1)+ANG(2)+ANG(3)
      S=S/2.0
      V=2.0*CONST(1)*CONST(2)*CONST(3)*SQRT(SIN(S)*SIN(S-ANG(1))*SIN(S-
     1ANG(2))*SIN(S-ANG(3)))
      Z=RO*V*.6023/WM
      WRITE(IWRIT,83) V,Z
   83 FORMAT(/'    VOLUME=',F10.5,' CUBIC ANGSTROMS'/'  Z=',F10.5//)
      IF (PC1 .EQ. 8)  GO TO 800
      WRITE(IWRIT,84)
   84 FORMAT(' TRY ANOTHER DENSITY VALUE')
      GO TO 801
C  CALCULATE THE X-RAY DENSITY
  900 WRITE(IWRIT,93)
   93 FORMAT(/' CALCULATE XRAY DENSITY'/)
  905 WRITE(IWRIT,901)
  901 FORMAT(' TYPE A,B,C,Z AND MOL. WT. IN 5F10.6')
      READ(IREAD,15) (CONST(I),I=1,3),Z,WM,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      GO TO  904
  902 WRITE(IWRIT,91)
   91 FORMAT(' TYPE Z AND MOL. WT. IN 2F10.6.')
      READ(IREAD,15) Z,WM
  904 S=ANG(1)+ANG(2)+ANG(3)
      S=S/2.0
      V=2.0*CONST(1)*CONST(2)*CONST(3)*SQRT(SIN(S)*SIN(S-ANG(1))*SIN(S-
     1ANG(2))*SIN(S-ANG(3)))
      RO=WM*Z/(V*.6023)
      WRITE(IWRIT,903) RO
  903 FORMAT(//'     CALCULATED DENSITY =',F10.6//)
      IF (PC1 .EQ. 7)  GO TO 700
      GO TO 905
C  CALCULATE AVERAGE D VALUES FROM 2*THETA VALUES USING SIN(THETA) AS WTS.
 1000 WRITE(IWRIT,1012)
 1012 FORMAT(/' WEIGHTED AVERAGE LATTICE PARAMETERS( OR D VALUES)'/)
 1020 DO1001 I=1,10
 1001 CONST(I)=0.0
      WRITE(IWRIT,1002)
 1002 FORMAT(//' ENTER THE INDEX,2*THETA AND FLAG FOR UP TO 10 REFLECTIO
     1NS IN 3F10.6 '/' FLAG NON ZERO INDICATES LAST DATA ENTRY'/)
      DO 1003 I=1,10
      READ(IREAD,15) H(I),CONST(I),FLAG,D,D,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      IF(FLAG)1005,1003,1005
 1003 CONTINUE
 1005 WRITE(IWRIT,1006)
 1006 FORMAT(//'      D            WEIGHT')
      AN=I
      FLAG=0.0
      RS=0.0
      V=0.0
      DO1007 J=1,I
      S=H(J)
      H(J)=SIN(CONST(J)*RAD/2.0)
      CONST(J)=S*ELAM/(2.0*H(J))
      FLAG=FLAG+CONST(J)
      RS=RS+H(J)
      V=V+CONST(J)*H(J)
 1007 WRITE(IWRIT,1011) CONST(J),H(J)
 1011 FORMAT(F10.6,5XF10.6)
      V=V/RS
      FLAG=FLAG/AN
      S=0.0
      SI=0.0
      DO1008 J=1,I
      SI=SI+(CONST(J)-FLAG)**2
 1008 S=S+SI*H(J)
      SI=SQRT(SI/AN)
      S=SQRT(S/(AN*RS))
      WRITE(IWRIT,1010) FLAG,SI,V,S
 1010 FORMAT(/'AVERAGE D=',F10.6,'     SIGMA=',F10.6/' WEIGHTED AVERAGE
     1D=',F10.6,'     SIGMA=',F10.6//)
      GO TO 1020
C  CALCULATE THETA,SIN THETA, 2*THETA AND SINT/L FROM D OR D*
 1100 WRITE(IWRIT,1110)
 1110 FORMAT(/' THETA,SIN(T),2*T AND SIN(T)/LAMBDA FROM D OR D*'/)
 1120 WRITE(IWRIT,1101)
 1101 FORMAT(//' TYPE D OR D*(RECIPRACOL ANGSTROMS) IN F10.6')
      READ(IREAD,15) DIST,D,D,D,D,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      IF(DIST-1.0)1103,1103,1104
 1103 DIST=1.0/DIST
 1104 WRITE(IWRIT,1105)
 1105 FORMAT(//'    INDEX       THETA         2*THETA      SIN(THETA)
     1  SIN(THETA)/L')
      DO 1106 I=1,100
      AN=I
      SINT=AN*ELAM/(2.0*DIST)
      THETA=ATAN(SINT/(SQRT(1.0-SINT**2)))/RAD
      SINL=SINT/ELAM
      THET2=2.0*THETA
      IF(SINT-1.00)1106,1106,1100
 1106 WRITE(IWRIT,1107) I,THETA,THET2,SINT,SINL
 1107 FORMAT(I5,4(5XF10.6))
      GO TO 1120
C  CALCULATE THE NUMBER OF REFLECTIONS ENCLOSED IN THE TORE OF REFLECTION
 1200 WRITE(IWRIT,1205)
 1205 FORMAT(/' CALCULATE MAXIMUM POSSIBLE NUMBER OF X-RAY REF''S.'/)
 1210 WRITE(IWRIT,1201)
 1201 FORMAT(/' TYPE VOLUME AND AN IN 2F10.6 '/'     WHERE AN=1.0 FOR PR
     1IMATIVE'/'             =2.0 C FACE CENTERED OR BODY CENTERED'/
     212X,' =4.0 F FACE CENTERED')
      READ(IREAD,15) V,AN,D,D,D,RESTRT
      IF (RESTRT  .NE. 0.0)  GO TO 1
      S=19.74*V*AN/(ELAM**3)
      V=S/8.0
      AN=S/4.0
      SI=S/2.0
      WRITE(IWRIT,1203) ELAM,S
 1203 FORMAT(//'   THE NUMBER OF REFLECTIONS OCCURRING IN THE TORE'/
     1'OF REFLECTION WITH RADIUS 1.0/',F10.6,' IS ',F10.0/)
      WRITE(IWRIT,1204) SI,AN,V
 1204 FORMAT(/'    TRICLINIC HAS',F10.0,' INDEPENDENT REFLECTIONS'/'   M
     1ONOCLINIC HAS',F10.0,' INDEPENDENT REFLECTIONS'/
     2'  ORTHOROMBIC HAS',F10.0,' INDEPENDENT REFLECTIONS'/)
      GO TO1210
  999 CALL EXIT
      END
