
	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
	DATA JFL/0/
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
C
C  OPEN THE OUTPUT FILE
C
	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
	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

