PROGRAM DIF11ADR C C ** PROGRAM TO CONVERT d-I FILES FROM DIFFRAC11 FORMAT TO ADR FORMAT C C C ** PROGRAMMER ROBERT L. SNYDER C ALFRED UNIVERSITY C ALFRED, N.Y. 14802 C C IMPLICIT REAL*8(A-H,O-Z) CHARACTER*40 NFILE,IJUNK,LFILE,PLTFIL,ISTD CHARACTER*16 LABEL CHARACTER*1 IBL, NAST, idat(9), IDOT BYTE TITLE(80) REAL*4 THETA1(200), DSP1(200),RELINT(200), INTCPS(200), FWHM1(200) COMMON /INP/ ALO,AHI,TIME,STEP,TITLE COMMON /IO/ IO5,IO6,IO7,IO10,IO11,IO20 DATA IO5,IO6,IO7,IO10,IO11,IO20,IO30/5,6,6,10,11,20,30/ data ibl, idot/' ','.'/ C C START CODE C DTR = 3.141592654 / 180. WRITE(IO7,1000) 1000 FORMAT(//10X'**** Convert DIFFRAC 11 d-I files to ADR format') C C Get the file name C 1 WRITE(IO7,1005) 1005 FORMAT('$Name of the DIFFRAC 11 d-I file: ') READ(IO5,1010,END=999) NFILE IF(NFILE .EQ. ' ') GO TO 999 1010 FORMAT(A40) C C ** FIND THE DEFAULT FILE NAME C ITEMP=0 DO 10 I=1,40 IF(NFILE(I:I).EQ.IDOT) ITEMP=I 10 CONTINUE IF (ITEMP.NE.0) GOTO 18 DO 12 I=40,1,-1 IF(NFILE(I:I).EQ.IBL) ITEMP=I 12 CONTINUE NFILE(ITEMP:ITEMP+3)='.DIF' 18 LFILE = NFILE LFILE(ITEMP+1:ITEMP+3)='ADR' C WRITE(IO7,1060) LFILE 1060 FORMAT(/' Name of the converted output file '/ 1'$(Default <',A40,'>) : ') READ(IO5,1010,END=1) IJUNK IF(IJUNK(1:1).EQ.IBL) GO TO 20 LFILE = IJUNK C C C OPEN D & I FILE FOR READ C 20 CALL INPUT(IO10,NFILE,TITLE,ALO,AHI,STEP,TIME,WAVEL, & THETA1,DSP1,RELINT,INTCPS,FWHM1,NPEAKS) C C ** WRITE IT ON LFILE C C OPEN THE OUTPUT FILE C 248 OPEN(UNIT=IO20,NAME=LFILE,TYPE='NEW',ACCESS='SEQUENTIAL', 1 CARRIAGECONTROL='LIST') C C GET DATE AND TIME C 250 CALL DATE( IDAT ) C C WRITE TITLE AND DATE TO FILE ON LUN 20 C WRITE(IO20,1301) IDAT, TITLE 1301 FORMAT(//'XRAY POWDER DATA ANALYSIS',/3X, 1 'PATTERN CORRECTED FOR INTERNAL STANDARD BY INTCAL'/ 1 'DATE: ',9A1,///'SAMPLE ID: ', 2 80A1,64X,/1X/1X) C C WRITE OUT THE SCAN LIMITS C WRITE(IO20,2001)ALO,TIME,AHI,STEP 2001 FORMAT('STARTING ANGLE : ',F8.4,5X,'COUNT TIME : ', 1 F6.1/'ENDING ANGLE : ',F9.4,/'ANGLE INCREMENT: ',F8.4) C C WRITE OUT THE ADR HEADRER RECORD C C$$$$$$$$$$$$$$$$$$$$$$$$$ WRITE(IO20,2002) 2002 FORMAT(//4X'PEAK',3X'2-THETA',6X'd',6X'RELINT',3X'h k l', 14X'ABSINT',4X'FWHM'/70('-')) WRITE(IO6,2003) 2003 FORMAT(//4X'PEAK',3X'2-THETA',6X'd',6X'RELINT',3X'h k l', 14X'ABSINT',4X'FWHM'/70('-')) C C NOW BEGIN OUTPUTTING EACH 2-THETA VALUE C N = 0 I1 = 0 I2 = 0 I3 = 0 nast = ' ' C DO 500 I=1,NPEAKS C read(io10,1180,end=510) theta,nast,d,ai,bb,fwhm THETA = THETA1(I) AI = RELINT(I) BB = INTCPS(I) FWHM = FWHM1(I) C C COMPUTE THE CORRECRED d VALUE C D = DSP1(I) 460 N = N + 1 WRITE(IO20,1370) N,THETA,NAST,D,AI,I1, 1 I2,I3,BB,FWHM WRITE(IO6,1370) N,THETA,NAST,D,AI,I1, 1 I2,I3,BB,FWHM 1370 FORMAT(4X,'#',I3,2X,F9.5,A1,1X,F7.4,2X,F6.2,2X,3I3,1X,F9.1,F9.4) 500 CONTINUE 510 WRITE(IO20,520) WRITE(IO6,520) 520 FORMAT(70('-')) CLOSE(UNIT=IO20) C 999 WRITE(IO6,9999) 9999 FORMAT(/10X'*** Normal termination of program ***') CALL EXIT END SUBROUTINE INPUT( IUNIT, NFILE, TITLE, & ALO, AHI, STEP, TIME, WAVEL, & THETA1, DSP1, RELINT, INTCPS, FWHM1, NPEAKS) C C READ A DIFFRAC-11 D & I FILE FOR PROGRAM INTCAL. C JIM WALKER 25-MAR-85 C REAL*4 THETA1(200), DSP1(200), RELINT(200), INTCPS(200), FWHM1(200) REAL*4 TITLE4(12) BYTE TITLE(80) INTEGER*2 JPEAKS CHARACTER NFILE*40 OPEN ( UNIT=IUNIT, NAME=NFILE, TYPE='OLD', SHARED, + READONLY, FORM='UNFORMATTED', ACCESS='DIRECT', & RECORDSIZE=1, ASSOCIATEVARIABLE=NEXT) C C Get run title DO 7,I=1,12 J=I READ(IUNIT'J) TITLE4(I) 7 CONTINUE ENCODE(80,4,TITLE) (TITLE4(I),I=1,12) 4 FORMAT(' SAMPLE ID: ',4A4,' MEASURED: ',5A4,' BY ',3A4) TITLE(56) = ' ' C C Get the run parameters READ(IUNIT'13) ALO READ(IUNIT'14) AHI READ(IUNIT'15) STEP READ(IUNIT'16) TIME READ(IUNIT'19) WAVEL C C Get the peaks READ(IUNIT'21) JPEAKS NPEAKS = JPEAKS BIGINT= 0. NEXT = 41 C DO 30, I=1,NPEAKS READ(IUNIT'NEXT) DSP1(I) READ(IUNIT'NEXT) INTCPS(I) READ(IUNIT'NEXT) FWHM1(I) NEXT = NEXT + 3 THETA1(I) = D2TH(DSP1(I),WAVEL) IF (INTCPS(I).GT.BIGINT) BIGINT = INTCPS(I) 30 CONTINUE C DO 40, I=1,NPEAKS RELINT(I) = 100.0 * INTCPS(I) / BIGINT 40 CONTINUE C RETURN END C FUNCTION D2TH(D,W) C W = 2*D*SIN(TH) D2TH = 360.0/3.1415926 * ASIN( W / 2.0 / D) RETURN END SUBROUTINE STDFIL(DINT,NUM,ISTD,IOUT,IUNIT,MAX) C Look for a file containing the standard in powd:[diffrac.intcal.standards] C The standard file has one number to a line. Negative numbers indicate C comments. 0.0 indicates that the comment should be echoed on the C terminal. C CHARACTER ISTD*40, NOTES*80 REAL*8 DINT(200) C C open the file OPEN(UNIT=IUNIT,NAME=ISTD, READONLY,STATUS='OLD',ERR=910, & DEFAULTFILE='POWD:[DIFFRAC.INTCAL.STANDARDS].ICS') C C read the lines NUM = 1 10 READ(IUNIT,20,END=999) DINT(NUM),NOTES 20 FORMAT(F10.5,A80) IF (DINT(NUM).EQ.0.0) WRITE(IOUT,30) NOTES 30 FORMAT(X,A80) IF (DINT(NUM).GT.0.0) NUM = NUM + 1 IF (NUM.LT.MAX) GOTO 10 C WRITE(IOUT,40) NUM-1 40 FORMAT(' Only the first',I4, & ' lines for the standard will be used.') C 999 NUM = NUM - 1 CLOSE(UNIT=IUNIT) RETURN C 910 NUM = 0 RETURN END