	PROGRAM FILMOD
C
C  A PROGRAM TO EDIT OR CREATE SEARCHABLE D/I FILES THAT ARE PART
C  OF DIFFRAC V. 
C  Or Diffrac-11 (as of 7-apr-86).
C
C  ROUTINES TAKEN FROM PARTS OF SEARCH AND IDENT
C
C
C  FILES TO BE EDITED MAY COME FROM ADR, IDENT OR
C  RESIDUAL PATTERNS FROM SEARCH
C
C
	CHARACTER*40 NFILE
	CHARACTER*80 TITLE
	COMMON /INP/ ALO,AHI,TIME,STEP,IFLG, JFLG
	COMMON /UNK/ NUMDI,INUNK(200),DUNK(200),THUNK(200)
	COMMON /CHAR/ TITLE, NFILE
	COMMON /IO/ IO5,IO6,IO7,IO30
	COMMON /BRAG/ WAVE, DTOR
	DATA WAVE/1.540598/, DTOR/0.0174533/
        DATA IO5,IO6,IO7,IO30/ 5, 6, 6, 30/
	WRITE (IO7,2000)
2000	FORMAT (1X,'This program will allow you to create a d/I file',
     1	' by keyboard entry'/1x'or edit an existing d/I file',
     2	/1x,'You may give the edited file a new name or retain',
     3	' the old one.'/
     4  ' Just press RETURN to take the default answers'//)
C
C  GET DATA FOR EDITING
C
30	CALL ADRIN
C
C  ARE YOU READY TO OUTPUT OR EDIT
C
50	WRITE (IO7,1000)
1000	FORMAT (///' Chose M(odify) OR O(utput) of d/I file or E(xit): '$)
	READ (IO5,1010,ERR=50,END=999)IT
1010	FORMAT(A1)
	IF(IT.EQ.'M') GO TO 100
	IF(IT.EQ.'O') GO TO 200
	IF(IT.EQ.'E') GO TO 999
	GO TO 50
C
C  CHOOSE EDIT
C
100	CALL CORRCT
	GO TO 50
C
C  CHOOSE OUTPUT
C
200	CALL ADROUT
C
C  STAY OR LEAVE
C
300	WRITE (IO7,1020)
1020	FORMAT (///' Chose C(ontinue) for new file or',
     1	' E(xit) if finished : '$)
	READ (IO5,1030,END=999)IP
1030	FORMAT (A1)
	IF (IP.EQ.'C') GO TO 30
999	CALL EXIT
	END

       SUBROUTINE ADRIN
C
C  THIS IS A GENERAL SUBROUTINE READ TO THE d-I INFORMATION
C  FROM AN ADR FILE. THE ADR INPUT FORMAT FOR SIEMENS FILES IS:
C  RECORD  1: BLANK
C  RECORD  2: BLANK
C  RECORD  3: BLANK
C  RECORD  4: ADR HEADER RECORD
C  RECORD  5: ALFRED UNIVERSITY HEADER RECORD
C  RECORD  6: DATE AND TIME OF PROCESSESING WITH ADR
C	(1X,'DATE:',1X,9A1,5X,'TIME: ',1X,8A1)
C	FOR INPUT: (7X,9A1,12X,8A1)
C  RECORD  7: OUTPUT FILE NAME
C	(' OUTPUT FILE NAME:'40A1) - (18X,10A1)
C  RECORD  8: TITLE OF RUN
C	('TITLE OF RUN:',80A1) - (13X,80A1)
C  RECORD  9: DATE OF RUN
C	(' DATE OF RUN: ',9A1) - (14X,9A1)
C  RECORD 10: BLANK
C  RECORD 11: STARTING ANGLE AND COUNT TIME (17X,F9.4,4X,F7.2)
C  RECORD 12: ENDING ANGLE AND X SIGMA (17X,F9.4,4X,F7.2)
C  RECORD 13: ANGLE INCREMENT AND Y SIGMA (17X,F9.4,4X,F7.2)
C  RECORD 14: POINTS FOR SMOOTH AND MAXIMUM FWHM
C  RECORDS 15-?: EXTRA RUN PARAMETERS
C  RECORD 16: d-I HEADER
C	(' PEAK',....)
C  RECORD 17: PK. #, 2-THETA, *, d, RELI, DELTA d, ABS I, FWHM
C	(1XI3,1XF9.4,A1,F8.3,F8.2,10X,F6.4,F9.1,F9.4)
C  OPTIONAL INFO ON d-I RECORD: IN PLACE OF 10X - hkl's in 3I3,1X
C
	CHARACTER*40 NFILE
	CHARACTER*1 IDOT, IBL, NAST, IAST
	CHARACTER*70 BUFF
	CHARACTER*80 TITLE
	DIMENSION IT(2), IPE(2), UNK(200)
	COMMON /INP/ ALO,AHI,TIME,STEP,IFLG, JFLG
	COMMON /UNK/ NUMDI,INUNK(200),DUNK(200),THUNK(200)
	COMMON /CHAR/ TITLE, NFILE
	COMMON /IO/ IO5,IO6,IO7,IO30
	COMMON /BRAG/ WAVE, DTOR
	DATA IDOT, IBL, IAST, IPE/'.', ' ', '*','PE','AK'/
C
C   INITIALIZE NUMDI - ZERO MEANS NO DATA ON FILE OR NO SUCH FILE
C
	NUMDI = 0
C
C  ALFRED OR SIEMENS FORMAT?
C
	WRITE(IO7,530)
530	FORMAT(/' ENTER: <0>=File to be created from keyboard, or'/
     1 ' To edit a d-I file ENTER file type: '/' <1>=Siemens <2>=',
     1 'Alfred, <3>= Diffrac11, <4>=exit: ')
	READ(IO5,535) IFMT
535	FORMAT(I)
C
C  SET JFLAG = 0 FILE INPUT , = 1 FOR KEYBOARD INPUT
C
	JFLG = 0
	IF(IFMT .GE. 4)STOP 
	IF(IFMT .EQ. 0)GO TO 900
C
C  GET NAME OF THE FILE
C
	WRITE(IO7,540)
540	FORMAT(/'$Enter the name of the d-I file :')
	READ(IO5,550)NFILE
550	FORMAT(A40)
C
C  OPEN THE DIFFRAC 11 FILE
C
       IF(IFMT .NE. 3)GO TO 5555
       JFLG = -1
       NTIN = IO30
       OPEN ( UNIT=NTIN, NAME=NFILE, TYPE='OLD', 
     +	  READONLY, FORM='UNFORMATTED', ACCESS='DIRECT', 
     &    RECORDSIZE=1, ASSOCIATEVARIABLE=NEXT)
C  Read title, operator, time & date
	NEXT=1
	DO 9110,I=1,45,4
9110	READ(NTIN'NEXT) TITLE(I:I+3)
	TITLE(26:28)='   '
	DO 9120,I=1,18
	 IF(' '.LE.TITLE(I:I) .AND. TITLE(I:I).LE.'~') GOTO 9120
C  Non ascii garbage detected in first twelve
C  records so this is not Diffrac-11 format.
C  $$ This is the place to add support for Diffrac-500
	 WRITE(6,9101)
9101	FORMAT(' File not in Diffrac 11 format!')
       CALL EXIT
C
C  Read number of peaks
9120	READ(NTIN'13) ALO
	READ(NTIN'14) AHI
	READ(NTIN'15) STEP
	READ(NTIN'16) TIME
	READ(NTIN'19) WAVE
	READ(NTIN'21) NUMDI
	NEXT = 41
C
C  READ DIFFRAC 11 FORMAT
C
        AMAX = 0.0
        DO 5002 I=1,NUMDI
	READ(NTIN'NEXT) DUNK(I)
	READ(NTIN'NEXT) UNK(I)
        IF(AMAX .LT. UNK(I)) AMAX = UNK(I)
        THUNK(I) = ASIN(WAVE  / (2.*DUNK(I)) ) / 0.017453293 
	NEXT = NEXT + 4
5002    CONTINUE
        DO 5004 I=1,NUMDI
5004	INUNK(I) = INT(UNK(I) / AMAX * 100.)
       	GO TO 899
C
C  OPEN THE ADR FILE
C
5555	OPEN(UNIT=IO30, NAME=NFILE, TYPE='OLD',FORM='FORMATTED')
C
C  SKIP OFF THE FIRST SEVEN BLANK RECORDS
C
	DO 556 I=1,7
556	READ(IO30,555)
555	FORMAT(1X)
C
C  READ HEADER RECORDS AND GET THE TITLE
C
	GO TO (560,580), IFMT
560	READ(IO30,570,END=710) TITLE
570	FORMAT(13X,A80)
	GO TO 600
580	READ(IO30,590,END=710) TITLE
590	FORMAT(14X,A80)
C
C  SKIP THE NEXT TWO RECORDS
C
600	READ(IO30,555)
	READ(IO30,555)
C
C  GET SCAN LIMITS AND MEAS. CONDITIONS.
C
	GO TO (610,630), IFMT
610	READ(IO30,620,END=710) ALO,TIME,AHI,STEP
620	FORMAT(17X,F8.4,19X,F6.1/16X,F9.4/17X,F8.4)
	GO TO 650
630	READ(IO30,640,END=710) ALO,TIME,AHI,STEP
640	FORMAT(18X,F8.4,19X,F6.1/17X,F9.4/18X,F8.4)
C
C  SEARCH FOR THE RECORD WITH "PEAK" STARTING IN COLUMN 1 OR 2
C
650	DO 700 I=1,50
	GO TO (660,680), IFMT
660	READ(IO30,670,END=710)(IT(J),J=1,2)
670	FORMAT(2A2)
	GO TO 695
680	READ(IO30,690,END=710) (IT(J),J=1,2)
690	FORMAT(1X,2A2)
695	IF( IT(1).EQ.IPE(1) .AND. IT(2).EQ.IPE(2) )GO TO 750
700     CONTINUE
C
C **	FILE IN WRONG FORMAT
C
710	STOP ' ????? File in wrong format'
C
C  FILE IS IN CORRECT FORMAT
C
C  READ THE TWO-THETA AND INTENSITIES
C
750	GO TO (760,780),IFMT
760	READ(IO30,770,END=999) THETA,NAST,TEMP0,TEMP1
770	FORMAT(3X,1XF9.5,A1,1XF7.4,1XF7.2,16X,F9.1,F9.4)
	GO TO 800
780	READ(IO30,790,END=999) THETA,NAST,TEMP0,TEMP1
790	FORMAT(4X,1XF9.5,A1,1XF7.4,1XF7.2,16X,F9.1,F9.4)
800	IF( TEMP0 .EQ. 0 )GO TO 899
C
C  ELIMINATE ALPHA 2 PEAK FROM INPUT LIST
C
        IF(IAST.EQ.NAST)GO TO 750
	NUMDI = NUMDI + 1
	THUNK(NUMDI) = THETA
	DUNK(NUMDI) = TEMP0
	INUNK(NUMDI) = TEMP1 + 0.5
	IF( NUMDI .LT. 200 )GO TO 750
        WRITE(IO7,810)
810    FORMAT(/1X,'Input d-I list truncated to 200 values')
	GO TO 899
899	CLOSE(UNIT=IO30)
	GOTO 999
C
C  KEYBOARD INPUT OF DATA
C
900	JFLG = 1
	WRITE(IO7,910)
910	FORMAT(/' ENTER the title of the data set:')
	READ(IO5,915) TITLE
915	FORMAT(A80)
C
C  GET SCAN LIMITS AND MEAS. CONDITIONS.
C
	WRITE(IO7,920)
920	FORMAT(/' ENTER low and high angle limits for the 2-Theta',
     1' scan (Default= 5.0,70.0)')
	READ(IO5,930)ALO,AHI
930	FORMAT(2G)
	WRITE(IO7,940)
940	FORMAT(/' ENTER the step width and count time (Defaults = ',
     1 '0.02,1.0)')
	READ(IO5,930)STEP,TIME
	IF(ALO .EQ. 0.)ALO = 5.
	IF(AHI .EQ. 0.)AHI = 65.
	IF(STEP .EQ. 0.)STEP = .02
	IF(TIME .EQ. 0.)TIME = 1.
C
C  READ THE TWO-THETA AND INTENSITIES
C
	WRITE(IO7,950)
950	FORMAT(/'$ENTER: <0>=2theta''s to be typed, or <1>=d''s',
     1' to be typed: ')
	READ(IO5,960)IFLG
960	FORMAT(I)
	IF(WAVE.EQ.0.0) WAVE = 1.54040
	WRITE(IO7,965) WAVE
965	FORMAT(/'$ENTER the wavelength to use for d-2theta conversions',
     1' (default = ',F8.4,'): ')
	READ(IO5,930)W
	IF(W .NE. 0.)WAVE = W
	AMAX = 0.0
	WRITE(IO7,970)
970	FORMAT(/' Begin entry of 2theta or d-I pairs:',/
     1' one pair per line seperated by a comma - When done enter <CR>'/
     2' You MUST include a decimal in both 2theta and Intensity!')
C980	READ(IO5,930) TEMP0, TEMP1
980	READ(IO5,982) BUFF
982	FORMAT(A70)
C
C  CHECK TO SEE IF THERE ARE TWO DECIMALS AND A COMMA
C
	ICOM = 0
	IBLN = 0
	IDEC = 0
	DO 984 I=1,70
	IF(BUFF(I:I) .EQ. ' ')IBLN = IBLN + 1
	IF(BUFF(I:I) .EQ. ',')ICOM = ICOM + 1
	IF(BUFF(I:I) .EQ. '.')IDEC = IDEC + 1
984	CONTINUE
	IF(IDEC .EQ. 2 .AND. ICOM .GE. 1)GO TO 988
	IF (IBLN .EQ. 70) GO TO 1000
	WRITE(IO6,986)BUFF
986	FORMAT(' Error on input line (decimals and comma must be',
     1' entered!) - Re-enter'/5X,A70)
	GO TO 980
988	READ(UNIT=BUFF,FMT = 930) TEMP0, TEMP1
	IF( TEMP0 .EQ. 0 )GO TO 1000
	NUMDI = NUMDI + 1
	UNK(NUMDI) = TEMP1 
	IF(TEMP1 .GT. AMAX) AMAX = TEMP1
	IF(IFLG .EQ. 1)GO TO 990
	THUNK(NUMDI) = TEMP0
	DUNK(NUMDI) = BRAGG(TEMP0)
	GO TO 995
990	DUNK(NUMDI) = TEMP0
	THUNK(NUMDI) = BRAGGI(TEMP0)
995	IF( NUMDI .LT. 200 )GO TO 980
        WRITE(IO7,997)
997    FORMAT(/1X,'Input d-I list truncated to 200 values')
C
C  SCALE THE INTENSITIES
C
1000	AMAX = 100. / AMAX 
	DO 1020 I=1,NUMDI
1020	INUNK(I) = UNK(I) * AMAX + 0.5
999	RETURN
        END

	FUNCTION BRAGG(A)
	COMMON /BRAG/ WAVE, DTOR
	BRAGG= WAVE / (2.0*SIN((A/2.0)*DTOR))
	RETURN
	END

	FUNCTION BRAGGI(A)
	COMMON /BRAG/ WAVE, DTOR
	BRAGGI = 2.0 * ASIN(WAVE/(2.0*A)) / DTOR
 	RETURN
	END

	SUBROUTINE CORRCT
C
C  INSERTS, DELETES OR CHANGES D-VALUES
C
	CHARACTER*70 BUFF
	CHARACTER*40 NFILE
	CHARACTER*80 TITLE
	BYTE ANSWER
	COMMON /INP/ ALO,AHI,TIME,STEP,IFLG, JFLG
	COMMON /UNK/ NUMDI,INUNK(200),DUNK(200),THUNK(200)
	COMMON /CHAR/ TITLE, NFILE
	COMMON /BRAG/ WAVE, DTOR
	COMMON /IO/ IO5,IO6,IO7,IO30
C
C  IF DATA CAME IN FROM FILE(jflg=0) WE NEED TO KNOW IF USER IS GOING TO TYPE
C  2 THETA'S (IFLG = 0) OR D'S (IFLG = 1)
C
	WRITE(IO7,1234)ALO,AHI
1234	FORMAT(/' ALO, AHI ',2F10.3/)
	IF(JFLG. EQ. 1)GO TO 1
	WRITE(IO7,123)
123	FORMAT(/' For corrections do you wish to enter 2theta(=<0>)',
     1' or d(=<1>)'$)
	READ(IO5,124)IFLG
124	FORMAT(I)
	IF(WAVE.EQ.0.0) WAVE = 1.5405
	WRITE(IO7,125) WAVE
125	FORMAT(/'$ENTER the wavelength to use for d-2theta conversions',
     1' (default = ',F8.4,'): ')
	READ(IO5,126) W
126	FORMAT(G)
	IF(W .NE. 0.)WAVE = W
C
C	PRESENT DATA FOR EVALUATION
C
1	N = 1
2	ND = 0
	TYPE 7000
7000	FORMAT (' '3(' No   d'5X'Int    2theta'1X)/)
	DO 10  N0=0, 16
	DO 8 N1 = N0+N, N+50, 17
	IF (N1.GT.NUMDI)  GOTO 10
	WRITE(IO7,7001) N1,DUNK(N1),INUNK(N1),THUNK(N1),
     1 N1+17,DUNK(N1+17),INUNK(N1+17),THUNK(N1+17),
     2 N1+34,DUNK(N1+34),INUNK(N1+34),THUNK(N1+34)
C     2 N1+34,DUNK(N1+34),INUNK(N1+34),THUNK(N1+34),N1=N0+N,N+16)
7001	FORMAT( 3(1X,I3,F7.4,1X,I4,3X,F7.3))
8	CONTINUE
C10	CONTINUE
10	WRITE(7,7003)
7003	FORMAT (' ')
C
C	IS THIS BLOCK OF DATA OK
C
	TYPE 7004
7004	FORMAT ('$Is this data ok? (Y/N default = Y): ')
	ACCEPT 5000, ANSWER
5000	FORMAT (A1)
	IF (ANSWER.NE.'N')  GOTO 100
C
C	CHANGE THRESHOLD?
C
	TYPE 7005
7005	FORMAT ('$Alter Intensity threshold ? (Y/N default=N): ')
	ACCEPT 5000, ANSWER
	IF (ANSWER .NE. 'Y')  GOTO 16
12	TYPE 7007
7007	FORMAT ('$ENTER new Intensity threshold (all lines below this',
     1 ' value will be deleted): ')
	READ (IO5,*,ERR=12)  THRESH
	ITR = THRESH
	N1 = 0
	DO 15  N0=1, NUMDI
	IF (INUNK(N0) .LT. ITH)  GOTO 15
	N1 = N1+1
	DUNK(N1) = DUNK(N0)
	THUNK(N1)=THUNK(N0)
	INUNK(N1) = INUNK(N0)
15	CONTINUE
	NUMDI = N1
	GOTO 2
C
C	WHAT CHANGE DO YOU WANT TO MAKE IN LINES
C
16	TYPE 7006
7006	FORMAT ('$Chose D(elete), I(nsert), C(hange)',
     1	', <CR>(to exit) : ')
	ACCEPT 5000, ANSWER
C
C	DELETE A LINE
C
20	IF (ANSWER.NE.'D')  GOTO 35
	TYPE 7008
7008	FORMAT ('$Number ? ')
	READ (IO5,*,ERR=20)  N0
	IF (N0.GT.NUMDI)  GOTO 16
	DUNK(N0) = 0.0
	ND = ND+1
	GOTO 16
C
C	CHANGE A LINE
C
35	IF (ANSWER.NE.'C')  GOTO 45
	IF(IFLG.EQ.1) GO TO 40
	TYPE 7010
7010	FORMAT ('$No, 2theta, intensity? ')
C	READ(IO5,*,ERR=35)N0,THUNK(N0),X
33	READ(IO5,36,ERR=35) BUFF
36	FORMAT(A70)
C CHECK FOR TWO COMMAS AND TWO DECIMALS
	ICOM = 0
	IDEC = 0
	IBLN = 0
	DO 37 I=1,70
	IF(BUFF(I:I) .EQ. ' ')IBLN = IBLN + 1
	IF(BUFF(I:I) .EQ. ',')ICOM = ICOM + 1
	IF(BUFF(I:I) .EQ. '.')IDEC = IDEC + 1
37	CONTINUE
	IF(IBLN .EQ. 70)GO TO 16
	IF(ICOM .GE. 2 .AND. IDEC .EQ. 2) GO TO 39
	WRITE(IO7,38)BUFF
38	FORMAT(' Error - Line number cannot contain a decimal ',
     1 ' - other values must!'/5X,A70/' Re-input line')
	GO TO 33
39	READ(UNIT=BUFF, FMT=31) N0,THUNK(N0),X
C39	DECODE(20,31,BUFF) N0,THUNK(N0),X
31	FORMAT(I5,2F10.4)
C	WRITE(6,9234)N0,THUNK(N0),X,BUFF
	INUNK(N0) = X
	DUNK(N0)=BRAGG(THUNK(N0))
	GO TO 16
40	TYPE 7012
7012	FORMAT ('$No, d, Intensity ? ')
c	READ (IO5,*,ERR=35)  N0, DUNK(N0), X
41	READ (IO5,36,ERR=35)  BUFF
C CHECK FOR TWO COMMAS AND TWO DECIMALS
	ICOM = 0
	IDEC = 0
	IBLN = 0
	DO 42 I=1,70
	IF(BUFF(I:I) .EQ. ' ')IBLN = IBLN + 1
	IF(BUFF(I:I) .EQ. ',')ICOM = ICOM + 1
	IF(BUFF(I:I) .EQ. '.')IDEC = IDEC + 1
42	CONTINUE
	IF(IBLN .EQ. 70)GO TO 16
	IF(ICOM .GE. 2 .AND. IDEC .EQ. 2) GO TO 44
	WRITE(IO7,38)BUFF
	GO TO 41
44	READ(UNIT=BUFF,FMT=31,ERR=35)  N0, DUNK(N0), X
C44	DECODE(20,31,BUFF)N0, DUNK(N0), X
	INUNK(N0) = X
C	WRITE(6,9234)N0,DUNK(N0),X,BUFF
C9234	FORMAT(' N0, DUNK(N0), INT = ',I4,2F10.4/1XA70)
	THUNK(N0) = BRAGGI(DUNK(N0))
	GOTO 16
C
C	INSERT A LINE
C
45	IF (ANSWER.NE.'I')  GOTO 55
	IF (NUMDI.GE.200)  GOTO 16
	NUMDI = NUMDI+1
	IF(IFLG.EQ.1) GO TO 50
	TYPE 7014
7014	FORMAT ('$2theta, Intensity ? ')
	READ(IO5,*,ERR=45)THUNK(NUMDI),X
	INUNK(NUMDI) = X
	DUNK(NUMDI)=BRAGG(THUNK(NUMDI))
	GO TO 16
50	TYPE 7016
7016	FORMAT ('$d, Intensity ? ')
	READ (IO5,*,ERR=45)  DUNK(NUMDI), X
	INUNK(NUMDI) = X
	THUNK(NUMDI) = BRAGGI(DUNK(NUMDI))
	GOTO 16
C
C	CHECK FOR RANGE OF D VALUES
C
55	DHI=BRAGG(ALO)
	DLO=BRAGG(AHI)
	DO 200 N0=1,NUMDI
	IF(DUNK(N0).LT.DLO.OR.DUNK(N0).GT.DHI)GO TO 58
	GO TO 200
58	DUNK(N0)=0.0
	THUNK(N0) = 0.0
	ND=ND+1
200	CONTINUE
C
C	REORDER THE LINES AND INTENSITIES
C
C
	DO 65  N0=1, NUMDI-1
	AMAX = DUNK(N0)
	NMAX = N0
	DO 60  N1=N0+1, NUMDI
	IF (AMAX.GE.DUNK(N1))  GOTO 60
	AMAX = DUNK(N1)
	NMAX = N1
60	CONTINUE
	DUNK(NMAX) = DUNK(N0)
	DUNK(N0) = AMAX
	K = INUNK(NMAX)
	INUNK(NMAX) = INUNK(N0)
	INUNK(N0) = K
	H = THUNK(NMAX)
	THUNK(NMAX)=THUNK(N0)
	THUNK(N0)=H
65	CONTINUE
	NUMDI = NUMDI - ND + 1
	MAX = INUNK(1)
C
C	NORMALIZE INTENSITIES
C
	DO 70  N0=2, NUMDI
70	IF ( MAX .LT. INUNK(N0))  MAX = INUNK(N0)
	MAX = 100. / FLOAT(MAX) + .5
	DO 72  N0=1, NUMDI
72	INUNK(N0) = INUNK(N0) * MAX
C
C	EXAMINE THE CORRECTED DATA
C
	GOTO 2
C
C	PRESENT THE NEXT BLOCK OF DATA
C
C
100	N = N+50
	IF (N.LE.NUMDI)  GOTO 2
C
	RETURN
C
	END

	SUBROUTINE ADROUT
C
C
C  THIS SUBROUTINE ALLOWS THE WRITING OF A SEARCHABLE PATTERN WITH A
C  NEW FILE NAME OR WRITING AN EDITED FILE WITH THE ORIGINAL NAME
C
C
C  THIS IS A GENERAL SUBROUTINE READ TO THE d-I INFORMATION
C  FROM AN ADR FILE. THE ADR INPUT FORMAT FOR SIEMENS FILES IS:
C  RECORD  1: BLANK
C  RECORD  2: BLANK
C  RECORD  3: BLANK
C  RECORD  4: ADR HEADER RECORD
C  RECORD  5: ALFRED UNIVERSITY HEADER RECORD
C  RECORD  6: DATE AND TIME OF PROCESSESING WITH ADR
C	(1X,'DATE:',1X,9A1,5X,'TIME: ',1X,8A1)
C	FOR INPUT: (7X,9A1,12X,8A1)
C  RECORD  7: OUTPUT FILE NAME
C	(' OUTPUT FILE NAME:'40A1) - (18X,10A1)
C  RECORD  8: TITLE OF RUN
C	('TITLE OF RUN:',80A1) - (13X,80A1)
C  RECORD  9: DATE OF RUN
C	(' DATE OF RUN: ',9A1) - (14X,9A1)
C  RECORD 10: BLANK
C  RECORD 11: STARTING ANGLE AND COUNT TIME (17X,F9.4,4X,F7.2)
C  RECORD 12: ENDING ANGLE AND X SIGMA (17X,F9.4,4X,F7.2)
C  RECORD 13: ANGLE INCREMENT AND Y SIGMA (17X,F9.4,4X,F7.2)
C  RECORD 14: POINTS FOR SMOOTH AND MAXIMUM FWHM
C  RECORDS 15-?: EXTRA RUN PARAMETERS
C  RECORD 16: d-I HEADER
C	(' PEAK',....)
C  RECORD 17: PK. #, 2-THETA, *, d, RELI, DELTA d, ABS I, FWHM
C	(1XI3,1XF9.4,A1,F8.3,F8.2,10X,F6.4,F9.1,F9.4)
C  OPTIONAL INFO ON d-I RECORD: IN PLACE OF 10X - hkl's in 3I3,1X
C
	CHARACTER*40 NFILE, MFILE
	CHARACTER*80 TITLE
	BYTE IDAT(9)
	COMMON /INP/ ALO,AHI,TIME,STEP,IFLG, JFLG
	COMMON /UNK/ NUMDI,INUNK(200),DUNK(200),THUNK(200)
	COMMON /CHAR/ TITLE, NFILE
	COMMON /IO/ IO5,IO6,IO7,IO30
	COMMON /BRAG/ WAVE, DTOR
C
C  SET UP THE NAME OF THE DEFAULT OUTPUT FILE
C
	IF(JFLG .EQ. 1)NFILE(1:7) = 'NEWFIL.'
	CALL LOCATE(NFILE, LOC)
	NFILE(LOC:LOC+2) = 'MOD'
50	WRITE(IO7,1020) NFILE
1020	FORMAT(/' The default output file will be named: ',A40/
     1 ' Enter a different name if you wish to change it: '$)
	READ(IO5,1030) MFILE
1030	FORMAT( A40 )
	IF( MFILE(1:2) .NE. '  ')NFILE = MFILE
        WRITE(IO7,1032)
1032	FORMAT(/'$Would you like <0>=Diffrac 11 or <1>=Alfred',
     1' output format? ')
        READ(IO5,1034) IFMT
1034	FORMAT(I)
        IF(IFMT .NE. 0) GO TO 5555
C
C  OPEN THE DIFFRAC 11 FILE
C
       NTIN = IO30
       OPEN ( UNIT=NTIN, NAME=NFILE, TYPE='NEW', 
     +	  FORM='UNFORMATTED', ACCESS='DIRECT', 
     &    RECORDSIZE=1, ASSOCIATEVARIABLE=NEXT)
C  WRITE title, operator, time & date
	NEXT=1
	DO 9110,I=1,45,4
9110	WRITE(NTIN'NEXT) TITLE(I:I+3)
C
C  Write number of peaks
C
9120	ZERO = 0.0
	WRITE(NTIN'13) ALO
	WRITE(NTIN'14) AHI
	WRITE(NTIN'15) STEP
	WRITE(NTIN'16) TIME
        WRITE(NTIN'17) ZERO
        WRITE(NTIN'18) ZERO
	WRITE(NTIN'19) WAVE
        WRITE(NTIN'20) ZERO
	WRITE(NTIN'21) NUMDI
        DO 5001 I=22,40
5001	WRITE(NTIN'I) ZERO
	NEXT = 41
C
C  WRITE DIFFRAC 11 FORMAT
C
        DO 5002 I=1,NUMDI
	WRITE(NTIN'NEXT) DUNK(I)
        FLOAT = INUNK(I)
	WRITE(NTIN'NEXT) FLOAT
        WRITE(NTIN'NEXT) ZERO
        WRITE(NTIN'NEXT) ZERO
        WRITE(NTIN'NEXT) ZERO
        WRITE(NTIN'NEXT) ZERO
5002    CONTINUE
       	GO TO 900
C
C  OPEN THE OUTPUT DIFFRAC-V FILE
C
5555	OPEN(UNIT=IO30,NAME=NFILE,TYPE='NEW',ACCESS='SEQUENTIAL',
     1 CARRIAGECONTROL='LIST')
C
C  GET DATE AND TIME
C
      CALL DATE( IDAT )
C
C  WRITE TITLE AND DATE TO FILE ON LUN 30
C
	WRITE(IO30,2000) IDAT, TITLE
2000	FORMAT(//'XRAY POWDER DATA ANALYSIS',/3X,
     1	'MODIFIED PATTERN',/'DATE: ',9A1,///'SAMPLE ID: ',
     2	A80,64X,/1X/1X)
C
C  WRITE OUT THE SCAN LIMITS
C
	WRITE(IO30,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
	WRITE(IO30,2002)
2002	FORMAT(//'PEAK  2-THETA      D     RELINT')
C
C  LASTLY OUTPUT THE DI INFORMATION
C
	DO 700 I=1,NUMDI
	UNK = INUNK(I)
	WRITE(IO30,1060)I,THUNK(I),DUNK(I),UNK
1060	FORMAT(I3,2X,F9.5,2X,F7.4,2XF6.2)
700	CONTINUE
900	WRITE(IO7,1070)NFILE
1070	FORMAT(/' Modified pattern written to file ',A40)
	CALL CLOSE(IO30)
999	RETURN
	END

	SUBROUTINE LOCATE(NAME,LOC)
C
C  THIS SUBROUTINE RETURNS THE VARIABLE LOC POINTING TO THE
C  NEXT CHARACTER AFTER THE DECIMAL POINT IN A FILE NAME
C
	CHARACTER*40 NAME
	DO 100 I=1,40
	IF(NAME(I:I) .EQ. '.')GO TO 200
100	CONTINUE
C
C  NO DECIMAL POINT FOUND - SET LOC TO ZERO
C
	LOC = 0
	GO TO 999
200	LOC = I + 1
999	RETURN
	END

