      PROGRAM FIG(A2, TAPE10=A2, A3, TAPE20=A3, TAPE59)
C
C  PROGRAM TO COMPUTE  FIGURES OF MERIT FOR POWDER PATTERNS OF ANY
C  CRYSTAL SYSTEM                                R. SNYDER  6/8/77
C
C  INPUT INSTRUCTIONS :
C                       INPUT IS FROM DATA FILE A2 PUNCHED OR BUILT USING TRIX
C
C  ITEM 1 TITLE  IN COL 1-70
C  ITEM 2 A,B,C,ALPHA(IN DEGREES),BETA,GAMMA,LAMBDA,IFLAG
C         SEPERATE ALL VALUES WITH COMMAS
C         LAMBDA--IF ZERO 1.5405 WILL BE USED
C         ALPHA, BETA OR GAMMA = 0.0 -- 90.0 WILL BE USED
C         IFLAG =  0 THETA DATA WILL BE INPUT
C               = 1 D VALUES WILL BE INPUT
C  ITEM 3 H,K,L,DOBS( OR 2-THETA OBS), NPOSSIBLE
C         SEPERATE ALL VALUES WITH COMMAS ****INCLUDE A COMMA AFTER NP WHEN USED
C         N POSSIBLE IS ONLY NEEDED FOR THOSE LINES WHICH THE FUNCTIONS
C         ARE TO BE EVALUATED---OTHERWISE IF NP=0 ONLY DEL 2 THETA AND
C         THE INPUT VALUES WILL BE PRINTED
C
C  ITEM 4 LAST CARD = BLANK MEANS A NEW DATA SET TO FOLLOW STARTING WITH ITEM 1
C                   99,  MEANS END OF LAST DATA SET
C                   YOU MAY ALSO END WITH THE LAST DATA CARD
C
C
      DIMENSION ITITLE(7)
      COMMON /CELLP/ CELL(6),VOL,RCP(6), RCV
      CALL CHANGE(4H+FIG)
      CALL DEVICE(7HDESTROY , 2HA3 , J, J)
      IN = 10
      IOUT = 20
      ITYP = 59
  100 SDT = 0.0
      SDTT = 0.0
      SDQ = 0.0
      READ(IN,1) ITITLE
    1 FORMAT(7A10)
      IF(EOF,IN)900,110
  110 WRITE(IOUT,5) ITITLE
    5 FORMAT(1H1,7A10/)
      WRITE(ITYP,10) ITITLE
   10 FORMAT(///7A10)  / )
      READ(IN,15)CELL,WAVE,ID
   15 FORMAT(7F10.5,I5)
      DO 120 I=4,6
      IF(CELL(I) .EQ. 0.0) CELL(I) = 90.0
  120 CONTINUE
      IF(WAVE .EQ. 0.0) WAVE = 1.54050
      IF(ID .EQ. 0) GO TO 130
      WRITE(IOUT,25)
      WRITE(ITYP,25)
   25 FORMAT(1X,"INPUT AS D VALUES")
      GO TO 140
  130 WRITE(IOUT,30)
      WRITE(ITYP,30)
   30 FORMAT(1X,"INPUT AS 2 THETA VALUES")
C
C  CALCULATE RECIPROCOL LATTICE PARAMETERS AND VOLUME
C
  140 CALL CELCON(DTR)
      WRITE(IOUT,20)CELL, VOL, WAVE, RCP, RCV
      WRITE(ITYP,20)CELL, VOL, WAVE, RCP, RCV
   20 FORMAT(4X1HA, 8X1HB, 8X1HC, 6X5HCOS A, 2X5HCOS B, 2X5HCOS G,
     1 4X3HVOL, 5X4HWAVE / 3(1XF8.5), 3(1XF6.4), 1XF8.2, 1XF7.5 /
     2 3(1XF8.6), 3(1XF6.4), 1XF8.6///
     3 2X,"H K L NO NP 2T OBS  2T CALC AV2T  RMS2T FN AV  FN RMS  M(N)
     4   RATIO")
C
C  BEGIN REFLECTION READING LOOP
C
      NO = 0
  200 NO = NO + 1
      READ(IN,35)J,K,L,DO,NP
   35 FORMAT(3I10,F14.6,I2)
      IF(EOF,IN)900,210
  210 IF(J .EQ. -99) GO TO 900
      IF(J .EQ. 0 .AND. K .EQ. 0 .AND. L .EQ. 0) GO TO 100
C
C  COMPUTE CALCULATED D AND 2 THETA
C
      QC = J**2*RCP(1)**2 + K**2*RCP(2)**2 + L**2*RCP(3)**2
     1 + 2.0*J*K*RCP(1)*RCP(2)*RCP(6)
     2 + 2.0*J*L*RCP(1)*RCP(3)*RCP(5)
     3 + 2.0*K*L*RCP(2)*RCP(3)*RCP(4)
      DC = SQRT(1.0 / QC )
      TC = 2.0 * ASIN(WAVE / (2.0*DC)) / DTR
C
C  COMPUTE OBS D OR 2 THETA
C
      END
