	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

