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