CDC   PROGRAM QDAT(INPUT,OUTPUT,CARDS,TAPE5=INPUT,TAPE6=OUTPUT,          QDAT-1
CDC  1 TAPE7=CARDS)                                                      QDAT
                                                                         QDAT
C--- VERSION 5.2, DATED 20 MAY 1979                                      QDAT-1
C-      BASED ON                                                         QDAT-1
C--- VERSION 5, DATED 10 JULY 1978                                       QDAT
                                                                         QDAT
      LOGICAL INSERT,I2TCOR                                              QDAT-1
      DIMENSION TITLE(20),D(100),DELTAD(100),TWOTH(100),QOBS(100),       QDAT
     1 AINTNS(100),AINSRT(20)                                            QDAT-1
                                                                         QDAT
      DATA ISPACE/3H   /                                                 QDAT
      DATA ACONT/4HCONT/                                                 QDAT-1
                                                                         QDAT
      INCH=105                                                           QDAT
      IOUT=108                                                           QDAT
      IPUN=20                                                            QDAT
                                                                         QDAT
      ALAMDF=1.54178                                                     QDAT
                                                                         QDAT
      READ(INCH,1000)(TITLE(I),I=1,20)                                   QDAT
1000  FORMAT(20A4)                                                       QDAT
      WRITE(IPUN,1000) (TITLE(I),I=1,20)                                 QDAT-1
      READ(INCH,1001) IDTYPE,ISTYLE,NSPURI,IFZON,ILOUS,ITRER,IKOHL,      QDAT
     1 IPOWD,ISPDI,D2TH,ALAMBD,AMOLWT,DENS,DDENS,ZMULT,Z2TCOR            QDAT-1
1001  FORMAT(2I1,I2,6I1,5F10.0,2F5.0)                                    QDAT-1
                                                                         QDAT-1
      IF(IKOHL.GT.0) WRITE(IPUN,1400)                                    QDAT-1
 1400 FORMAT(5H $OPA,75X)                                                QDAT-1
                                                                         QDAT
      DEG=57.29577951308                                                 QDAT
      RAD=1.0/DEG                                                        QDAT
      ISTFLG=0                                                           QDAT
      IF(IDTYPE.EQ.0) IDTYPE=1                                           QDAT
      IF(ISTYLE.LT.0.OR.ISTYLE.GT.2) ISTYLE=0                            QDAT
      IF(D2TH.EQ.0.0) D2TH=0.06                                          QDAT
      IF(ALAMBD.EQ.0.0) ALAMBD=ALAMDF                                    QDAT
      IF(DDENS.EQ.0.0) DDENS=0.1                                         QDAT
      IF(DENS.EQ.0.0) DDENS=0.0                                          QDAT
      IF(ZMULT.EQ.0.0) ZMULT=1.                                          QDAT
      QCONST=4.0/(ALAMBD*ALAMBD)                                         QDAT
      AMCELL=ZMULT*AMOLWT                                                QDAT
                                                                         QDAT-1
      I2TCOR=Z2TCOR.NE.0.                                                QDAT-1
      IF(I2TCOR) WRITE(IOUT,1090) Z2TCOR                                 QDAT-1
 1090 FORMAT(1H0,'CORRECTION OF',F10.6,'  DEGREES TO BE ADDED TO EACH'   QDAT-1
     1 ' 2THETA VALUE')                                                  QDAT-1
      IF(IDTYPE.LE.2) GOTO 5                                             QDAT-1
      Z2TCOR=0.                                                          QDAT-1
      I2TCOR=.FALSE.                                                     QDAT-1
      WRITE(IOUT,1091)                                                   QDAT-1
 1091 FORMAT(1H ,'NOT DATA TYPE 1 OR 2 - NO CORRECTION APPLIED')         QDAT-1
    5 CONTINUE                                                           QDAT-1
                                                                         QDAT
      INSERT=.FALSE.                                                     QDAT-1
    4 READ(INCH,1000) (AINSRT(I),I=1,20)                                 QDAT-1
      IF(AINSRT(1).EQ.ACONT) GOTO 3                                      QDAT-1
      INSERT=.TRUE.                                                      QDAT-1
      WRITE(IPUN,1000) (AINSRT(I),I=1,20)                                QDAT-1
      GOTO 4                                                             QDAT-1
    3 CONTINUE                                                           QDAT-1
                                                                         QDAT-1
      WRITE(IOUT,1003) (TITLE(I),I=1,20)                                 QDAT-1
 1003 FORMAT(/45H0** POWDER DATA FORMAT TRANSLATION PROGRAM **,3X,       QDAT
     1 8HVERSION ,                                                       QDAT
     2 '5.2, DATED 20 MAY 1979'                                          QDAT-1
     * /1H0,20A4,                                                        QDAT-1
     3 /1H0,                                                             QDAT
     4 42H NO   2THETA   THETA     SINTH     SINTHSQ,8X,1HQ,9X,1HD,6X,   QDAT
     5 8HINT   NO/)                                                      QDAT
      I=0                                                                QDAT
   1  READ(INCH,1005)X,AINT                                              QDAT
1005  FORMAT(F10.0,A3)                                                   QDAT
      IF(X.LE.0.0) GO TO 2                                               QDAT
      I=I+1                                                              QDAT
      IF(IDTYPE.EQ.1) X=0.5*X                                            QDAT
      IF(IDTYPE.LE.2) X=SIN((X+0.5*Z2TCOR)/DEG)                          QDAT-1
      IF(IDTYPE.LE.3) X=X*X                                              QDAT
      IF(IDTYPE.EQ.5) X=0.00001*X                                        QDAT
      IF(IDTYPE.LE.5) X=QCONST*X                                         QDAT
      IF(IDTYPE.EQ.7) X=0.0001*X                                         QDAT
      IF(IDTYPE.LE.7) X=SQRT(1.0/X)                                      QDAT
                                                                         QDAT
C---WHATEVER THE INPUT TYPE, X IS NOW THE D-SPACING IN ANGSTROMS         QDAT
                                                                         QDAT
      D(I)=X                                                             QDAT
      QOBS(I)=10000.0/(X*X)                                              QDAT
      THETA=DEG*ASIN(0.5*ALAMBD/X)                                       QDAT
      TWOTH(I)=2.0*THETA                                                 QDAT
      SINTH=SIN(RAD*THETA)                                               QDAT
      SINSQ=SINTH*SINTH                                                  QDAT
      DMAX=0.5*ALAMBD/SIN(0.5/DEG*(TWOTH(I)-D2TH))                       QDAT
      DELTAD(I)=DMAX-X                                                   QDAT
      AINTNS(I)=AINT                                                     QDAT
      IF(AINT.NE.ISPACE) ISTFLG=1                                        QDAT
      WRITE(IOUT,1010) I,TWOTH(I),THETA,SINTH,SINSQ,QOBS(I),D(I),AINT,I  QDAT
1010  FORMAT(1H ,I3,1X,2F8.3,F11.6,F12.7,F11.3,F10.4,3X,A3,I5)           QDAT
      GOTO 1                                                             QDAT
                                                                         QDAT
C---END OF INPUT                                                         QDAT
                                                                         QDAT
   2  NOBS=I                                                             QDAT
      WRITE(IOUT,1020) NOBS                                              QDAT
1020  FORMAT(/17H INPUT COMPLETED,,I3,22H LINES TO BE PROCESSED)         QDAT
      IF(IFZON.EQ.0) GOTO 10                                             QDAT
                                                                         QDAT
C---FZON(6)                                                              QDAT
      DO 199 IFZN=1,IFZON                                                QDAT
      IF(.NOT.INSERT) WRITE(IPUN,1100) ALAMBD,AMOLWT,DENS                QDAT-1
 1100 FORMAT(                                                            QDAT-1
     2 3H9 1,17X,F10.6,3X,5H1 4 8,9X,3H1  ,F10.3,F10.4,10X)              QDAT
      IF(ISTFLG.EQ.0) WRITE(IPUN,1150) (QOBS(I),I=1,NOBS)                QDAT
      IF(ISTFLG.EQ.1) WRITE(IPUN,1151) (TWOTH(I),AINTNS(I),I=1,NOBS)     QDAT
1150  FORMAT(8(F10.3))                                                   QDAT
1151  FORMAT(8(F7.3,A3))                                                 QDAT
      WRITE(IPUN,1190)                                                   QDAT
1190  FORMAT(1H0/3HEND)                                                  QDAT
 199  CONTINUE                                                           QDAT
  10  IF(ILOUS.EQ.0) GOTO 20                                             QDAT
                                                                         QDAT
C---LOUV(7), LOUM(7) @ LOSH(3)                                           QDAT
      AMAX=20                                                            QDAT-1
      BMAX=20                                                            QDAT-1
      CMAX=20                                                            QDAT-1
      VOLMIN=0.                                                          QDAT
      VOLMAX=2000.                                                       QDAT-1
      BEMIN=90.                                                          QDAT
      BEMAX=130.                                                         QDAT
      DO 299 ILOU=1,ILOUS                                                QDAT
      IF(.NOT.INSERT) WRITE(IPUN,1200) NOBS,AMOLWT,DENS,DDENS,           QDAT-1
     1 AMAX,BMAX,CMAX,VOLMIN,VOLMAX,BEMIN,BEMAX                          QDAT
 1200 FORMAT(                                                            QDAT-1
     3 I3,3X,F10.3,2F10.4/                                               QDAT
     4 7F7.0,17H  0  30.00  30.00)                                       QDAT
      WRITE(IPUN,1250) (D(I),DELTAD(I),I,AINTNS(I),D2TH,ILOU,I=1,NOBS)   QDAT
 1250 FORMAT(2F7.4,6X,4HLINE,I3,3X,A3,17X,5HD2TH=,F6.3,4H DEG,7X,        QDAT
     1 6HLOUVMS,I2)                                                      QDAT
 299  CONTINUE                                                           QDAT
  20  IF(ITRER.EQ.0) GOTO 30                                             QDAT
                                                                         QDAT
C---TRER                                                                 QDAT
      DO 399 ITRE=1,ITRER                                                QDAT
      WRITE(IPUN,1350) (D(I),I,AINTNS(I),I=1,NOBS)                       QDAT
1350  FORMAT(F15.4,6H  LINE,I3,2X,A3,43X,4HTRER)                         QDAT
      WRITE(IPUN,1390) ALAMBD                                            QDAT
1390  FORMAT(1H0,79X/47HMONOSET=7, MONOGAM=1, MONO=130, MERIT=20, WAVE=, QDAT
     1 F8.6,16H, CHOICE=4, END*,9X)                                      QDAT
 399  CONTINUE                                                           QDAT
  30  IF(IKOHL.EQ.0) GOTO 40                                             QDAT
                                                                         QDAT
C---KOHL                                                                 QDAT
      DO 499 IKOH=1,IKOHL                                                QDAT
      IF(.NOT.INSERT) WRITE(IPUN,1401) ALAMBD                            QDAT-1
 1401 FORMAT(                                                            QDAT-1
     3 34H H4MAX=4, K4MAX=4, L4MAX=4, WLENG=,F10.6,1H,,35X)              QDAT
      WRITE(IPUN,1450) (D(I),I=1,NOBS)                                   QDAT
1450  FORMAT(6H D=   ,9(F7.4,1H,),2X/                                    QDAT
     1 3X,11(F6.4,1H,)/                                                  QDAT
     2 (6X,10(F6.4,1H,),4X))                                             QDAT
      WRITE(IPUN,1490)                                                   QDAT
 1490 FORMAT(5H $END)                                                    QDAT
 499  CONTINUE                                                           QDAT
  40  IF(IPOWD.EQ.0) GOTO 50                                             QDAT
                                                                         QDAT
C---POWDER(49)                                                           QDAT
      DO 599 IPOW=1,IPOWD                                                QDAT
      WRITE(IPUN,1500) IPOW,((TITLE(I),I=1,20),J=1,2)                    QDAT
1500  FORMAT(22H** POWD(49S) **   COPY,I2/                               QDAT
     1 6H+TITLE/                                                         QDAT
     2 20A4/                                                             QDAT
     3 4H*END//                                                          QDAT
     4 6H+INPAT/                                                         QDAT
     5 20A4/                                                             QDAT
     6 4H*END/                                                           QDAT
     7 4H*2,7)                                                           QDAT
      IF(ISTYLE.NE.0) WRITE(IPUN,1501) ISTYLE                            QDAT
1501  FORMAT(3H*5,,I1)                                                   QDAT
      IF(ALAMBD.NE.ALAMDF) WRITE(IPUN,1502) ALAMBD                       QDAT
1502  FORMAT(3H*7,,F10.6)                                                QDAT
      IF(AMCELL.NE.0.0) WRITE(IPUN,1503) AMCELL                          QDAT
1503  FORMAT(3H*8,,F10.3)                                                QDAT
      IF(DENS.NE.0.0) WRITE(IPUN,1504) DENS,DDENS                        QDAT
1504  FORMAT(3H*9,,2F8.4)                                                QDAT
      IF(NSPURI.NE.0) WRITE(IPUN,1505) NSPURI                            QDAT
1505  FORMAT(4H*10,,I2)                                                  QDAT
      WRITE(IPUN,1510)                                                   QDAT
1510  FORMAT(2H*D)                                                       QDAT
      IF(ISTYLE.EQ.0) WRITE(IPUN,1550) (QOBS(I),I=1,NOBS)                QDAT
1550  FORMAT(F10.5)                                                      QDAT
      IF(ISTYLE.NE.0) WRITE(IPUN,1551) (QOBS(I),AINTNS(I),I=1,NOBS)      QDAT
1551  FORMAT(F10.5,2X,A3)                                                QDAT
      WRITE(IPUN,1590)                                                   QDAT
1590  FORMAT(1H//2H*0)                                                   QDAT
 599  CONTINUE                                                           QDAT
   50 IF(ISPDI.EQ.0) GOTO 60                                             QDAT
                                                                         QDAT
C---SPDIF(4)                                                             QDAT
      DO 699 ISPD=1,ISPDI                                                QDAT
      WRITE(IPUN,1600) ISPD,ISPD,(TITLE(I),I=1,17),ISPD,                 QDAT
     1 ISTYLE,D2TH,ALAMBD,ISPD                                           QDAT
 1600 FORMAT(21H** SPDIF(4) **   COPY,I2/                                QDAT
     1 10HSPDIF    4,63X,5HSPDIF,I2/                                     QDAT
     2 7HTITLE  ,16A4,A1,6H SPDIF,I2/                                    QDAT
     3 7HDEFPAR ,I3,5X,F5.3,F10.6,43X,5HSPDIF,I2)                        QDAT
      ZM=ZMULT                                                           QDAT
      IF(AMOLWT.EQ.0.) ZM=0.                                             QDAT
      IF((NSPURI.NE.0).OR.(AMOLWT.NE.0.).OR.(DENS.NE.0.))                QDAT
     1 WRITE(IPUN,1601) NSPURI,AMOLWT,DENS,DDENS,ZM,ISPD                 QDAT
 1601 FORMAT(7HCELMAX ,I3,10X,F10.3,F10.4,F5.3,F5.2,23X,5HSPDIF,I2)      QDAT
      IF(ISTYLE.NE.1) WRITE(IPUN,1650) (TWOTH(I),AINTNS(I),I,ISPD,       QDAT
     1 I=1,NOBS)                                                         QDAT
 1650 FORMAT(4HLINE,6X,F10.5,A3,38X,I3,9X,5HSPDIF,I2)                    QDAT
      IF(ISTYLE.EQ.1) WRITE(IPUN,1651) (TWOTH(I),AINTNS(I),I,ISPD,       QDAT
     1 I=1,NOBS)                                                         QDAT
 1651 FORMAT(4HLINE,6X,F10.5,7X,A3,31X,I3,9X,5HSPDIF,I2)                 QDAT
      WRITE(IPUN,1690) ISPD                                              QDAT
 1690 FORMAT(3HEND,70X,5HSPDIF,I2)                                       QDAT
  699 CONTINUE                                                           QDAT
      WRITE(IPUN,1699) ISPD                                              QDAT
 1699 FORMAT(6HFINISH,67X,5HSPDIF,I2)                                    QDAT
   60 CONTINUE                                                           QDAT
                                                                         QDAT
      STOP                                                               QDAT
      END                                                                QDAT
