C==================================================================
C
C	COMMON BLOCKS FOR PROGRAM FILECONV
C
C==================================================================
C
C  GENERAL BLOCKS...
C
     	PARAMETER DTOR= 0.8726646259E-2, RTOD= 114.591559
     	COMMON /GENRAL/ IREC
C
C	IREC --- READ RECORD POINTER (FOR DEBUGING PURPOSE)
C==================================================================
C
C	INPUT/OUTPUT BLOCKS...
C
     	PARAMETER IINP= 1, IOUT= 2, NTYP= 60
     	CHARACTER FILTYP(NTYP)*24
     	CHARACTER FILINP*32, FILOUT*32
     	COMMON/IOFILE/IERR,JFIL,IFLI,IFLO,ITYI,ITYO,FILINP,FILOUT,FILTYP
C
C	IERR --- ERROR FLAG:
C	     FROM  READ: 0=NO ERROR, 1=ERROR DURING READ, 2=OPEN FAILURE
C			 3=BAIL OUT
C	     FROM WRITE: 0=NO ERROR, 1=ERROR DURING WRITE OR OPEN FAILURE
C			 3=BAIL OUT
C	JFIL ----- FILE TYPE NOT SUPPORTED YET
C	IFLI ----- INPUT FILE TYPE
C	IFLO ----- OUTPUT FILE TYPE
C	ITYI ----- INPUT FILE CATEGORY
C		   1=RAW, 2=DIF, 3=PLT, 4=DAT
C	ITYO ----- OUTPUT FILE CATEGORY
C		   1=RAW, 2=DIF, 3=PLT, 4=DAT
C	IINP ----- LOGICAL UNIT NUMBER FOR INPUT DATA FILE
C	IOUT ----- LOGICAL UNIT NUMBER FOR OUTPUT DATA FILE
C	FILINP --- INPUT DATA FILENAME
C	FILOUT --- OUTPUT DATA FILENAME
C	NTYP ----- MAX NUMBER OF FILE TYPES CONVERTABLE
C	FILTYP --- CHARACTER ARRAY THAT STORES THE FILE TYPE NAME
C==================================================================
C
C	FILE HEADER BLOCK...
C
     	INTEGER*2 ITYP
     	COMMON /FILHED/ ITYP, NHDB, ISBF, LENG
C
C	ITYP --- DATA FILE TYPE
C	NHDB --- NUMBER OF RECORDS IN THE HEADER BLOCK
C	ISBF --- STARTING RECORD OF SPECIFICATION BLOCK REFERENCES
C	LENG --- LENGTH OF SPECIFICATION BLOCK REFERENCES
C==================================================================
C
C	FILE BLOCK REFERENCES...
C
     	PARAMETER NSBR= 12
     	CHARACTER IRLR(NSBR)*4
     	COMMON /FILRFR/ IRPR(NSBR,2), IRLR
C
C	NSBR --- NUMBER OF SPECIFICATION BLOCK REFERENCES
C	IRPR --- SPECIFICATION BLOCK REFERENCES (POINTERS AND LENGTH)
C	IRLR --- LABEL OF SPECIFICATION BLOCK REFERENCES
C==================================================================
C
C	FILE DESCRIPTION BLOCK...
C
     	INTEGER*2 FTYP, MTYP, NREP, MPRO, NRNG
     	CHARACTER NAME(3)*4, SCAN*1, STYP*1, SLID(20)*4
     	COMMON /FILDES/ NAME, DATM, TIMM, FTYP, MTYP, NREP,
     	1 MPRO, NRNG, SCAN, STYP, SLID
C
C	NAME --- OPERATOR NAME
C	DATM --- ENCODED DATE
C	TIMM --- ENCODED TIME
C	FTYP --- FILE TYPE
C	MTYP --- METHOD OF ANALYSIS
C	NREP --- NUMBER OF SERIES OF MEASUREMENTS
C	MPRO --- MEASUREMENT PROCEDURE
C	NRNG --- NUMBER OF SCAN RANGES
C	SCAN --- SCAN MODE
C	STYP --- SERIES TYPE
C	SLID --- SAMPEL ID
C==================================================================
C
C	LINE MEASUREMENT BLOCK...
C
     	COMMON /LINEMM/ BANG(14), DANG(14)
C
C	BANG(1) --- STARTING ANGLE
C	BANG(2) --- ENDING ANGLE
C	BANG(3) --- STEP WIDTH
C	BANG(4) --- MAX COUNTS
C	BANG(5) --- TWO-THETA OF MAX COUNTS
C	BANG(6) --- MIN COUNTS
C	BANG(7) --- TWO-THETA OF MIN COUNTS
C	BANG(8) --- RESERVED
C	BANG(9) --- NUMBER OF OSCILLATIONS
C	BANG(10)--- COUNT TIME (SEC) FOR PEAK
C	BANG(11)--- COUNT TIME FOR BACKGROUND
C	BANG(12)--- RESERVED
C	BANG(13)--- DELAY TIME
C	BANG(14)--- FIXED ANGLE OF MEASUREMENT
C	DANG(*) --- USER MODIFIABLE SET OF BANG(*)
C==================================================================
C
C	INSTRUMENTATION BLOCK...
C
     	CHARACTER ANODE(6)*2
     	COMMON /INSTRU/ IELE, WAVE(5,6), ANODE
C
C	IELE -------- TARGET ELEMENT (DEFAULT=4,Cu)
C	WAVE(*,1) --- Cr
C	WAVE(*,2) --- Fe
C	WAVE(*,3) --- Co
C	WAVE(*,4) --- Cu
C	WAVE(*,5) --- Mo
C	WAVE(*,6) --- USER SPECIFIED
C	WAVE(1,*) --- WAVELENGTH OF K-ALPHA 1
C	WAVE(2,*) --- WAVELENGTH OF K-ALPHA 2
C	WAVE(3,*) --- WAVELENGTH OF K-ALPHA
C	WAVE(4,*) --- WAVELENGTH OF K-BETA
C	WAVE(5,*) --- KA1/KA2 RATIO
C==================================================================
C
C	INTENSITY DATA BLOCK...
C
     	PARAMETER MNP= 10000
     	COMMON /COUNTS/ MODE, NPTS, XOBS(MNP), YOBS(MNP)
C
C	MNP ---- MAXIMUM NUMBER OF DATA POINTS ALLOWED
C	MODE --- 0 = X --- TWO-THETA
C		 1 = X --- D-SPACING
C		 2 = X --- Q-SCAN (Q=2PI/D=4PI*SIN(THETA)/LAMDA)
C	NPTS --- TOTAL NUMBER OF DATA POINTS STORED IN YOBS
C	XOBS --- ARRAY TO STORE THE X-VALUES
C	YOBS --- ARRAY TO STORE THE RAW COUNTS
C==================================================================
C
C	DIFILE BLOCK...
C
     	PARAMETER MNK= 500
     	CHARACTER PEAK(MNK)*4
     	INTEGER*4 PHKL(3,MNK)
     	COMMON /DIFILE/ NPKS, IRES, JRES, CUTI(2), CUTF(2),
     	1 F2TH(MNK), FDSP(MNK), C2TH(MNK), CDSP(MNK),
     	1 PHGH(MNK), AREA(MNK,2), RELA(MNK),
     	1 FWHM(MNK), PHKL, PEAK
C
C	MNK ---- MAXIMUM NUMBER OF PEAKS ALLOWED
C	NPKS --- TOTAL NUMBER OF PEAKS STORED
C	IRES --- RESIDUAL PATTERN FLAG: 0=CONTAINED, 1=NOT CONTAINED
C	JRES --- USE THE RESIDUAL PATTERN: 1=NO, 2=YES
C	CUTI --- INTENSITY CUTOFFS (%)
C	CUTF --- FWHM CUTOFFS (D)
C	F2TH --- OBSERVED TWO-THETA
C	FDSP --- OBSERVED D-SPACING
C	C2TH --- CORRECTED TWO-THETA
C	CDSP --- CORRECTED D-SPACING
C	PHGH --- PEAK HEIGHT (CPS)
C	AREA(*,1) --- INTEGRATED INTENSITY
C	AREA(*,2) --- RESIDUAL INTENSITY
C	RELA --- RELATIVE INTENSITY
C	FWHM --- FULL WIDTH AT HALF MAXIMUM
C	PHKL --- REFLECTION HKL
C	PEAK --- PEAK TYPE LABEL
C==================================================================
C=======================================================
C
C	PROGRAM FILECONV
C
C	PROGRAMMER: Rongsheng Zhou
C		    ALFRED UNIVERSITY, FEB-1987
C	Modified 3/89 by R. L. Snyder
C
C	AN INTEGRATED FILE FORMAT CONVERSION ROUTINE
C	MAINLY FOR X-RAY DIFFRACTION ANALYSIS PROGRAMS
C
C=======================================================

     	INCLUDE 'FILECONV.CBS'

     	PARAMETER LINE= 22
     	PARAMETER IRAW1=  1, IRAW2= 18
     	PARAMETER IDIF1= 21, IDIF2= 32
     	PARAMETER IPLT1= 41, IPLT2= 43
     	PARAMETER ILIS1= 46, ILIS2= 47
     	PARAMETER IDAT1= 51, IDAT2= 52
     	CHARACTER TEXT*80, DEFFIL*32, FILNUM(NTYP)*4
     	DIMENSION IL(NTYP), IC(NTYP)

     	DATA FILTYP(1)  / 'Diffrac-500 ........ RAW' /
     	DATA FILTYP(2)  / 'Diffrac-11 ......... RAW' /
     	DATA FILTYP(3)  / 'Diffrac-5(Alfred) .. RAW' /
     	DATA FILTYP(4)  / 'Diffrac-5(Siemens) . RAW' /
     	DATA FILTYP(5)  / 'Specplot ........... RAW' /
     	DATA FILTYP(6)  / 'Nicolet ............ RAW' /
     	DATA FILTYP(7)  / 'Scintag ............ RAW' /
     	DATA FILTYP(8)  / 'Rigaku ............. RAW' /
     	DATA FILTYP(9)  / 'Rigaku (old) ....... RAW' /
     	DATA FILTYP(10) / 'MDI ................ RAW' /
     	DATA FILTYP(11) / 'GSAS Rietveld....... RAW' /
     	DATA FILTYP(12) / 'Shadow(Alfred) ..... RAW' /
     	DATA FILTYP(13) / 'X-ray Rietveld ..... RAW' /
     	DATA FILTYP(14) / 'NBS Rietveld ....... RAW' /
     	DATA FILTYP(15) / 'NSLS-X7 (BNL) ...... RAW' /
     	DATA FILTYP(16) / 'NSLS-X3 (SUNY) ..... RAW' /
     	DATA FILTYP(17) / 'JCAMP - PDF3 ....... RAW' /
     	DATA FILTYP(18) / '?????? ............. RAW' /
     	DATA FILTYP(60) / 'Line Printer ....... LP ' /

     	DATA FILNUM(1)  / '[ 1]' /
     	DATA FILNUM(2)  / '[ 2]' /
     	DATA FILNUM(3)  / '[ 3]' /
     	DATA FILNUM(4)  / '[ 4]' /
     	DATA FILNUM(5)  / '[ 5]' /
     	DATA FILNUM(6)  / '[ 6]' /
     	DATA FILNUM(7)  / '[ 7]' /
     	DATA FILNUM(8)  / '[ 8]' /
     	DATA FILNUM(9)  / '[ 9]' /
     	DATA FILNUM(10) / '[10]' /
     	DATA FILNUM(11) / '[11]' /
     	DATA FILNUM(12) / '[12]' /
     	DATA FILNUM(13) / '[13]' /
     	DATA FILNUM(14) / '[14]' /
     	DATA FILNUM(15) / '[15]' /
     	DATA FILNUM(16) / '[16]' /
     	DATA FILNUM(17) / '[17]' /
     	DATA FILNUM(18) / '[18]' /
     	DATA FILNUM(60) / '[60]' /

     	DATA FILTYP(21) / 'Diffrac-500 ........ DIF' /
     	DATA FILTYP(22) / 'Diffrac-11 ......... DIF' /
     	DATA FILTYP(23) / 'Diffrac-5(Alfred) .. DIF' /
     	DATA FILTYP(24) / 'Diffrac-5(Siemens) . DIF' /
     	DATA FILTYP(25) / 'Specplot ........... DIF' /
     	DATA FILTYP(26) / 'Nicolet ............ DIF' /
     	DATA FILTYP(27) / 'Scintag ............ DIF' /
     	DATA FILTYP(28) / 'Rigaku ............. DIF' /
     	DATA FILTYP(29) / '?????? ............. DIF' /
     	DATA FILTYP(30) / 'MDI ................ DIF' /
     	DATA FILTYP(31) / 'AIDS ............... DIF' /
     	DATA FILTYP(32) / 'Keyboard ........... DIF' /
     	DATA FILTYP(41) / 'Shadow ............. PLT' /
     	DATA FILTYP(42) / 'X-ray Rietveld ..... PLT' /
     	DATA FILTYP(43) / 'NBS Rietveld ....... PLT' /
     	DATA FILTYP(46) / 'X-ray Rietveld ..... LIS' /
     	DATA FILTYP(47) / 'NBS Rietveld ....... LIS' /
      	DATA FILTYP(51) / 'GRAFIT ............. DAT' /
     	DATA FILTYP(52) / 'GRAFIT ............. HKL' /

     	DATA FILNUM(21) / '[21]' /
     	DATA FILNUM(22) / '[22]' /
     	DATA FILNUM(23) / '[23]' /
     	DATA FILNUM(24) / '[24]' /
     	DATA FILNUM(25) / '[25]' /
     	DATA FILNUM(26) / '[26]' /
     	DATA FILNUM(27) / '[27]' /
     	DATA FILNUM(28) / '[28]' /
     	DATA FILNUM(29) / '[29]' /
     	DATA FILNUM(30) / '[30]' /
     	DATA FILNUM(31) / '[31]' /
     	DATA FILNUM(32) / '[32]' /
     	DATA FILNUM(41) / '[41]' /
     	DATA FILNUM(42) / '[42]' /
     	DATA FILNUM(43) / '[43]' /
     	DATA FILNUM(46) / '[46]' /
     	DATA FILNUM(47) / '[47]' /
     	DATA FILNUM(51) / '[51]' /
     	DATA FILNUM(52) / '[52]' /
C
C  IL is the line number for each of the menu labels
C
     	DATA IL /
     	1  2,  3,  4,  5,  6,  7,  8,  9, 10, 11,
     	1 12, 13, 14, 15, 16, 17, 18, 19,  0,  0,
     	1  2,  3,  4,  5,  6,  7,  8,  9, 10, 11,
     	1 12, 13,  0,  0,  0,  0,  0,  0,  0,  0,
     	1 14, 15, 16,  0,  0, 17, 18,  0,  0,  0,
     	1 19, 20,  0,  0,  0,  0,  0,  0,  0, 20 /
C
C  IC is the column number for each of the menu labels
C
     	DATA IC /
     	1 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
     	1 11, 11, 11, 11, 11, 11, 11, 11,  0,  0,
     	1 51, 51, 51, 51, 51, 51, 51, 51, 51, 51,
     	1 51, 51,  0,  0,  0,  0,  0,  0,  0,  0,
     	1 51, 51, 51,  0,  0, 51, 51,  0,  0,  0,
     	1 51, 51,  0,  0,  0,  0,  0,  0,  0, 11 /

     	DATA WAVE/
     	1 2.289700, 2.293606, 2.291000, 2.084870, 2.0,
     	1 1.936042, 1.939980, 1.937355, 1.756610, 2.0,
     	1 1.788965, 1.792850, 1.790260, 1.620790, 2.0,
     	1 1.540562, 1.544390, 1.541838, 1.392218, 2.0,
     	1 0.709300, 0.713590, 0.710730, 0.632288, 2.0,
     	1 0.000000, 0.000000, 0.000000, 0.000000, 0.0 /
     	DATA ANODE / 'CR', 'FE', 'CO', 'CU', 'MO', 'US' /
C
C  DISPLAY THE MAIN MENU...
C
1	CALL CLEARS( 0)			!CLEAR THE SCREEN
     	CALL COLORS(-1)			!REVERSE VIDEO
     	CALL COLORS(80)			!INTENSE PRINT
     	TEXT='FILECONV --- An Integrated File Format Conversion Routine'
     	CALL HEADER( TEXT )
     	CALL COLORS(1)
     	WRITE(6,1000)
1000	FORMAT(
     	16X,'[ 1]',29X,'<*>',4X,'[21]'/6X,'[ 2]',29X,'<*>',4X,'[22]'/
     	16X,'[ 3]',29X,'<*>',4X,'[23]'/6X,'[ 4]',29X,'<*>',4X,'[24]'/
     	16X,'[ 5]',29X,'<*>',4X,'[25]'/6X,'[ 6]',29X,'<*>',4X,'[26]'/
     	16X,'[ 7]',29X,'<*>',4X,'[27]'/6X,'[ 8]',29X,'<*>',4X,'[28]'/
     	16X,'[ 9]',29X,'<*>',4X,'[29]'/6X,'[10]',29X,'<*>',4X,'[30]'/
     	16X,'[11]',29X,'<*>',4X,'[31]'/6X,'[12]',29X,'<*>',4X,'[32]'/
     	16X,'[13]',29X,'<*>',4X,'[41]'/6X,'[14]',29X,'<*>',4X,'[42]'/
     	16X,'[15]',29X,'<*>',4X,'[43]'/6X,'[16]',29X,'<*>',4X,'[46]'/
     	16X,'[17]',29X,'<*>',4X,'[47]'/6X,'[18]',29X,'<*>',4X,'[51]'/
     	16X,'[60]',29X,'<*>',4X,'[52]')
     	CALL COLORS(-1)
     	WRITE(6,1002)
1002	FORMAT('     Enter CTRL_Z wherever you wish to quit;   ? or',
     	1' HELP if you need any help    ')
     	CALL COLORS(1)
     	DO 5 I=1, NTYP
     	   IF( I.GT.IRAW2 .AND. I.LT.IDIF1 ) GOTO 5
     	   IF( I.GT.IDIF2 .AND. I.LT.IPLT1 ) GOTO 5
     	   IF( I.GT.IPLT2 .AND. I.LT.ILIS1 ) GOTO 5
     	   IF( I.GT.ILIS2 .AND. I.LT.IDAT1 ) GOTO 5
     	   IF( I.GT.IDAT2 .AND. I.LT.NTYP  ) GOTO 5
     	   CALL PUTEXT( FILTYP(I), 24, IL(I), IC(I) )
5	CONTINUE

9	IFLI = 0			!INPUT FILE TYPE
     	IFLO = 0			!OUTPUT FILE TYPE
C
C  GET THE CONVERSION COMBINATION...
C
100	IF( IFLI.GT.IDIF2 ) GOTO 120
     	CALL COLORS(1)
     	TEXT = ' '
     	IF( IFLI.EQ.0 ) THEN
     	    CALL PUTEXT( TEXT, 40, LINE, 1 )
     	    TEXT = ' Input File Type(#): '
     	    CALL PUTEXT( TEXT, 21, LINE, 1 )
     	ENDIF
     	IF( IFLI.GT.0 ) THEN
     	    CALL PUTEXT( TEXT, 40, LINE+1, 1 )
     	    TEXT = 'Output File Type(#): '
     	    CALL PUTEXT( TEXT, 21, LINE+1, 1 )
     	ENDIF
     	READ(5,101,ERR=444,END=444) TEXT
101	FORMAT(A)
     	IF( TEXT.EQ.' ' ) GOTO 444
     	NCH = NBLANK( TEXT, 10 )
     	IF( NCH.GT.0 ) TEXT = TEXT(NCH+1:) 
     	NCH = NALPHA( TEXT, -4 )
     	IF( TEXT(1:2).EQ.'EX' .OR. TEXT(1:2).EQ.'QU' ) GOTO 444
     	DECODE( NCH, 102, TEXT, ERR=333 ) IQS
102	FORMAT(I)

     	CALL CURSOR( 24, 1 )
     	CALL CLEARS( 6 )
     	IF( IQS.LT.IRAW1 .OR.  IQS.GT.NTYP  ) GOTO 111
     	IF( IQS.GT.IRAW2 .AND. IQS.LT.IDIF1 ) GOTO 111
     	IF( IQS.GT.IDIF2 .AND. IQS.LT.IPLT1 ) GOTO 111
     	IF( IQS.GT.IPLT2 .AND. IQS.LT.ILIS1 ) GOTO 111
     	IF( IQS.GT.ILIS2 .AND. IQS.LT.IDAT1 ) GOTO 111
     	IF( IQS.GT.IDAT2 .AND. IQS.LT.NTYP  ) GOTO 111
     	GOTO 150
120	IF( IFLI.LT.ILIS1 ) IQS = 51	!DEFAULT TO GRAFIT "DAT"
     	IF( IFLI.GT.IPLT2 ) IQS = 52	!DEFAULT TO GRAFIT "HKL"
150	IF( IFLI.EQ.0 ) THEN
C
C  NO INPUT "DAT" FILE CONVERSION....
C
     	    IF( IQS.GT.ILIS2 ) GOTO 222
     	    IFLI = IQS
     	    CALL COLORS(-1)
     	    CALL PUTEXT( FILTYP(IFLI), 24, IL(IFLI), IC(IFLI) )
     	ELSE
     	    IF( IQS.EQ.IFLI .AND. IQS.GT.IDIF2 ) GOTO 222
     	    IF( IFLI.EQ.ILIS2 ) THEN
     		IF( IQS.LT.IDAT1 .OR. IQS.GT.IDAT2 ) GOTO 222
     	    ENDIF
C
C  NO OUTPUT "PLT" OR "LIS" FILE CONVERSION...
C
     	    IF( IQS.GT.IDIF2 .AND. IQS.LT.IDAT1 ) GOTO 222
C
C  NO "RAW" TO "DIF" OR "HKL" FILE CONVERSION...
C
     	    IF( IFLI.LT.IDIF1 ) THEN
     		IF( IQS.GT.IRAW2 .AND. IQS.LT.IPLT1 ) GOTO 222
     		IF( IQS.EQ.IDAT1+1 ) GOTO 222
     	    ENDIF
C
C  NO "DIF" TO "RAW" FILE CONVERSION...
C
     	    IF( IFLI.GT.IRAW2 .AND. IFLI.LT.IPLT1 ) THEN
     		IF( IQS.LT.IDIF1 ) GOTO 222
     	    ENDIF

     	    IFLO = IQS
     	    IF( IFLI.NE.IFLO ) THEN
     	        CALL COLORS(-1)
     	        CALL PUTEXT( FILTYP(IFLO), 24, IL(IFLO), IC(IFLO) )
     	    ENDIF
     	ENDIF
     	IF( IFLO.EQ.0 ) GOTO 100
     	GOTO 200
C
C  ERROR TRANSFER...
C
111	CALL COLORS(-1)
     	CALL PUTEXT( 'ERROR: undefined file type.', 27, 24, 1 )
     	GOTO 100
222	CALL COLORS(-1)
     	CALL PUTEXT( 'ERROR: invalid file conversion route.', 37,24,1 )
     	GOTO 100
333	IF( TEXT(1:1).EQ.'?' ) GOTO 555
     	IF( TEXT(1:4).EQ.'HELP' ) GOTO 555
     	CALL CURSOR( 24, 1 )
     	CALL CLEARS( 6)
     	CALL COLORS(-1)
     	CALL PUTEXT( 'ERROR: invalid entry.', 21,24,1 )
     	GOTO 100
444	IF( IFLI.EQ.0 ) GOTO 999
445	CALL PUTEXT( FILTYP(IFLI), 24, IL(IFLI), IC(IFLI) )
     	CALL PUTEXT( FILNUM(IFLI),  4, IL(IFLI), IC(IFLI)-5 )
     	IF( IFLO.GT.0 ) THEN
     	    CALL PUTEXT( FILTYP(IFLO), 24, IL(IFLO), IC(IFLO) )
     	    CALL PUTEXT( FILNUM(IFLO),  4, IL(IFLO), IC(IFLO)-5 )
     	ENDIF
     	CALL CURSOR(LINE,1)
     	CALL CLEARS( 2)
     	GOTO 9
C
C  DISPLAY HELP ON FILE TYPES...
C
555	CALL CURSOR( 2, 1 )
     	CALL CLEARS( 2)
     	WRITE(6,556)
556	FORMAT(' FILECONV supports the following types of files:'/
     	16x'RAW --- Raw data or pattern scan file (max 10,000 points).'/
     	16x'DIF --- Peak D-spacing and Intensity file (max 500 peaks).'/
     	16x'PLT --- Output data file written for plotting.'/
     	16x'LIS --- Output log file written for list of results.'/
     	16x'DAT --- Data file ready to be plotted by GRAFIT.'/
     	16x'HKL --- HKL and D-spacing file to be overlaid by GRAFIT.'/
     	16x'LP  --- ASCII list file for line printer.'/
     	2' The following file conversion routes are implemented:'/
     	26x'[1] RAW ===> RAW              [6] DIF ===> DIF'/
     	26x'[2] RAW ===> DAT              [7] DIF ===> DAT'/
     	26x'[3] RAW ===> LP               [8] DIF ===> LP'/
     	26x'[4] LIS ===> HKL              [9] DIF ===> HKL'/
     	26x'[5] LIS ===> DAT             [10] PLT ===> DAT'/
     	3' "Keyboard_DIF" is an editor written d/I file which consists'/
     	3' of peak entries in one of the two line formats:'/
     	3'      1)  d-spacing(A), intensity(%), FWHM, H, K, L'/
     	3'      2)  2-theta(deg), intensity(%), FWHM, H, K, L'/
     	3' where FWHM and H,K,L are optional.'/
     	3' When entering a filename for either input or output, file',
     	3' extension is'/' optional with its file type as its default',
     	3' file extension.')
     	CALL COLORS(-1)
     	WRITE(6,446)
446	FORMAT('$Hit RETURN to continue...')
     	READ(5,101,ERR=1,END=1) TEXT
     	GOTO 1
C
C  DETERMINE THE INPUT/OUTPUT FILE CATEGORY...
C
200	IF( IFLI.GE.IRAW1 .AND. IFLI.LE.IRAW2 ) ITYI = 1
     	IF( IFLI.GE.IDIF1 .AND. IFLI.LE.IDIF2 ) ITYI = 2
     	IF( IFLI.GE.IPLT1 .AND. IFLI.LE.IPLT2 ) ITYI = 3
     	IF( IFLI.GE.ILIS1 .AND. IFLI.LE.ILIS2 ) ITYI = 4
     	IF( IFLO.GE.IRAW1 .AND. IFLO.LE.IRAW2 ) ITYO = 1
     	IF( IFLO.GE.IDIF1 .AND. IFLO.LE.IDIF2 ) ITYO = 2
     	IF( IFLO.EQ.IDAT1  ) ITYO = 5
     	IF( IFLO.EQ.IDAT1+1) ITYO = 6
     	IF( IFLO.EQ.IDAT1+2) ITYO = 7
     	IF( IFLO.EQ.NTYP   ) ITYO = 99
     	GOTO 220
C
C  GET THE INPUT FILENAME...
C
210	IF(IFLI.NE.IFLO) CALL PUTEXT(FILNUM(IFLO),4,IL(IFLO),IC(IFLO)-5)
220	CALL CURSOR(LINE,1)
     	CALL CLEARS( 2)
300	CALL COLORS(-1)
     	CALL COLORS(9)
     	CALL PUTEXT( FILNUM(IFLI), 4, IL(IFLI), IC(IFLI)-5 )
     	CALL COLORS(1)
     	TEXT = ' '
     	CALL PUTEXT( TEXT, 80, LINE, 1 )
     	TEXT = 'Enter  input filename: '
     	CALL PUTEXT( TEXT, 23, LINE, 1 )
     	READ(5,2001,ERR=445,END=445) FILINP
2001	FORMAT(A)
     	IF( FILINP.EQ.' ' ) GOTO 445
C
C  LOOK FOR DEFAULT FILE EXTENSION...
C
    	IF( ITYI.EQ.1 ) CALL DEFEXT( FILINP, 'RAW' )
    	IF( ITYI.EQ.2 ) CALL DEFEXT( FILINP, 'DIF' )
    	IF( ITYI.EQ.3 ) CALL DEFEXT( FILINP, 'PLT' )
    	IF( ITYI.EQ.4 ) CALL DEFEXT( FILINP, 'LIS' )
     	NCH = NALPHA( FILINP, -32 )	!CONVERT UPPERCASES
C
C  GET THE OUTPUT FILENAME...
C
     	IF( IFLI.NE.IFLO ) THEN
     	    CALL PUTEXT( FILNUM(IFLI), 4, IL(IFLI), IC(IFLI)-5 )
     	    CALL COLORS(-1)
     	    CALL COLORS(9)
     	    CALL PUTEXT( FILNUM(IFLO), 4, IL(IFLO), IC(IFLO)-5 )
     	ENDIF
301	TEXT = ' '
     	CALL COLORS(1)
     	CALL PUTEXT( TEXT, 80, LINE+1, 1 )
     	IF( ITYI.EQ.ITYO ) THEN
3011	    TEXT = 'Enter output filename: '
     	    CALL PUTEXT( TEXT, 23, LINE+1, 1 )
     	    READ(5,2001,ERR=210,END=210) FILOUT
     	    IF( FILOUT.EQ.' ' ) GOTO 210
     	ELSE
     	    TEXT = ' '
     	    TEXT(1:22) = 'Enter output filename<'
    	    IF( ITYO.EQ.1 ) CALL NAMEXT( FILINP, DEFFIL, 'RAW' )
    	    IF( ITYO.EQ.2 ) CALL NAMEXT( FILINP, DEFFIL, 'DIF' )
    	    IF( ITYO.EQ.5 ) CALL NAMEXT( FILINP, DEFFIL, 'DAT' )
    	    IF( ITYO.EQ.6 ) CALL NAMEXT( FILINP, DEFFIL, 'HKL' )
    	    IF( ITYO.EQ.7 ) CALL NAMEXT( FILINP, DEFFIL, 'DAT' )
    	    IF( ITYO.EQ.99) CALL NAMEXT( FILINP, DEFFIL, 'LP' )
     	    IF( DEFFIL.EQ.FILINP ) GOTO 3011
     	    TEXT(23: ) = DEFFIL(1: )
     	    NCH = NALPHA( TEXT(1: ), 80 )
     	    TEXT(NCH+1: ) = '>: '
     	    CALL PUTEXT( TEXT(1: ), NCH+3, LINE+1, 1 )
     	    READ(5,2001,ERR=210,END=210) FILOUT
     	    IF( FILOUT.EQ.' ' ) FILOUT = DEFFIL
     	ENDIF
C
C  LOOK FOR DEFAULT FILE EXTENSION...
C
    	IF( ITYO.EQ.1 ) CALL DEFEXT( FILOUT, 'RAW' )
    	IF( ITYO.EQ.2 ) CALL DEFEXT( FILOUT, 'DIF' )
    	IF( ITYO.EQ.5 ) CALL DEFEXT( FILOUT, 'DAT' )
    	IF( ITYO.EQ.6 ) CALL DEFEXT( FILOUT, 'HKL' )
    	IF( ITYO.EQ.7 ) CALL DEFEXT( FILOUT, 'DAT' )
    	IF( ITYO.EQ.99) CALL DEFEXT( FILOUT, 'LP' )
     	NCH = NALPHA( FILOUT, -32 )	!CONVERT UPPERCASES
     	IF( FILINP.NE.FILOUT ) GOTO 302

     	CALL COLORS(-1)
     	CALL PUTEXT('ERROR: no duplicating filename allowed.',39,24,1)
     	GOTO 301

302	CALL COLORS(1)
     	CALL PUTEXT( FILNUM(IFLO), 4, IL(IFLO), IC(IFLO)-5 )
     	CALL CURSOR( 24, 1 )
     	CALL CLEARS( 6)
     	IF( ITYI.NE.3 ) THEN
     	CALL COLORS(-1)
     	CALL PUTEXT('Reading the input file... Please wait...',40,24,1)
     	ENDIF
C
C  INITIALIZE THE COMMON BLOCKS...
C
     	IF( ITYI.NE.3 ) CALL INICOM	!INITIALIZE THE COMMON BLOCKS
     	IERR = 0			!ERROR FLAG OFF
     	JFIL = IFLI			!FILE TYPE NOT SUPPORTED
C
C  READ FROM THE INPUT FILE AND STORE IN THE COMMON BLOCKS...
C
     	IF( IFLI.EQ.1  ) CALL RRW500	!DIFFRAC-500		RAW
     	IF( IFLI.EQ.2  ) CALL RRW011	!DIFFRAC-11  		RAW
     	IF( IFLI.EQ.3  ) CALL RRW05A	!DIFFRAC-5 (ALFRED)	RAW
     	IF( IFLI.EQ.4  ) CALL RRW05S	!DIFFRAC-5 (SIEMENS)	RAW
     	IF( IFLI.EQ.5  ) CALL RRWSPP	!SPECPLOT		RAW
     	IF( IFLI.EQ.6  ) CALL RRWNIC	!NICOLET		RAW
     	IF( IFLI.EQ.7  ) CALL RRWTAG	!SCINTAG		RAW
     	IF( IFLI.EQ.8  ) CALL RRWRIG	!RIGAKU (ASCII)		RAW
     	IF( IFLI.EQ.9  ) CALL RRWRIO	!RIGAKU OLD BINARY   	RAW
     	IF( IFLI.EQ.10 ) CALL RRWMDI	!MDI (ASCII)		RAW
     	IF( IFLI.EQ.11 ) CALL RRWSAS	!UNKNOWN		RAW
     	IF( IFLI.EQ.12 ) CALL RRWSHA	!SHADOW (ALFRED)	RAW
     	IF( IFLI.EQ.13 ) CALL RRWXRR	!X-RAY RIETVELD		RAW
     	IF( IFLI.EQ.14 ) CALL RRWNBS	!NBS RIETVELD		RAW
     	IF( IFLI.EQ.15 ) CALL RRWX7	!NSLS-X7 (BNL)		RAW
     	IF( IFLI.EQ.16 ) CALL RRWX3	!NSLS-X7 (SUNY)		RAW
     	IF( IFLI.EQ.17 ) CALL RRWPDF	!JCAMP-PDF3		RAW
    	IF( IFLI.EQ.18 ) CALL RRWUNK	!UNKNOWN 		RAW
C
     	IF( IFLI.EQ.21 ) CALL RDI500	!DIFFRAC-500		DIF
     	IF( IFLI.EQ.22 ) CALL RDI011	!DIFFRAC-11		DIF
     	IF( IFLI.EQ.23 ) CALL RDI05A	!DIFFRAC-5 (ALFRED)	DIF
     	IF( IFLI.EQ.24 ) CALL RDI05S	!DIFFRAC-5 (SIEMENS)	DIF
     	IF( IFLI.EQ.25 ) CALL RDISPP	!SPECPLOT		DIF
     	IF( IFLI.EQ.26 ) CALL RDINIC	!NICOLET		DIF
     	IF( IFLI.EQ.27 ) CALL RDITAG	!SCINTAG		DIF
     	IF( IFLI.EQ.28 ) CALL RDIRIG	!RIGAKU 		DIF
     	IF( IFLI.EQ.29 ) CALL RDIUNK	!UNKNOWN 		DIF
     	IF( IFLI.EQ.30 ) CALL RDIMDI	!MDI	 		DIF
     	IF( IFLI.EQ.31 ) CALL RDIAID	!AIDS 			DIF
     	IF( IFLI.EQ.32 ) CALL RDIKEY	!KEYBOARD		DIF
     	IF( IFLI.EQ.41 ) CALL RPLSHA	!SHADOW			PLT
     	IF( IFLI.EQ.42 ) CALL RPLXRR	!X-RAY RIETVELD		PLT
     	IF( IFLI.EQ.43 ) CALL RPLNBS	!NBS RIETVELD		PLT
C     	IF( IFLI.EQ.44 ) CALL RPLUNK	!UNKNOWN		PLT
     	IF( IFLI.EQ.46 ) CALL RLSXRR	!X-RAY RIETVELD		LIS
     	IF( IFLI.EQ.47 ) CALL RLSNBS	!NBS RIETVELD		LIS
C     	IF( IFLI.EQ.48 ) CALL RLSUNK	!UNKNOWN		LIS

     	CLOSE( UNIT=IINP )
     	IF( IERR.GT.0 ) GOTO 777
     	IF( ITYI.EQ.1 .AND. NPTS.EQ.0 ) GOTO 777
     	IF( ITYI.NE.3 ) GOTO 400
     	IF( IERR.LT.0 ) GOTO 888
     	GOTO 500
C
C  CONDUCT THE DIALOGUE...
C
400	IF( ITYI.EQ.1 ) CALL DIARAW
     	IF( ITYI.EQ.2 .OR. ITYI.EQ.4 ) CALL DIADIF
     	IF( IERR.GT.0 ) GOTO 1		!BAIL OUT
     	IF( ITYO.EQ.5 ) GOTO 410
     	IF( IFLO.EQ.3 .OR. IFLO.EQ.4 ) GOTO 410
     	IF( IFLO.EQ.12.OR. IFLO.EQ.13) GOTO 410
     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)
C
C  WRITE TO THE OUTPUT FILE FROM THE COMMON BLOCKS...
C
410	IERR = 0			!ERROR FLAG OFF
     	JFIL = IFLO			!FILE TYPE NOT SUPPORTED
     	IF( IFLO.EQ.1  ) CALL WRW500	!DIFFRAC-500		RAW
     	IF( IFLO.EQ.2  ) CALL WRW011	!DIFFRAC-11  		RAW
     	IF( IFLO.EQ.3  ) CALL WRW05A	!DIFFRAC-5 (ALFRED)	RAW
     	IF( IFLO.EQ.4  ) CALL WRW05S	!DIFFRAC-5 (SIEMENS)	RAW
     	IF( IFLO.EQ.5  ) CALL WRWSPP	!SPECPLOT		RAW
     	IF( IFLO.EQ.6  ) CALL WRWNIC	!NICOLET		RAW
     	IF( IFLO.EQ.7  ) CALL WRWTAG	!SCINTAG		RAW
     	IF( IFLO.EQ.8  ) CALL WRWRIG	!RIGAKU			RAW
     	IF( IFLO.EQ.9  ) CALL WRWRIO	!RIGAKU			RAW
     	IF( IFLO.EQ.10 ) CALL WRWMDI	!MDI			RAW
     	IF( IFLO.EQ.11 ) CALL WRWSAS	!GSAS 			RAW
     	IF( IFLO.EQ.12 ) CALL WRWSHA	!SHADOW (ALFRED)	RAW
     	IF( IFLO.EQ.13 ) CALL WRWXRR	!X-RAY RIETVELD		RAW
     	IF( IFLO.EQ.14 ) CALL WRWNBS	!NBS RIETVELD		RAW
     	IF( IFLO.EQ.15 ) CALL WRWX7	!NSLS-X7		RAW
     	IF( IFLO.EQ.16 ) CALL WRWX3	!NSLS-X3		RAW
     	IF( IFLO.EQ.17 ) CALL WRWPDF	!JCAMP-PDF3		RAW
     	IF( IFLO.EQ.18 ) CALL WRWUNK	!UNKNOWN		RAW
     	IF( IFLO.EQ.21 ) CALL WDI500	!DIFFRAC-500		DIF
     	IF( IFLO.EQ.22 ) CALL WDI011	!DIFFRAC-11		DIF
     	IF( IFLO.EQ.23 ) CALL WDI05A	!DIFFRAC-5 (ALFRED)	DIF
     	IF( IFLO.EQ.24 ) CALL WDI05S	!DIFFRAC-5 (SIEMENS)	DIF
     	IF( IFLO.EQ.25 ) CALL WDISPP	!SPECPLOT		DIF
     	IF( IFLO.EQ.26 ) CALL WDINIC	!NICOLET		DIF
     	IF( IFLO.EQ.27 ) CALL WDITAG	!SCINTAG		DIF
     	IF( IFLO.EQ.28 ) CALL WDIRIG	!RIGAKU			DIF
     	IF( IFLO.EQ.29 ) CALL WDIUNK	!UNKNOWN		DIF
     	IF( IFLO.EQ.30 ) CALL WDIMDI	!MDI			DIF
     	IF( IFLO.EQ.31 ) CALL WDIAID	!AIDS			DIF
     	IF( IFLO.EQ.32 ) CALL WDIKEY	!KEYBOARD		DIF
     	IF( IFLO.EQ.51 ) CALL GRADAT	!GRAFIT			DAT
     	IF( IFLO.EQ.52 ) CALL GRAHKL	!GRAFIT			HKL
C     	IF( IFLO.EQ.53 ) CALL DATUNK	!UNKNOWN		DAT
     	IF( IFLO.EQ.60 ) CALL LPRINT	!LINE PRINTER		LP

     	IF( IERR.GT.0 ) GOTO 888	!ERROR DURING WRITE
500	CALL COLORS(-1)
     	CALL CLEARS( 6)
     	CALL PUTEXT( 'File conversion OK!', 20, 24, 1 )
     	CLOSE( UNIT=IOUT )
     	CALL PAUSES( 1 )
     	GOTO 1				!BACK THE MAIN MENU
C
C  ERROR FILE FORMAT IN THE INPUT FILE...
C
777	IF( IERR.EQ.3 ) GOTO 1
     	CALL COLORS(-1)
     	CALL CLEARS( 6)
     	IF( IERR.EQ.1 ) THEN
     	    CALL PUTEXT('ERROR: invalid file format in input file.',
     	1 41, 24, 1 )
     	ENDIF
     	IF( IERR.EQ.2 ) THEN
     	    TEXT = 'ERROR: can not find/open file'
     	    TEXT(31:) = FILINP
     	    NCH = NALPHA( TEXT, 80 )
     	    CALL PUTEXT( TEXT, NCH, 24, 1 )
     	ENDIF
     	CLOSE( UNIT=IINP )
     	GOTO 300
C
C  RUN OUT OF DISK QUOTA OR NO PRIVILEGE FOR WRITE...
C
888	IF( IERR.EQ.3 ) GOTO 1
     	CALL COLORS(-1)
     	CALL CLEARS( 6)
     	CALL PUTEXT('ERROR during write (disk quota/privilege?).',
     	1 43, 24, 1 )
     	CLOSE( UNIT=IOUT )
C
C  FINALLY...
C
999	CALL CLEARS(2)
     	CALL COLORS(1)
     	CALL EXIT
     	END
    	SUBROUTINE CLEARS( IC )
C
C   PROGRAMMER: R.S. ZHOU,	FEB-1986
C
C	THIS ROUTINE ERASES THE SCREEN AREA SPECIFIED BY "IC"
C	BY USING THE STANDARD ANSI COMMANDS.
C
C	IC = 0: ERASE THE ENTIRE SCREEN AND CURSOR HOME AT (1,1)
C	IC = 1: ERASE THE ENTIRE SCREEN AND CURSOR DOES NOT MOVE
C	IC = 2: ERASE FROM THE CURRENT CURSOR TO THE END OF SCREEN
C	IC = 3: ERASE FROM THE CURRENT CURSOR TO THE TOP OF SCREEN
C	IC = 4: ERASE FROM THE CURRENT CURSOR TO THE END OF LINE
C	IC = 5: ERASE FROM THE CURRENT CURSOR TO THE START OF LINE
C	IC = 6: ERASE THE ENTIRE LINE OF CURRENT CURSOR.
C
    	BYTE TEXT(8)
    	DATA TEXT / 0, 27, 91, 0, 0, 27, 91, 72 /
C
    	II = IC
    	TEXT(5) = 74
    	IF( II.GT.3 ) TEXT(5) = 75
    	TEXT(4) = 50
    	IF( II.EQ.2 .OR. II.EQ. 4 ) TEXT(4) = 48
    	IF( II.EQ.3 .OR. II.EQ. 5 ) TEXT(4) = 49
    	IE = 5
    	IF( II.EQ.0 ) IE = 8
     	WRITE(6,1) (TEXT(I),I=1,IE)
1	FORMAT(<IE>A1$)
    	RETURN
     	END
     	SUBROUTINE CODDAT( DAY, CDAY )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE DECODES D-500 SYSTEM DATE
C
     	CHARACTER DAY*9, DAT*6
     	CHARACTER*36 MONTHS
     	DATA MONTHS/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/

     	DAY = '00-000-00'
     	IF( CDAY.GT.0.0 ) THEN
     	    IDAY = CDAY
     	    ENCODE( 6, 1, DAT ) IDAY
     	    DAY(1:2) = DAT(1:2)
     	    DECODE( 2, 1, DAT(3:4) ) IVAL
     	    DAY(4:6) = MONTHS( IVAL : IVAL+2 )
     	    DAY(8:9) = DAT(5:6)
     	ENDIF
1	FORMAT(I6)

     	RETURN
     	END
     	SUBROUTINE CODTIM( TIM, RTIM )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE DECODES D-500 SYSTEM TIME
C
     	CHARACTER TIM*8, ATIM*6

     	TIM = '00:00:00'
     	ITIM = RTIM
     	ENCODE( 6, 1, ATIM ) ITIM
     	TIM(1:2) = ATIM(1:2)
     	TIM(4:5) = ATIM(3:4)
     	TIM(7:8) = ATIM(5:6)
1	FORMAT(I6)

     	RETURN
     	END
    	SUBROUTINE COLORS( IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE IMPLEMENTS THE STANDARD ANSI GRAPHICS RENDITIONS
C
C	IC=#*, # = background color 1 to 7, 0 = unchanged.
C	       * = character color  1 to 7, 0 = unchanged.
C	IC=0 means 17: white characters on black background.
C
C	If IC<0, reverse video is on, otherwise off (if not unchanged colors).
C	If *=9 blink on (e.g. IC=9 just blinking)
C	If #=9 underscore on (.e.g. IC=90 just underscore)
C	If #=8 bold display on (.e.g. IC=80 just bold)
C
    	BYTE TEXT(6)
    	DATA TEXT / 0, 27, 91, 0, 0, 109 /
C
C   TEXT = <ESC>[00m
C
    	IC0 = IC
     	IF( IC0.EQ.0 ) THEN
     	    IC0 = 1
     	    IC1 = 7
     	ELSE
    	    IR = 0
    	    IF( IC0.LT.0 ) IR = 1
    	    IC1 = IABS(IC0)
     	    IC0 = IC1/10
    	    IC1 = IC1 - IC0*10
    	ENDIF

    	IF( IC0.LT.8 .AND. IC1.LT.8 ) THEN
    	    TEXT(4) = 48
    	    TEXT(5) = 48
     	    WRITE(6,1) TEXT  		!ALL ATTRIBUTES OFF
    	ENDIF
     	IF( IR.EQ.1 ) THEN
    	    TEXT(4) = 48
    	    TEXT(5) = 55		!REVERSE VIDEO ON
     	    WRITE(6,1) TEXT
     	ENDIF

     	IF( IC0.NE.0 ) THEN
     	    IF( IC0.EQ.8 ) THEN
    	    	TEXT(4) = 0
    	    	TEXT(5) = 49		!BOLD PRINT ON
     	    	WRITE(6,1) TEXT
     	    ENDIF
     	    IF( IC0.EQ.9 ) THEN
    	    	TEXT(4) = 0
    	    	TEXT(5) = 52		!UNDERSCORE ON
     	    	WRITE(6,1) TEXT
     	    ENDIF
C    	    IF( IC0.LT.8 ) THEN
C    	    	TEXT(4) = 52
C    	    	TEXT(5) = 48 + IC0	!BACKGROUND COLOR
C     	    	WRITE(6,1) TEXT
C     	    ENDIF
     	ENDIF

     	IF( IC1.NE.0 ) THEN
     	    IF( IC1.EQ.9 ) THEN
    	    	TEXT(4) = 0
    	    	TEXT(5) = 53		!BLINK ON
     	    	WRITE(6,1) TEXT
C     	    ELSE
C    	    	TEXT(4) = 51
C    	    	TEXT(5) = 48 + IC1	!CHARACTER COLOR
C     	    	WRITE(6,1) TEXT
     	    ENDIF
     	ENDIF
1	FORMAT(6A1$)
    	RETURN
     	END
    	SUBROUTINE COMMAS( TEXT, NK, NF, GF, KF, NLS )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY
C		NOV-1986
C
C	THIS ROUTINE IMPLEMENTS A FREE FORMAT INPUT PROCESSOR.
C
C	TEXT --- INPUT TEXTSTRING IN CHARACTER FORMAT TO BE DECODED.
C	NK ----- SIZE OF THE "TEXT" IN NUMBER OF CHARACTERS.
C	NF ----- NUMBER OF REAL*4 DECIMALS TO BE DECODED FROM THE "TEXT".
C	GF ----- REAL*4 ARRAY TO STORE THE DECODED DECIMALS.
C	KF ----- INTEGER ARRAY TO FLAG WHICH ELEMENT OF THE "GF"
C	         ARRAY GETS AN INPUT: 0=NO, 1=YES.
C	NLS ---- THE POSITION OF THE LAST CHARACTER IN THE "TEXT" 
C	         THAT DOESN'T GET DECODED. IN OTHER WORDS, IT FLAGS
C	         HOW MANY CHARACTERS HAVE BEEN USED, COUNTED FROM
C	         THE LEFT TO RIGHT IN THE "TEXT", TO DECODE THE "NF" 
C	         REAL*4 DECIMALS.
C
C	COMMENTS:
C
C	THE FIELD SEPARATOR CAN BE EITHER A SPACE OR SPACES OR COMMA.
C	TO SKIP A FIELD, YOU HAVE TO USE THE COMMAS AND THE INPUT 
C	PROCESSOR RETURNS WITH ITS "KF" = 0.
C
C	INTEGER FIELDS ARE DECODED AND STORED IN THE "GF" AS DECIMAL 
C	NUMBERS. THEREFORE DECIMAL NUMBERS CAN BE ENTERED AS INTEGERS
C	AND VICE VERSA.
C
C	AN ERROR RESULTS IF THE INPUT PROCESSOR ENCOUNTERS TRAILING
C	TEXT CHARACTERS IN THE "TEXT" BEFORE THE "NF"TH DATA FIELD 
C	GOT DECODED FROM THE "TEXT" AND IT RETURNS WITH "NK" = 0.
C	THEREFORE THE VALUE OF "NK" MUST BE PASSED BY AN ARGUMENT
C	INSTEAD OF THE ACTUAL NUMBER AND THEREFORE THE CALLING ROUTINE 
C	SHOULD ALWAYS CHECK THE RETURNED "NK" FOR POSSIBLE ERROR INPUT.
C	IF THERE IS NO TRAILING TEXT CHARACTERS IN THE "TEXT", THE
C	"TEXT" CAN HAVE FEWER THAN "NF" NUMBER OF DATA FIELDS AND
C	THE REST OF "GF" ARE FILLED WITH VALUES 0.0s AND THEIR "KF"s
C	WITH 0s.
C
    	REAL*4 GF(NF)
    	CHARACTER SYM*1, BEL*1, STRN*40, TEXT(NK)*1
    	DIMENSION KF(NF), NCS(50), NSP(50)

    	NFS = NF
    	DO I=1, NFS
    	   KF(I) = 0
    	   GF(I) = 0.0
    	ENDDO
    	NLS = 0
    	NCH = NK
    	IF( NCH.EQ.0 ) GOTO 999
    	JMS = 1
    	NCS(JMS) = 0
    	NSP(JMS) = 0
    	BEL = ','
    	ICI = 0

    	DO 9 I=1, NCH
    	SYM = TEXT(I)
    	IF( SYM.NE.',' ) GOTO 1
    	    IF( BEL.NE.' ' .OR. ICI.EQ.0 ) THEN
    	        JMS = JMS + 1
    		IF( ICI.EQ.0 ) THEN
    		    NSP(JMS) = I - NCS(JMS-1)
    		ELSE
    		    NSP(JMS) = 0
    		ENDIF
    	    ELSE
    	        NSP(JMS) = I - NCS(JMS)
    	    ENDIF
    	    NCS(JMS) = I
    	    NLS = I + 1
    	    ICI = 0
    	GOTO 6
1	IF( SYM.NE.' ' .OR. BEL.EQ.' ' .OR. BEL.EQ.',' ) GOTO 5
    	    JMS = JMS + 1
    	    NCS(JMS) = I
    	    NSP(JMS) = 0
    	GOTO 8
5	IF( SYM.EQ.' ' ) GOTO 8
    	NLS = I
6	IF( JMS.GT.NFS ) GOTO 10
8	BEL = SYM
    	IF( SYM.NE.' ' .AND. SYM.NE.',' ) ICI = 1
9	CONTINUE

    	NLS = I
    	JMS = JMS + 1
    	NCS(JMS) = I
    	NSP(JMS) = 0

10	DO I=1,JMS-1
    	   I1 = NCS(I) + 1
    	   I2 = NCS(I+1) - 1 - NSP(I+1)
    	   NCH = I2 - I1 + 1
     	   IF( NCH.GT.40 ) GOTO 888
    	   IF( NCH.GT.0 ) THEN
     	       NCH = 0
     	       DO J=I1,I2
     		  NCH = NCH + 1
    	          STRN(NCH:NCH) = TEXT(J)
     	       ENDDO
    	       IDOT = INDEX( STRN(1:NCH), '.' )
    	       IF( IDOT.EQ.0 ) THEN
    		   NCH = NCH + 1
    		   STRN(NCH:NCH) = '.'
    	       ENDIF
    	       DECODE( NCH, 20, STRN, ERR=888 ) GF(I)
    	       KF(I) = 1
    	   ENDIF
    	ENDDO
20	FORMAT(G40.30)
    	GOTO 999
888	NK = 0
999	RETURN
    	END
    	SUBROUTINE CURSOR( IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE POSITIONS THE ALPHA CURSOR
C
C		AT SCREEN   LINE --- IL
C		AT SCREEN COLUMN --- IC
C
C	IN DIALOGUE AREA BY ANSI CURSOR COMMANDS.
C
C		1<=IL<=30,     1<=IC<=80
C
C	IF IL=0, IC SPECIFIES CURSOR RIGHTWARD/LEFTWARD MOTION;
C	IF IC=0, IL SPECIFIES CURSOR UP/DOWN MOTION:
C
C		POSITIVE NUMBER ===> DOWN/LEFTWARD
C		NEGATIVE NUMBER ===> UP/RIGHTWARD
C
C	IF BOTH IC=0,IL=0, CURSOR MOTION IS ONE LINE DOWN.
C
    	BYTE CUR1(9), CUR2(6), CUR3(6), CUR4(6), CUR5(6)

    	DATA CUR1/ 0, 27, 91, 0, 0, 59, 0, 0, 72 /	!<ESC>[00;00H (POSITION)
    	DATA CUR2/ 0, 27, 91, 0, 0, 65 /		!<ESC>[00A (UP)
    	DATA CUR3/ 0, 27, 91, 0, 0, 66 /		!<ESC>[00B (DOWN)
    	DATA CUR4/ 0, 27, 91, 0, 0, 67 /		!<ESC>[00C (RIGHT)
    	DATA CUR5/ 0, 27, 91, 0, 0, 68 /		!<ESC>[00D (LEFT)

     	ILL = IABS(IL)
     	IF( ILL.GT.30 ) ILL = 30
     	ICC = IABS(IC)
     	IF( ICC.GT.80 ) ICC = 80
     	IL0 = ILL/10
     	IL1 = ILL-10*IL0
     	IC0 = ICC/10
     	IC1 = ICC-10*IC0

     	IF( IL.GT.0 .AND. IC.GT.0 ) THEN
     	    CUR1(4) = IL0+48
     	    CUR1(5) = IL1+48
     	    CUR1(7) = IC0+48
     	    CUR1(8) = IC1+48
     	    WRITE(6,1) CUR1
     	ENDIF

     	IF( IC.EQ.0 ) THEN
     	    IF( IL.LT.0 ) THEN
     		CUR2(4) = IL0+48
     		CUR2(5) = IL1+48
     		WRITE(6,1) CUR2
     	    ELSE
     		CUR3(4) = IL0+48
     		CUR3(5) = IL1+48
     		WRITE(6,1) CUR3
     	    ENDIF
     	ENDIF

     	IF( IL.EQ.0 ) THEN
     	    IF( IC.LT.0 ) THEN
     		CUR4(4) = IC0+48
     		CUR4(5) = IC1+48
     		WRITE(6,1) CUR4
     	    ELSE
     		CUR5(4) = IC0+48
     		CUR5(5) = IC1+48
     		WRITE(6,1) CUR5
     	    ENDIF
     	ENDIF

1	FORMAT(9A1$)
    	RETURN
     	END
     	FUNCTION DATCOD( DAY )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE ENCODES D-500 SYSTEM DATE
C
     	CHARACTER DAY*9, DAT*6
     	CHARACTER*36 MONTHS
     	DATA MONTHS/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/

     	DATCOD = 0.0
     	IVAL = INDEX( MONTHS, DAY(4:6) )
     	IF( IVAL.GT.0 ) THEN
     	    DAT(1:2) = DAY(1:2)
     	    ENCODE( 2, 1, DAT(3:4) ) IVAL
     	    DAT(5:6) = DAY(8:9)
     	    DECODE( 6, 2, DAT, ERR=9 ) VAL
     	    DATCOD = VAL
     	ENDIF
1	FORMAT(I2)
2	FORMAT(F7.0)
9	RETURN
     	END
     	SUBROUTINE DATUNK
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A ??? DATA FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE DEFEXT( FNAME, EXT )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY-1987
C
C	THIS ROUTINE ATTACHES THE DEFAULT FILE EXTENSION
C	"EXT" TO A FILE "FNAME" MISSING ITS FILE EXTENSION.
C
     	CHARACTER FNAME*(*), EXT*(*)

     	IF( FNAME.EQ.' ' ) RETURN
     	N = INDEX( FNAME, ']' ) + 1
     	N = INDEX( FNAME(N:), '.' )
     	IF( N.GT.0 ) RETURN		!WITH FILE EXTENSION
     	N = INDEX( FNAME, ' ' )
     	FNAME(N:N) = '.'
     	FNAME(N+1:) = EXT
     	RETURN
     	END
     	SUBROUTINE DIADIF
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE CONDUCTS THE INTERATIVE DIALOGUE
C	FOR INPUT DIFILE CONVERSION.
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER TEXT*80, SAMP*80, USER*12, SYM*1, KEY*2
    	DIMENSION RP(10), KP(10)
     	EQUIVALENCE (SAMP, SLID), (USER, NAME)

     	LTYP = 0		!OUTPUT PEAK TYPE FLAG: ALL PEAKS
     	IPEAK = 1		!PEAK # POINTER (BEING DISPLAYED)
C
C  SCREEN THE LISTED PEAKS BY "CUTI" AND "CUTF"...
C
     	CALL SCREEN( LTYP, IPEAK )
C
C  DISPLAY THE DIALOGUE MENU...
C
1	CALL CLEARS( 0 )
     	CALL COLORS(-1)
     	CALL COLORS(80)
     	TEXT = 'VAXCONV --- Dialogue Menu for D/I File Conversion'
     	CALL HEADER( TEXT )
     	CALL COLORS(1)
     	WRITE(6,2)
2	FORMAT(
     	1'  INPUT FILE:',27X,'INPUT FILE TYPE:'/
     	1' OUTPUT FILE:',26X,'OUTPUT FILE TYPE:'/
     	1' 1=SAMPLE ID:'/' 2=RUN DATE:',11X,'3=RUN TIME:',10X,'4=USER',
     	1' NAME:'/' 5=ANODE:'4X'6=KA1:'9X'7=KA2:'9X'8=KA:',
     	19X'9=KA1/KA2 RATIO:'/' 10=INTENSITY CUTOFFS(%):',16X,'11=FWHM',
     	1' CUTOFFS(D):'/' 12=OUTPUT PEAK TYPE(S) (0=ALL,1=KA1 ONLY):',
     	17X'13=USE RESIDUAL PATTERN:'/X,80('=')/' Only the numbered',
     	1' fields can be accessed to and be changed interactively.'/
     	1' e.g. INPUT> 1=Silicon internal calibration run<return>')
     	CALL COLORS(90)		!UNDERLINE ON
     	WRITE(6,3)
3	FORMAT(' TOT #TH    2-THETA(O,C)   D(O)    D(C)',
     	1'  REL.INT   AREA     FWHM    H  K  L TYPE ')
     	CALL COLORS(1)		!UNDERLINE OFF
     	WRITE(6,4)
4	FORMAT(7X,'1>'/,X,80('=')/' In the above, O=Observed,',
     	1' C=Calibrated. To edit peaks, do the followings:'/
     	1' INPUT> 20;<return> ---> show peak #20; INPUT> 20/<return>',
     	1' ---> delete peak #20'/' INPUT> 20>28.443 28.435,,,15,,0.23',
     	1' 1 1 1 ka1.....<return> ---> modify peak #20'/
     	1' INPUT> 999>65.45 65.455,,,20,,0.15 2 1 1 ka1.....<return>',
     	1' ---> add a new peak'/' INPUT> N<return> --> display next',
     	1' line;  INPUT> B<return> ---> back up.'/
     	1' Enter RE to refresh the menu; LIST, TYPE to list all peaks,',
     	1' CTRL_Z to quit.'/' Enter blank RETURN or EXIT to exit',
     	1' from the menu to start the conversion.'/,X,80('='))
C
C  INSERT THE PARAMETERS...
C
     	CALL COLORS(-1)			!REVERSE VIDEO ON

     	CALL PUTEXT( FILINP, 25, 2, 13 )
     	CALL PUTEXT( FILOUT, 25, 3, 13 )
     	CALL PUTEXT( FILTYP(IFLI), 24, 2, 57 )
     	CALL PUTEXT( FILTYP(IFLO), 24, 3, 57 )
     	CALL PUTEXT( SAMP, 68, 4, 13 )

     	CALL CODDAT( TEXT(1:9), DATM )
     	CALL PUTEXT( TEXT(1:9), 9, 5, 12  )
     	CALL CODTIM( TEXT(1:8), TIMM )
     	CALL PUTEXT( TEXT(1:8), 8, 5, 34  )
     	CALL PUTEXT( USER, 12, 5, 56 )

     	CALL PUTEXT( ANODE(IELE),  2, 6, 9 )
     	CALL PUTFFL( WAVE(1,IELE), 1, 7.4, 6, 19 )
     	CALL PUTFFL( WAVE(2,IELE), 1, 7.4, 6, 34 )
     	CALL PUTFFL( WAVE(3,IELE), 1, 7.4, 6, 48 )
     	CALL PUTFFL( WAVE(5,IELE), 1, 4.1, 6, 73 )

     	CALL PUTFFL( CUTI(1), 1, 5.1, 7, 25 )
     	CALL PUTFFL( CUTI(2), 1, 5.1, 7, 33 )
     	CALL PUTFFL( CUTF(1), 1, 5.3, 7, 60 )
     	CALL PUTFFL( CUTF(2), 1, 5.3, 7, 68 )
     	CALL PUTIFL( LTYP, 1, 2, 8, 43 )
     	IF( JRES.EQ.1 ) CALL PUTEXT( 'NO ', 3, 8, 74 )
     	IF( JRES.EQ.2 ) CALL PUTEXT( 'YES', 3, 8, 74 )

     	CALL PUTIFL( IPEAK, 1, 3, 13, 5 )
     	CALL PUTFFL( F2TH(IPEAK), 1, 7.3, 13, 10 )
     	CALL PUTFFL( C2TH(IPEAK), 1, 7.3, 13, 18 )
     	CALL PUTFFL( FDSP(IPEAK), 1, 7.4, 13, 26 )
     	CALL PUTFFL( CDSP(IPEAK), 1, 7.4, 13, 34 )
     	CALL PUTFFL( RELA(IPEAK), 1, 5.1, 13, 42 )
     	CALL PUTGFL( AREA(IPEAK,JRES), 1, 11.4, 13, 48 )
     	CALL PUTFFL( FWHM(IPEAK), 1, 5.3, 13, 60 )
     	CALL PUTIFL( PHKL(1,IPEAK), 3, 3, 13, 66 )
     	CALL PUTEXT( PEAK(IPEAK), 4, 13, 76 )
     	CALL COLORS(80)
     	CALL PUTIFL( NPKS, 1, 3, 13, 1 )
C
C  START THE DIALOGUE CYCLE...
C
111	CALL COLORS(1)
    	CALL PUTEXT( 'INPUT> ', 7, 23, 1 )
    	IERR = 1				!ERROR FLAG ON
    	READ(5,100,ERR=9999,END=9999) TEXT
100	FORMAT(A)

    	IERR = 0
    	IF( TEXT.EQ.' ' ) GOTO 999
     	NCHS = NALPHA( TEXT, 80 )
     	NCH  = NBLANK( TEXT(1:NCHS), NCHS )
     	IF( NCH.GT.0 ) THEN
     	    TEXT = TEXT(NCH+1:)
     	    NCHS = NCHS - NCH
     	ENDIF
    	SYM = TEXT(1:1)
     	KEY = TEXT(1:2)
     	NCH = NALPHA( SYM, -1 )
     	NCH = NALPHA( KEY, -2 )
    	IF( KEY.EQ.'EX' ) GOTO 999
     	IERR = 1
    	IF( KEY.EQ.'QU' ) GOTO 9999
    	IF( KEY.EQ.'RE' ) GOTO 1	!REFRESH THE MENU
    	IF( KEY.EQ.'LI'.OR. KEY.EQ.'TY' ) THEN
     	    IF( NPKS.EQ.0 ) GOTO 444			!NO PEAKS LISTED
     	    CALL SHOWPS					!SHOW ALL PEAKS
     	    GOTO 1					!REFRESH THE MENU
     	ENDIF
     	CALL CURSOR( 23, 1 )
    	CALL CLEARS( 2 )
     	IF( NCHS.GT.1 ) GOTO 101
     	IF( SYM.EQ.'N' ) GOTO 4321
     	IF( SYM.EQ.'B' ) GOTO 4322
     	GOTO 888
C
C  DECODE THE ENTRY NUMBER...
C
105	FORMAT(I)
101	IF( NCHS.LT.4 ) GOTO 110
     	DECODE( 3, 105, TEXT(1:3), ERR=110 ) INDX
     	GOTO 130
110	IF( NCHS.LT.3 ) GOTO 120
     	DECODE( 2, 105, KEY, ERR=120 ) INDX
    	GOTO 130
120	DECODE( 1, 105, SYM, ERR=888 ) INDX

130    	IF( INDX.LT.1 ) GOTO 777

    	NPS = INDEX( TEXT(1:4), '>' )
    	IF( NPS.GT.0 ) GOTO 1234	!PEAK EDIT
    	NPS = INDEX( TEXT(1:4), ';' )
    	IF( NPS.GT.0 ) GOTO 4320	!PEAK LIST
    	NPS = INDEX( TEXT(1:4), '/' )
    	IF( NPS.GT.0 ) GOTO 400		!PEAK DELETE
    	NPS = INDEX( TEXT(1:3), '=' )
    	IF( NPS.EQ.0 ) GOTO 888		!WRONG ACCESS
    	NCH = NCHS - NPS
     	IF( NCH.EQ.0 ) GOTO 111
     	CALL COLORS(-1)			!REVERSE VIDEO
    	CALL COLORS(80)			!INTENSE PRINT
    	NPS = NPS + 1
    	GOTO (50,51,52,53,54,55,55,55,55,56,56,55,57), INDX
C
C  ERROR TRANSFER...
C
777	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: entry value out of range. Entry ignored!',
     	1 48, 24, 1 )
    	GOTO 111
666	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: shown radiation source is not modifiable.',
     	1 49, 24, 1 )
     	GOTO 111
888    	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: invalid entry. Check spelling.',
     	1 38, 24, 1 )
    	GOTO 111
C
C  GET THE SAMPLE ID...
C
50	SAMP = TEXT(NPS:NCHS)
     	CALL PUTEXT( SAMP, 68, 4, 13 )
     	GOTO 111
C
C  GET THE DATE...
C
51	NCH = NALPHA( TEXT(1:NCHS), -NCHS )	!CONVERT TO UPPERCASES
     	DUMY = DATCOD( TEXT(NPS:NCHS) )
     	IF( DUMY.EQ.0.0 ) GOTO 888
     	DATM = DUMY
     	CALL CODDAT( TEXT(1:9), DATM )
     	CALL PUTEXT( TEXT(1:9), 9, 5, 12  )
     	GOTO 111
C
C  GET THE TIME...
C
52	NCH = NALPHA( TEXT(1:NCHS), -NCHS )	!CONVERT TO UPPERCASES
     	DUMY = TIMCOD( TEXT(NPS:NCHS) )
     	IF( DUMY.EQ.0.0 ) GOTO 888
     	TIMM = DUMY
     	CALL CODTIM( TEXT(1:8), TIMM )
     	CALL PUTEXT( TEXT(1:8), 8, 5, 34  )
     	GOTO 111
C
C  GET THE USER NAME...
C
53	USER = TEXT(NPS:NCHS)
     	CALL PUTEXT( USER, 12, 5, 56 )
     	GOTO 111
C
C  GET THE ANODE...
C
54	KEY = TEXT(NPS:(NPS+1))
     	NCH = NALPHA( KEY, -2 )			!CONVERT TO UPPERCASES
     	IF( KEY.EQ.ANODE(IELE) ) GOTO 111
     	DO I=1, 5
     	   IF( KEY.EQ.ANODE(I) ) GOTO 200
     	ENDDO
     	IELE = 6
     	ANODE(IELE) = KEY
     	CALL PUTEXT( ANODE(IELE), 2, 6, 9 )
     	CALL COLORS(-1)
     	CALL PUTEXT('_Please enter the correct values
     	1 for field 6,7,8,9.', 51, 24, 1 )
     	GOTO 111
C
C  DISPLAY NEW RADIATION...
C
200	IELE = I
     	CALL PUTEXT( ANODE(IELE), 2, 6, 9 )
     	CALL PUTFFL( WAVE(1,IELE), 1, 7.4, 6, 19 )
     	CALL PUTFFL( WAVE(2,IELE), 1, 7.4, 6, 34 )
     	CALL PUTFFL( WAVE(3,IELE), 1, 7.4, 6, 48 )
     	CALL PUTFFL( WAVE(5,IELE), 1, 4.1, 6, 73 )
     	IF( NPKS.EQ.0 ) GOTO 111
     	CALL LAMDAP	!RECALCULATE THE PEAK POSITIONS
     	GOTO 501
C
C  GET THE RADIATIONS AND PEAK TYPE...
C
55	IF( TEXT(NCHS:NCHS) .EQ. ',' ) NCHS = NCHS - 1
    	NCH = NCHS - NPS + 1
    	IF( NCH.EQ.0 ) GOTO 111
    	CALL COMMAS( TEXT(NPS:NCHS), NCH, 1, RP, KP, IDUM )
    	IF( NCH.EQ.0 ) GOTO 888		!ERROR INPUT

     	IF( INDX.LT.10 ) THEN
     	    IF( IELE.NE.6 ) GOTO 666
     	    IF( RP(1).LT.0.01 .OR. RP(1).GE.10.0 ) GOTO 777
     	    IF( INDX.EQ.6 ) THEN
     		WAVE(1,IELE) = RP(1)
     		CALL PUTFFL( RP(1), 1, 7.4, 6, 19 )
     	    ENDIF
     	    IF( INDX.EQ.7 ) THEN
     		WAVE(2,IELE) = RP(1)
     		CALL PUTFFL( RP(1), 1, 7.4, 6, 34 )
     	    ENDIF
     	    IF( INDX.EQ.8 ) THEN
     		WAVE(3,IELE) = RP(1)
     		CALL PUTFFL( RP(1), 1, 7.4, 6, 48 )
     	    ENDIF
     	    IF( INDX.EQ.9 ) THEN
     		WAVE(5,IELE) = RP(1)
     		CALL PUTFFL( RP(1), 1, 4.1, 6, 73 )
     	    ENDIF
     	    IF( NPKS.EQ.0 ) GOTO 111
     	    CALL LAMDAP			!RECALCULATE THE PEAK POSITIONS
     	    GOTO 501
     	ELSE
     	    IF( RP(1).LT.0 .OR. RP(1).GT.2 ) GOTO 777
     		IDUM = LTYP
     		LTYP = RP(1)
     		IF( IDUM.EQ.LTYP ) GOTO 111
     		CALL PUTIFL( LTYP,1, 2, 8, 43 )
     		IF( NPKS.EQ.0 ) GOTO 111
     		CALL SCREEN( LTYP, IPEAK )
     		GOTO 501
     	ENDIF
     	GOTO 111
C
C  GET THE RESIDUAL PATTERN FLAG...
C
57	IF( IRES.EQ.0 ) GOTO 555
     	NCH = JRES
     	JRES = 1
     	IF( TEXT(NPS:NPS).EQ.'Y'.OR.TEXT(NPS:NPS).EQ.'y' ) JRES= 2
     	IF( NCH.EQ.JRES ) GOTO 111
     	IF( JRES.EQ.1 ) CALL PUTEXT( 'NO ', 3, 8, 74 )
     	IF( JRES.EQ.2 ) CALL PUTEXT( 'YES', 3, 8, 74 )
     	IF( NPKS.EQ.0 ) GOTO 111
     	CALL SCREEN( LTYP, IPEAK )
     	GOTO 501

555	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: input file does not contain
     	1 a residual pattern.', 55, 24, 1 )
     	GOTO 111
C
C  GET THE INTENSITY/FWHM CUTOFFS...
C
56	IF( TEXT(NCHS:NCHS) .EQ. ',' ) NCHS = NCHS - 1
    	NCH = NCHS - NPS + 1
    	IF( NCH.EQ.0 ) GOTO 111
    	CALL COMMAS( TEXT(NPS:NCHS), NCH, 2, RP, KP, IDUM )
    	IF( NCH.EQ.0 ) GOTO 888		!ERROR INPUT

     	IF( INDX.EQ.10 ) THEN
     	    IF( KP(1).EQ.1 ) THEN
     	    	IF( RP(1).LT.0.1 .OR. RP(1).GT.50.0 ) GOTO 777
     	    	CUTI(1) = RP(1)
     	        CALL PUTFFL( CUTI(1), 1, 5.1, 7, 25 )
     	    ENDIF
     	    IF( KP(2).EQ.1 ) THEN
     	    	IF( RP(2).LT.50.0 .OR. RP(2).GT.100. ) GOTO 777
     	    	CUTI(2) = RP(2)
     	        CALL PUTFFL( CUTI(2), 1, 5.1, 7, 33 )
     	    ENDIF
     	ENDIF
     	IF( INDX.EQ.11 ) THEN
     	    IF( KP(1).EQ.1 ) THEN
     	    	IF( RP(1).LT.0.01 .OR. RP(1).GT.0.50 ) GOTO 777
     	    	CUTF(1) = RP(1)
     	        CALL PUTFFL( CUTF(1), 1, 5.3, 7, 60 )
     	    ENDIF
     	    IF( KP(2).EQ.1 ) THEN
     	    	IF( RP(2).LT.0.50 .OR. RP(2).GT.9.99) GOTO 777
     	    	CUTF(2) = RP(2)
     	        CALL PUTFFL( CUTF(2), 1, 5.3, 7, 68 )
     	    ENDIF
     	ENDIF
     	IF( NPKS.EQ.0 ) GOTO 111
     	CALL SCREEN( LTYP, IPEAK )
     	GOTO 501
C
C  SCAN THE PEAK LIST...
C
4320	IF( NPKS.EQ.0 ) GOTO 444
     	IF( INDX.GT.NPKS ) GOTO 777
     	IF( INDX.EQ.IPEAK ) GOTO 111
     	IPEAK = INDX
     	GOTO 501
4321	IF( NPKS.EQ.0 ) GOTO 444
     	IPEAK = IPEAK + 2
4322	IF( NPKS.EQ.0 ) GOTO 444
     	IPEAK = IPEAK - 1
     	IF( IPEAK.EQ.0 ) IPEAK = NPKS
     	IF( IPEAK.GT.NPKS ) IPEAK = 1
     	GOTO 501
444	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: number of peak recorded = 0 ', 36, 24, 1 )
     	GOTO 111
222	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: duplicated entry detected.
     	1 Entry ignored.', 49, 24, 1 )
     	GOTO 111
C
C	---------------------------------------
C	     P E A K    L I N E    E D I T
C	---------------------------------------
C
C  DECODE THE ENTRIES...
C
1234	IF( TEXT(NCHS:NCHS) .EQ. ',' ) NCHS = NCHS - 1
    	NCH = NCHS - NPS
    	IF( NCH.EQ.0 ) GOTO 111
    	NPS = NPS + 1
    	CALL COMMAS( TEXT(NPS:NCHS), NCH, 10, RP, KP, IDUM )
    	IF( NCH.EQ.0 ) GOTO 888		!ERROR INPUT
C
C  MODIFY AN EXISTING PEAK OR ADD A NEW PEAK...
C
     	IF( INDX.GT.NPKS ) THEN			!ADD A NEW PEAK
     	    IF( NPKS+1.GT.MNK ) GOTO 333	!LIMIT HIT
     	    INDX = NPKS + 1
     	ENDIF
C
C  GET THE PEAK TYPE...
C
     	PEAK(INDX) = TEXT(IDUM: )
     	NCH = NALPHA( PEAK(INDX), 4 )	!CONVERT TO UPPERCASES
     	NCH = 1
     	IF( PEAK(INDX).EQ.'KA2' ) NCH = 2
     	IF( PEAK(INDX).EQ.'KA' )  NCH = 3
     	IF( PEAK(INDX).EQ.'KB1' ) NCH = 4
     	IF( NCH.EQ.1 ) PEAK(INDX) = 'KA1'
C
C  STORE THE VALID NUMBERS...
C
     	IF( KP(1).EQ.1 ) THEN
     	    IF( RP(1).LT.1.0 .OR. RP(1).GT.179.0 ) GOTO 777
     	    DO I=1, NPKS
     		IF( ABS(F2TH(I)-RP(1)).LT.0.001 ) GOTO 222
     	    ENDDO
     	    F2TH(INDX) = RP(1)
     	    FDSP(INDX) = 0.5*WAVE(NCH,IELE)/SIN(DTOR*F2TH(INDX))
     	    IF( KP(2).EQ.0 .AND. KP(4).EQ.0 ) THEN
     	    	C2TH(INDX) = RP(1)
     	    	CDSP(INDX) = FDSP(INDX)
     	    ENDIF
     	ENDIF
     	IF( KP(2).EQ.1 ) THEN
     	    IF( RP(2).LT.1.0 .OR. RP(2).GT.179.0 ) GOTO 777
     	    DO I=1, NPKS
     		IF( ABS(C2TH(I)-RP(2)).LT.0.001 ) GOTO 222
     	    ENDDO
     	    C2TH(INDX) = RP(2)
     	    CDSP(INDX) = 0.5*WAVE(NCH,IELE)/SIN(DTOR*C2TH(INDX))
     	    IF( KP(1).EQ.0 .AND. KP(3).EQ.0 ) THEN
     	    	F2TH(INDX) = RP(2)
     	        FDSP(INDX) = CDSP(INDX)
     	    ENDIF
     	ENDIF
     	IF( KP(1).EQ.0 .AND. KP(3).EQ.1 ) THEN
     	    IF( RP(3).LE.0.0 .OR. RP(3).GT.99.9999 ) GOTO 777
     	    DO I=1, NPKS
     		IF( ABS(FDSP(I)-RP(3)).LT.0.0001 ) GOTO 222
     	    ENDDO
     	    FDSP(INDX) = RP(3)
     	    F2TH(INDX) = RTOD*ASIN(0.5*WAVE(NCH,IELE)/FDSP(INDX))
     	    IF( KP(2).EQ.0 .AND. KP(4).EQ.0 ) THEN
     	    	CDSP(INDX) = RP(3)
     	    	C2TH(INDX) = F2TH(INDX)
     	    ENDIF
     	ENDIF
     	IF( KP(2).EQ.0 .AND. KP(4).EQ.1 ) THEN
     	    IF( RP(4).LE.0.0 .OR. RP(4).GT.99.9999 ) GOTO 777
     	    DO I=1, NPKS
     		IF( ABS(CDSP(I)-RP(4)).LT.0.0001 ) GOTO 222
     	    ENDDO
     	    CDSP(INDX) = RP(4)
     	    C2TH(INDX) = RTOD*ASIN(0.5*WAVE(NCH,IELE)/CDSP(INDX))
     	    IF( KP(1).EQ.0 .AND. KP(3).EQ.0 ) THEN
     	        FDSP(INDX) = RP(4)
     	    	F2TH(INDX) = C2TH(INDX)
     	    ENDIF
     	ENDIF
     	IF( KP(5).EQ.1 ) THEN
     	    IF( RP(5).LT.CUTI(1) .OR. RP(5).GT.CUTI(2) ) GOTO 777
     	    RELA(INDX) = RP(5)
     	    IF( INDX.GT.1 ) THEN
     	AREA(INDX,JRES) = AREA(INDX-1,JRES)*RELA(INDX)/RELA(INDX-1)
     	    ELSE
     	IF( NPKS.LT.2 ) AREA(1,JRES) = RELA(1)
     	IF( NPKS.GT.1 ) AREA(1,JRES) = AREA(2,JRES)*RELA(1)/RELA(2)
     	    ENDIF
     	    PHGH(INDX) = AREA(INDX,JRES)
     	ENDIF
     	IF( KP(6).EQ.1 ) THEN
     	    IF( RP(6).LT.1.0 ) GOTO 777
     	    AREA(INDX,JRES) = RP(6)
     	    PHGH(INDX) = RP(6)
     	    IF( INDX.GT.1 ) THEN
     	    RELA(INDX) = RELA(INDX-1)*AREA(INDX,JRES)/AREA(INDX-1,JRES)
     	    ELSE
     	    IF( NPKS.LT.2 ) RELA(1)= AREA(1,JRES)
     	    IF( NPKS.GT.1 ) RELA(1)= RELA(2)*AREA(1,JRES)/AREA(2,JRES)
     	    ENDIF
     	    IF(RELA(INDX).LT.CUTF(1).OR.RELA(INDX).GT.CUTF(2)) GOTO 777
     	ENDIF
     	IF( INDX.GT.NPKS ) FWHM(INDX) = 0.1	!DEFAULT
     	IF( KP(7).EQ.1 ) THEN
     	    IF( RP(7).LT.CUTF(1) .OR. RP(7).GT.CUTF(2) ) GOTO 777
     	    FWHM(INDX) = RP(7)
     	ENDIF
     	IF( INDX.GT.NPKS ) PHKL(1,INDX) = 0	!DEFAULT
     	IF( KP(8).EQ.1 ) THEN
     	    IF( ABS(RP(8)).GT.99.0 ) GOTO 777
     	    PHKL(1,INDX) = RP(8)
     	ENDIF
     	IF( INDX.GT.NPKS ) PHKL(2,INDX) = 0	!DEFAULT
     	IF( KP(9).EQ.1 ) THEN
     	    IF( ABS(RP(9)).GT.99.0 ) GOTO 777
     	    PHKL(2,INDX) = RP(9)
     	ENDIF
     	IF( INDX.GT.NPKS ) PHKL(3,INDX) = 0	!DEFAULT
     	IF( KP(10).EQ.1 ) THEN
     	    IF( ABS(RP(10)).GT.99.0 ) GOTO 777
     	    PHKL(3,INDX) = RP(10)
     	ENDIF
     	IF( INDX.GT.NPKS ) NPKS = INDX
     	IPEAK = INDX
     	GOTO 500

333	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: max number of peaks hit.
     	1 No more peak to add.', 53, 24, 1 )
     	GOTO 111
C
C  DELETE A VALID PEAK...
C
400	IF( NPKS.EQ.0 ) GOTO 444
     	IF( INDX.GT.NPKS ) GOTO 777
     	NPKS = NPKS - 1
     	DO I= INDX, NPKS		!REPACK THE ARRAY
     	   F2TH(I) = F2TH(I+1)
     	   C2TH(I) = C2TH(I+1)
     	   FDSP(I) = FDSP(I+1)
     	   CDSP(I) = CDSP(I+1)
     	   RELA(I) = RELA(I+1)
     	   AREA(I,JRES) = AREA(I+1,JRES)
     	   PHGH(I) = PHGH(I+1)
     	   FWHM(I) = FWHM(I+1)
     	   PHKL(1,I) = PHKL(1,I+1)
     	   PHKL(2,I) = PHKL(2,I+1)
     	   PHKL(3,I) = PHKL(3,I+1)
     	   PEAK(I) = PEAK(I+1)
     	ENDDO
     	IF( NPKS.EQ.0 ) THEN
     	    F2TH(1) = 0.0
     	    C2TH(1) = 0.0
     	    FDSP(1) = 0.0
     	    CDSP(1) = 0.0
     	    RELA(1) = 0.0
     	    AREA(1,JRES) = 0.0
     	    PHGH(1) = 0.0
     	    FWHM(1) = 0.0
     	    PHKL(1,1) = 0
     	    PHKL(2,1) = 0
     	    PHKL(3,1) = 0
     	    PEAK(1) = ' '
     	ENDIF
     	IF( IPEAK.GT.NPKS ) IPEAK = NPKS
     	IF( IPEAK.EQ.0 ) IPEAK = 1
C
C  SCREEN THE PEAKS...
C
500	IF( NPKS.GT.0 ) CALL SCREEN( LTYP, IPEAK )
C
C  DISPLAY THE NEW LINE...
C
501	IF( IPEAK.GT.NPKS ) IPEAK = NPKS
     	CALL COLORS(-1)			!REVERSE VIDEO
     	CALL PUTIFL( IPEAK, 1, 3, 13, 5 )
     	CALL PUTFFL( F2TH(IPEAK), 1, 7.3, 13, 10 )
     	CALL PUTFFL( C2TH(IPEAK), 1, 7.3, 13, 18 )
     	CALL PUTFFL( FDSP(IPEAK), 1, 7.4, 13, 26 )
     	CALL PUTFFL( CDSP(IPEAK), 1, 7.4, 13, 34 )
     	CALL PUTFFL( RELA(IPEAK), 1, 5.1, 13, 42 )
     	CALL PUTGFL( AREA(IPEAK,JRES), 1, 11.4, 13, 48 )
     	CALL PUTFFL( FWHM(IPEAK), 1, 5.3, 13, 60 )
     	CALL PUTIFL( PHKL(1,IPEAK), 3, 3, 13, 66 )
     	CALL PUTEXT( PEAK(IPEAK), 4, 13, 76 )
     	CALL COLORS(80)
     	CALL PUTIFL( NPKS,  1, 3, 13, 1 )
     	GOTO 111
C
C  READY TO GET OUT...
C
999	IERR = 1
     	IF( NPKS.EQ.0 ) GOTO 9999	!NO PEAK LEFT
     	IERR= 0
     	NRNG = 1
     	NREP = 1
C
C  FIGURE OUT THE CORRECT ANGULAR RANGE...
C
     	DO I=1, 14
     	    DANG(I) = BANG(I)
     	ENDDO
     	IF( DANG(3).EQ.0.0 ) DANG(3) = 0.01	!ARBITRARY VALUE
     	DANG(1)= DANG(1)+DANG(3)*INT((F2TH(1)-DANG(1))/DANG(3)-1.0)
     	DANG(2)= DANG(1)+DANG(3)*INT((F2TH(NPKS)-DANG(1))/DANG(3)+1.0)
9999	RETURN
     	END
     	SUBROUTINE DIARAW
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE CONDUCTS THE INTERATIVE DIALOGUE
C	FOR INPUT RAW DATA FILE CONVERSION.
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*4 SPIKE, RESET
     	CHARACTER TEXT*80, SAMP*80, USER*12, SYM*1, KEY*2
    	DIMENSION RP(5), KP(5)
     	EQUIVALENCE (SAMP, SLID), (USER, NAME)
C
C  FIND THE MAXIMUM AND MINIMUM POINTS IN THE PATTERN...
C
     	BANG(4) =-1.0E+38
     	BANG(6) = 1.0E+38
     	DO I=1, NPTS
     	    IF( YOBS(I).GT.BANG(4) ) THEN
     		BANG(4) = YOBS(I)
     		BANG(5) = I
     	    ENDIF
     	    IF( YOBS(I).LT.BANG(6) ) THEN
     		BANG(6) = YOBS(I)
     		BANG(7) = I
     	    ENDIF
     	ENDDO
     	BANG(5) = BANG(1) + BANG(3)*(BANG(5)-1.0)
     	BANG(7) = BANG(1) + BANG(3)*(BANG(7)-1.0)
C
C  LOAD THE "DANG" ARRAY...
C
     	DO I=1, 14
     	   DANG(I) = BANG(I)
     	ENDDO

     	NRNG = 1		!RESET RANGES TO 1 FOR OUTPUT
     	NREP = 1		!RESET SERIES TO 1 FOR OUTPUT
     	RESET= 1		!ZERO POINT RESET LEVEL
c  spike changed to 1,000,000 to avoid truncatuing large peaks
     	SPIKE= 500000 		!VOLTAGE SPIKE DELTA COUNTS

1	CALL CLEARS( 0 )
     	CALL COLORS(-1)
     	CALL COLORS(80)
     	TEXT = 'VAXCONV --- Dialogue Menu for Raw Data File Conversion'
     	CALL HEADER( TEXT )
     	CALL COLORS(1)
C
C  DISPLAY THE DIALOGUE MENU...
C
     	WRITE(6,2)
2	FORMAT(X,80('='),/
     	1'  INPUT FILE:',27X,'INPUT FILE TYPE:'/
     	1' OUTPUT FILE:',26X,'OUTPUT FILE TYPE:'/
     	1' DATA COLLECTION MODE:'/,X,80('='),/
     	1' 1=SAMPLE ID:'/,X,80('-'),/
     	1' 2=RUN DATE:',11X,'3=RUN TIME:',10X,'4=USER NAME:'/,X,80('-'),/
     	1' 5=ANODE:'4X'6=KA1:'9X'7=KA2:'9X'8=KA:'9X'9=KA1/KA2 RATIO:'/
     	1X,80('-')/' 10=STARTING ANGLE:',9X,'11=ENDING ANGLE:',
     	19X,'12=OUTPUT STEPSIZE:'/' 13=COUNTTIME(SEC):',
     	18X'NUMBER OF POINTS:',13X,'INPUT STEPSIZE:'/
     	1' 14=VOLTAGE SPIKE DELTA(COUNTS):         15=ZERO POINT',
     	1' RESET(COUNTS):'/' MAX CPS=',15X,'AT 2TH=',10X,'MIN CPS=',15X,
     	1'AT 2TH='/,X,80('=')/
     	2' Only the numbered fields can be accessed to and be changed',
     	2' interactively.'/
     	2' e.g. INPUT> 1=Si SRM640A internal calibration run<return>'/
     	2' Enter RE to refresh the menu; LIST, TYPE to list raw pattern,',
     	2' CTRL_Z to quit.'/' Enter blank RETURN or EXIT to exit from',
     	2' the menu to start the conversion.')
C
C  INSERT THE PARAMETERS...
C
     	CALL COLORS(-1)			!REVERSE VIDEO ON
     	CALL PUTEXT( FILINP, 25, 3, 13 )
     	CALL PUTEXT( FILOUT, 25, 4, 13 )
     	CALL PUTEXT( FILTYP(IFLI), 24, 3, 57 )
     	CALL PUTEXT( FILTYP(IFLO), 24, 4, 57 )
     	IF( MODE.EQ.0 ) TEXT = 'PATTERN STEP SCAN (STEPING IN TWO-THETA)'
     	IF( MODE.EQ.1 ) TEXT = 'PATTERN STEP SCAN (STEPING IN D-SPACING)'
     	IF( MODE.EQ.2 ) TEXT = 'PATTERN STEP SCAN (STEPING IN Q (2pi/d)'
     	CALL PUTEXT( TEXT, 40, 5, 22 )

     	CALL PUTEXT( SAMP, 68, 7, 13 )
     	CALL CODDAT( TEXT(1:9), DATM )
     	CALL PUTEXT( TEXT(1:9), 9, 9, 12  )
     	CALL CODTIM( TEXT(1:8), TIMM )
     	CALL PUTEXT( TEXT(1:8), 8, 9, 34  )
     	CALL PUTEXT( USER, 12, 9, 56 )

     	CALL PUTEXT( ANODE(IELE), 2, 11, 9 )
     	CALL PUTFFL( WAVE(1,IELE), 1, 7.4, 11, 19 )
     	CALL PUTFFL( WAVE(2,IELE), 1, 7.4, 11, 34 )
     	CALL PUTFFL( WAVE(3,IELE), 1, 7.4, 11, 48 )
     	CALL PUTFFL( WAVE(5,IELE), 1, 4.1, 11, 73 )

     	CALL PUTFFL( DANG(1), 1, 7.3, 13, 19 )
     	CALL PUTFFL( DANG(2), 1, 7.3, 13, 44 )
     	CALL PUTFFL( DANG(3), 1, 7.3, 13, 72 )
     	CALL PUTFFL( dang(10), 1, 7.0, 14, 19 )
     	CALL PUTFFL( BANG(3), 1, 7.3, 14, 72 )
     	CALL PUTIFL( SPIKE, 1, 6, 15, 32 )
     	CALL PUTIFL( RESET, 1, 6, 15, 69 )

     	CALL PUTFFL(         DANG( 5), 1,  7.3, 16, 31)
     	CALL PUTFFL(         DANG( 7), 1,  7.3, 16, 71)
     	CALL COLORS(80)
     	CALL PUTGFL( DANG(4)/DANG(10), 1, 13.6, 16, 9 )
     	CALL PUTGFL( DANG(6)/DANG(10), 1, 13.6, 16, 49)
     	CALL PUTIFL( NPTS,  1, 5, 14, 44 )
C
C  START THE DIALOGUE CYCLE...
C
111	CALL COLORS(1)				!REVERSE VIDEO OFF
    	CALL PUTEXT( 'INPUT> ', 7, 23, 1 )
    	IERR = 1				!ERROR FLAG ON
    	READ(5,100,ERR=999,END=999) TEXT
100	FORMAT(A)

    	IERR = 0
    	IF( TEXT.EQ.' ' ) GOTO 999
     	NCHS = NALPHA( TEXT, 80 )
     	NCH  = NBLANK( TEXT(1:NCHS), NCHS )
     	IF( NCH.GT.0 ) THEN
     	    TEXT = TEXT(NCH+1:)
     	    NCHS = NCHS - NCH
     	ENDIF
    	SYM = TEXT(1:1)
     	KEY = TEXT(1:2)
     	NCH = NALPHA( SYM, -1 )
     	NCH = NALPHA( KEY, -2 )
    	IF( KEY.EQ.'EX' ) GOTO 999
     	IERR = 1
    	IF( KEY.EQ.'QU' ) GOTO 999
     	IF( KEY.EQ.'RE' ) GOTO 1		!REFRESH THE MENU
     	IF( KEY.EQ.'LI' .OR. KEY.EQ.'TY' ) THEN
     	    CALL SHOWPN				!SHOW THE PATTERN
     	    GOTO 1
     	ENDIF
     	CALL CURSOR( 23, 1 )
    	CALL CLEARS( 2 )
C
C  DECODE THE ENTRY NUMBER...
C
     	IF( NCHS.LT.3 ) GOTO 120
    	DECODE( 2, 110, KEY, ERR=120 ) INDX
110	FORMAT(I)
    	GOTO 130
120	IF( NCHS.LT.2 ) GOTO 888
     	DECODE( 1, 110, SYM, ERR=888 ) INDX

130    	IF( INDX.LT.1 .OR. INDX.GT.15 ) GOTO 777

    	NPS = INDEX( TEXT(1:3), '=' )
    	IF( NPS.EQ.0 ) GOTO 888		!WRONG ACCESS
    	NCH = NCHS - NPS
     	IF( NCH.EQ.0 ) GOTO 111
     	CALL COLORS(-1)
    	CALL COLORS(80)
    	NPS = NPS + 1
    	GOTO (50,51,52,53,54,55,55,55,55,55,55,55,55,55,55), INDX
C
C  ERROR TRANSFER...
C
777	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: entry value out of range. Entry ignored!',
     	1 48, 24, 1 )
    	GOTO 111
666	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: original radiation sources are
     	1 not modifiable.', 54, 24, 1 )
     	GOTO 111
888    	CALL COLORS(-1)
     	CALL PUTEXT('_ERROR: invalid entry. Check spelling.', 38, 24, 1 )
    	GOTO 111
C
C  GET THE SAMPLE ID...
C
50	SAMP = TEXT(NPS:NCHS)
     	CALL PUTEXT( SAMP, 68, 7, 13 )
     	GOTO 111
C
C  GET THE DATE...
C
51	NCH = NALPHA( TEXT(1:NCHS), -NCHS )	!CONVERT TO UPPERCASES
     	DUMY = DATCOD( TEXT(NPS:NCHS) )
     	IF( DUMY.EQ.0.0 ) GOTO 888
     	DATM = DUMY
     	CALL CODDAT( TEXT(1:9), DATM )
     	CALL PUTEXT( TEXT(1:9), 9, 9, 12  )
     	GOTO 111
C
C  GET THE TIME...
C
52	NCH = NALPHA( TEXT(1:NCHS), -NCHS )	!CONVERT TO UPPERCASES
     	DUMY = TIMCOD( TEXT(NPS:NCHS) )
     	IF( DUMY.EQ.0.0 ) GOTO 888
     	TIMM = DUMY
     	CALL CODTIM( TEXT(1:8), TIMM )
     	CALL PUTEXT( TEXT(1:8), 8, 9, 34  )
     	GOTO 111
C
C  GET THE USER NAME...
C
53	USER = TEXT(NPS:NCHS)
     	CALL PUTEXT( USER, 12, 9, 56 )
     	GOTO 111
C
C  GET THE ANODE...
C
54	IF( IELE.NE.6 ) GOTO 666
     	KEY = TEXT(NPS:(NPS+1))
     	NCH = NALPHA( KEY, -2 )			!CONVERT TO UPPERCASES
     	IF( KEY.EQ.ANODE(IELE) ) GOTO 111
     	DO I=1, 5
     	   IF( KEY.EQ.ANODE(I) ) GOTO 200
     	ENDDO
     	IELE = 6
     	ANODE(IELE) = KEY
     	CALL PUTEXT( ANODE(IELE), 2, 11, 9 )
     	CALL COLORS(-1)
     	CALL PUTEXT('_Please enter the correct values
     	1 for field 6,7,8,9.', 51, 24, 1 )
     	GOTO 111
C
C  DISPLAY NEW WAVELENGTHS...
C
200	IELE = I
     	CALL PUTEXT( ANODE(IELE), 2, 11, 9 )
     	CALL PUTFFL( WAVE(1,IELE), 1, 7.4, 11, 19 )
     	CALL PUTFFL( WAVE(2,IELE), 1, 7.4, 11, 34 )
     	CALL PUTFFL( WAVE(3,IELE), 1, 7.4, 11, 48 )
     	CALL PUTFFL( WAVE(5,IELE), 1, 4.1, 11, 73 )
     	GOTO 111
C
C  GET THE WAVELENGTHS, SCANING PARAMETERS...
C
55	IF( TEXT(NCHS:NCHS) .EQ. ',' ) NCHS = NCHS - 1
    	NCH = NCHS - NPS + 1
    	IF( NCH.EQ.0 ) GOTO 111
    	CALL COMMAS( TEXT(NPS:NCHS), NCH, 1, RP, KP, IDUM )
    	IF( NCH.EQ.0 ) GOTO 888		!ERROR INPUT

     	IF( INDX.LT.10 ) THEN
     	    IF( IELE.NE.6 ) GOTO 666
     	    IF( RP(1).LT.0.01 .OR. RP(1).GE.10.0 ) GOTO 777
     	    IF( INDX.EQ.6 ) THEN
     		WAVE(1,IELE) = RP(1)
     		CALL PUTFFL( RP(1), 1, 7.4, 11, 19 )
     	    ENDIF
     	    IF( INDX.EQ.7 ) THEN
     		WAVE(2,IELE) = RP(1)
     		CALL PUTFFL( RP(1), 1, 7.4, 11, 34 )
     	    ENDIF
     	    IF( INDX.EQ.8 ) THEN
     		WAVE(3,IELE) = RP(1)
     		CALL PUTFFL( RP(1), 1, 7.4, 11, 48 )
     	    ENDIF
     	    IF( INDX.EQ.9 ) THEN
     		WAVE(5,IELE) = RP(1)
     		CALL PUTFFL( RP(1), 1, 4.1, 11, 73 )
     	    ENDIF
     	ENDIF

     	IF( INDX.EQ.10 ) THEN
     	    IF( RP(1).GE.BANG(2) ) GOTO 777
     	    IF( RP(1).LT.BANG(1) ) RP(1) = BANG(1)
     	    DANG(1)= BANG(1)+BANG(3)*INT((RP(1)-BANG(1))/BANG(3)+0.1)
     	    CALL PUTFFL( DANG(1), 1, 7.3, 13, 19 )
     	ENDIF

     	IF( INDX.EQ.11 ) THEN
     	    IF( RP(1).LE.BANG(1) ) GOTO 777
     	    IF( RP(1).GT.BANG(2) ) RP(1) = BANG(2)
     	    DANG(2)= BANG(1)+BANG(3)*INT((RP(1)-BANG(1))/BANG(3)+0.1)
     	    CALL PUTFFL( DANG(2), 1, 7.3, 13, 44 )
     	ENDIF

     	IF( INDX.EQ.12 ) THEN
     	    IF( RP(1).GT.(DANG(2)-DANG(1)) ) GOTO 777
     	    IF( RP(1).LT.BANG(3) ) RP(1) = BANG(3)
     	    DANG(3) = BANG(3)*INT(RP(1)/BANG(3)+0.5)
     	    CALL PUTFFL( DANG(3), 1, 7.3, 13, 72 )
     	ENDIF

     	IF( INDX.EQ.13 ) THEN
     	    IF( RP(1).LE.0.0 .OR. RP(1).GT.9999.0 ) GOTO 777
     	    DANG(10) = RP(1)
     	    CALL PUTFFL( DANG(10), 1, 7.3, 14, 19 )
     	ENDIF

     	IF( INDX.EQ.14 ) THEN
     	    IF( RP(1).LT.10.0 .OR. RP(1).GT.999999.0 ) GOTO 777
     	    SPIKE = RP(1)
     	    CALL PUTIFL( SPIKE, 1, 6, 15, 32 )
     	ENDIF
     	IF( INDX.EQ.15 ) THEN
     	    IF( RP(1).LT.0.00 .OR. RP(1).GT.999999.0 ) GOTO 777
     	    RESET = RP(1)
     	    CALL PUTIFL( RESET, 1, 6, 15, 69 )
     	ENDIF

     	IF( INDX.LT.10 .OR. INDX.GT.12 ) GOTO 111
     	NPTS = INT( (DANG(2)-DANG(1))/DANG(3) + 0.1 ) + 1
     	CALL PUTIFL( NPTS, 1, 5, 14, 44 )
     	GOTO 111
999	IF( IERR.GT.0 ) GOTO 9999
C
C  REPACK "YOBS" ARRAY ACCORDING THE NEW SCAN PARAMETERS...
C
     	NCH = DANG(3)/BANG(3) + 0.1			!STEP NUMBER
     	NCHS = 1 + INT((DANG(1)-BANG(1))/BANG(3)+0.1)	!STARTING POINT
     	DO I=1, NPTS
     	   YOBS(I) = YOBS(NCHS+(I-1)*NCH)
     	ENDDO
C
C  SEARCH FOR MAX, MIN POINTS, ZERO POINTS, VOLTAGE SPIKES IN "YOBS" ARRAY...
C   
     	DANG(5) = 0.0
     	DANG(7) = 0.0
     	DANG(6) = 1.0E+38
     	DANG(4) = 0.0
     	DOLD = YOBS(1)
     	IF( DOLD.LT.RESET ) DOLD = RESET
     	DO I=1, NPTS
     	   DUMY = YOBS(I)
     	   IF( DUMY.LT.RESET .OR. DUMY.GT.SPIKE+DOLD ) DUMY = DOLD
     	   YOBS(I) = DUMY
     	   DOLD = DUMY
     	   IF( DUMY.GT.DANG(4) ) THEN
     	       DANG(4) = DUMY
     	       DANG(5) = I
     	   ENDIF
     	   IF( DUMY.LT.DANG(6) ) THEN
	DANG(6) = DUMY
     	       DANG(7) = I
     	   ENDIF
     	ENDDO
     	DANG(5) = DANG(1) + DANG(3)*(DANG(5)-1.0)
     	DANG(7) = DANG(1) + DANG(3)*(DANG(7)-1.0)
C
C  LET'S GET OUT...
C
9999	RETURN
     	END
     	SUBROUTINE GRADAT
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A BINARY DATA FILE FOR GRAFIT
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1
     	REAL*4 LAMDA
     	PARAMETER F4PI= 12.56636, F2PI = 6.28318

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )

     	IF( ITYI.NE.1 ) GOTO 111
C
C  WRITE OUT THE RAW PATTERN DATA...
C
     	IXTY = MODE
     	LAMDA = WAVE(1,IELE)
     	IF( LAMDA.EQ.0.0 ) LAMDA = WAVE(1,4)
C
C  PRESENT THE CONVERSION OPTIONS...
C
101	CALL CURSOR(18,1)
     	CALL CLEARS(2)
     	CALL COLORS(1)
     	WRITE(5,1000) IXTY+1
1000	FORMAT(' Output pattern could have one of the following',
     	1' types of X-axes:'/
     	19x' [1] TWO-THETA in degrees'/
     	19x' [2] d-spacing in angstroms'/
     	19x' [3] Q-spacing (Q = 2pi/d = 4pi*sin(theta)/lamda)'/
     	1'$Your choice <',I1,'> ')
     	READ(5,1001,ERR=101,END=777) IQS
1001	FORMAT(A)
     	IF( IQS.EQ.'1' ) IXTY = 1
     	IF( IQS.EQ.'2' ) IXTY = 2
     	IF( IQS.EQ.'3' ) IXTY = 3
     	IXTY = IXTY-1

     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)
C
C  CALCULATE THE X-AXIS VALUES...
C
     	DO I=1, NPTS
     	   XOBS(I) = DANG(1) + DANG(3)*(I-1)
     	ENDDO
     	IF( IXTY.NE.MODE ) THEN
     	    IF( MODE.EQ.0 ) THEN
     		IF( IXTY.EQ.1 ) THEN
     		DO I=1, NPTS		!TWO-THETA ---> D-SPACING
     		   XOBS(I)= 0.5*LAMDA / SIN(DTOR*XOBS(I))
     		ENDDO
     		ENDIF
     		IF( IXTY.EQ.2 ) THEN
     		DO I=1, NPTS		!TWO-THETA ---> Q-SPACING
     		   XOBS(I)= F4PI*SIN(DTOR*XOBS(I)) / LAMDA
     		ENDDO
     		ENDIF
     	    ENDIF
     	    IF( MODE.EQ.1 ) THEN
     		IF( IXTY.EQ.0 ) THEN
     		DO I=1, NPTS		!D-SPACING ---> TWO-THETA
     		   XOBS(I)= RTOD*ASIN(0.5*LAMDA/XOBS(I))
     		ENDDO
     		ENDIF
     		IF( IXTY.EQ.2 ) THEN
     		DO I=1, NPTS		!D-SPACING ---> Q-SPACING
     		   XOBS(I)= F2PI / XOBS(I)
     		ENDDO
     		ENDIF
     	    ENDIF
     	    IF( MODE.EQ.2 ) THEN
     		IF( IXTY.EQ.0 ) THEN
     		DO I=1, NPTS		!Q-SPACING ---> TWO-THETA
     		   XOBS(I)= RTOD*ASIN(LAMDA*XOBS(I)/F4PI)
     		ENDDO
     		ENDIF
     		IF( IXTY.EQ.1 ) THEN
     		DO I=1, NPTS		!Q-SPACING ---> D-SPACING
     		   XOBS(I)= F2PI / XOBS(I)
     		ENDDO
     		ENDIF
     	    ENDIF
     	ENDIF
C
C  WRITE OUT THE DATA SET...
C
     	ID = 0
     	WRITE(IOUT,ERR=888) NPTS, ID
     	WRITE(IOUT,ERR=888) ( XOBS(I), I=1, NPTS )
     	WRITE(IOUT,ERR=888) ( YOBS(I)/DANG(10), I=1, NPTS )
     	GOTO 999

111	IF( ITYI.NE.2 ) GOTO 999
C
C  WRITE OUT THE PEAKS...
C
200	CALL CURSOR( 15, 1 )
     	CALL CLEARS( 2 )
     	CALL COLORS(1)
     	WRITE(6,2000)
2000	FORMAT(
     	1'       OUTPUT  X  TYPES',20X'OUTPUT  Y  TYPES'/,X,75('-')/
     	1'   [1] OBSERVED   TWO-THETA',12X,'[1] RELATIVE INTENSITY'/
     	1'   [2] CALIBRATED TWO-THETA',12X,'[2] INTEGRATED INTENSITY'/
     	1'   [3] OBSERVED   D-SPACING',12X,'[3] FWHM'/
     	1'   [4] CALIBRATED D-SPACING'/,X,75('-')//
     	1'$Enter option numbers (X,Y) <1,1> ')
     	READ(5,2001,ERR=200,END=777) IX, IY
2001	FORMAT(2I)
     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

     	IF( IX.LT.1 .OR. IX.GT.4 ) IX = 1
     	IF( IY.LT.1 .OR. IY.GT.3 ) IY = 1
     	ID = 0
     	WRITE(IOUT,ERR=888) NPKS, ID
     	IF( IX.EQ.1 ) WRITE(IOUT,ERR=888) (F2TH(I),I=1,NPKS)
     	IF( IX.EQ.2 ) WRITE(IOUT,ERR=888) (C2TH(I),I=1,NPKS)
     	IF( IX.EQ.3 ) WRITE(IOUT,ERR=888) (FDSP(I),I=1,NPKS)
     	IF( IX.EQ.4 ) WRITE(IOUT,ERR=888) (CDSP(I),I=1,NPKS)
     	IF( IY.EQ.1 ) WRITE(IOUT,ERR=888) (RELA(I),I=1,NPKS)
     	IF( IY.EQ.2 ) WRITE(IOUT,ERR=888) (AREA(I,JRES),I=1,NPKS)
     	IF( IY.EQ.3 ) WRITE(IOUT,ERR=888) (FWHM(I),I=1,NPKS)
     	GOTO 999

777	IERR = 3		!BAIL OUT
     	GOTO 999
888	IERR = 1		!ERROR DURING WRITE
999	RETURN
     	END
     	SUBROUTINE GRAHKL
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT AN ASCII HKL AND D-SPACING FILE
C	FOR GRAFIT FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=888 )
C
C  RENORMALIZE REFLECTION RELATIVE INTENSITIES ACCORDING TO FWHMS
C  AND LORENTZIAN PROFILE MODEL SO THAT THEY REFLECT THE RELATIVE
C  INTENSITIES OF PEAK HEIGHTS TO CERTAIN EXTENTS...
C
     	DO I=1, NPKS
     	   IF( RELA(I).EQ.100.0 ) GOTO 100
     	ENDDO
     	I = 1
100	DUMY = FWHM(I)
     	DO I=1, NPKS
     	   RELA(I)= RELA(I)*DUMY/FWHM(I)
     	ENDDO
     	DUMY = RELA(1)
     	DO I=2, NPKS
     	   IF( RELA(I).GT.DUMY ) DUMY = RELA(I)
     	ENDDO
     	DO I=1, NPKS
     	   RELA(I) = 100.0*RELA(I)/DUMY
     	ENDDO
C
C  WRITE THE HKL FILE...
C
     	WRITE(IOUT,1000,ERR=888)
1000	FORMAT(8X,'H   K   L    2-THETA  D-SPACING   I(%)')
     	DO I=1, NPKS
     	IF( PEAK(I).EQ.'KA1' ) WRITE(IOUT,1001,ERR=888)
     	1 (PHKL(J,I),J=1,3), F2TH(I), FDSP(I), RELA(I)
     	ENDDO
1001	FORMAT('DHKL=',3I4,X,3F10.4)
     	GOTO 999
888	IERR = 1		!ERROR DURING WRITE
999	RETURN
     	END
     	SUBROUTINE HEADER( TEXT )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY
C
C	THIS ROUTINE DISPLAYS THE HEADER "TEXT"
C	IN THE FIRST LINE IN DIALOGUE AREA.
C
     	CHARACTER TITLE*80, TEXT*(*)

     	TITLE = TEXT
     	CALL DATE( TITLE(63:71) )
     	CALL TIME( TITLE(73:80) )
     	CALL PUTEXT( TITLE, 80, 1, 1 )

     	RETURN
     	END
     	SUBROUTINE INICOM
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE INITIALIZES THE COMMON BLOCKS
C	OF RAW & DIF FILE CONVERSION
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DAY*9, TIM*8
C
C  INITIALIZE THE HEADER BLOCK...
C
     	ITYP = ITYI
     	NHDB = 5
     	ISBF = 6
     	LENG = 3*NSBR
C
C  INITIALIZE THE SPECIFICATION BLOCK REFERENCES...
C
     	DO I=1, NSBR
     	   IRPR(I,1) = 0
     	   IRPR(I,2) = 0
     	   IRLR(I) = '    '
     	ENDDO

     	IRPR(1,1) = 73
     	IRPR(1,2) = 72
     	IRLR(1) = 'INST'

     	IRPR(3,1) = 42
     	IRPR(3,2) = 31
     	IRLR(3) = 'RADE'

     	IRPR(4,1) = 145
     	IRPR(4,2) = 15
     	IRLR(4) = 'LIME'

     	IRPR(6,1) = 163
     	IRPR(6,2) = MNP
     	IF( ITYP.EQ.1 ) IRLR(6) = 'RAWD'
     	IF( ITYP.EQ.2 ) IRLR(6) = 'DIFD'

     	IRPR(10,1) = 160
     	IRPR(10,2) = 3
     	IRLR(10) = 'EXPR'
C
C  INITIALIZE THE INSTRUMENTAION BLOCK...
C
     	IELE = 6		!ANODE = USER SPECIFIED
     	DO I=1, 5
     	   WAVE(I,6) = 0.0
     	ENDDO
C
C  INITIALIZE THE FILE DESCRIPTION BLOCK...
C
     	NAME(1) = 'FILE'
     	NAME(2) = 'CONV'
     	NAME(3) = '    '
     	CALL DATE( DAY )
     	CALL TIME( TIM )
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
     	FTYP = 0
     	MTYP = 0
     	NREP = 1
     	MPRO = 1
     	NRNG = 1
     	SCAN = 'S'
     	STYP = 'N'
     	DO I=1, 20
     	   SLID(I) = ' '
     	ENDDO
     	SLID(1) ='FILE'
     	SLID(2) ='CONV'
C
C  INITIALIZE THE LINE MEASUREMENT BLOCK...
C
     	DO I=1, 14
     	   BANG(I) = 0.0
     	ENDDO
     	BANG(10) = 1.0		!STEP COUNT TIME (SEC)
C
C  INITIALIZE THE DIFILE BLOCK...
C
     	NPKS = 0		!PEAK COUNTER
     	IRES = 0		!RESIDUAL FLAG: OFF
     	JRES = 1		!RESIDUAL FLAG: OFF
     	CUTI(1) = 0.1
     	CUTI(2) = 100.
     	CUTF(1) = 0.010
     	CUTF(2) = 9.999
C
C  INITIALIZE THE INTENSITY DATA BLOCK...
C
     	NPTS = 0		!POINT COUNTER
     	MODE = 0		!TWO-THETA SCAN
     	RETURN
     	END
     	SUBROUTINE LAMDAP
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, FEB-1987
C
C	THIS ROUTINE CALCULATES THE ANGULER PEAK POSITION
C	ACCORDING TO THE CURRENT SPECIFIED RADIATION SOURCES.
C
     	INCLUDE 'FILECONV.CBS'

     	DO I=1, NPKS
C
C  GET THE PEAK TYPE...
C
     	   ID = 1
     	   IF( PEAK(I).EQ.'KA2' ) ID = 2
     	   IF( PEAK(I).EQ.'KA' )  ID = 3
     	   IF( PEAK(I).EQ.'KB1' ) ID = 4
C
C  CALCULATE THE NEW TWO-THETA...
C
     	   DUMY = 0.5*WAVE(ID,IELE)/FDSP(I)
     	   IF( DUMY.GE.1.0 ) GOTO 222
     	   F2TH(I) = RTOD*ASIN( DUMY )
     	   DUMY = 0.5*WAVE(ID,IELE)/CDSP(I)
     	   IF( DUMY.GE.1.0 ) GOTO 222
     	   C2TH(I) = RTOD*ASIN( DUMY )
     	ENDDO
     	GOTO 333
222	CALL CURSOR( 22, 1 )
     	WRITE(6,223) NPKS-I+1
223	FORMAT(10X,I3,' NUMBER OF PEAKS TRUNCATED (TWO-THETA>180.0)')
     	NPKS = I-1
333	CALL CURSOR( 23, 1 )
     	CALL COLORS(-1)
     	WRITE(6,111)
111	FORMAT(' _NOTE: peak two-thetas have been reset',
     	1' to the new radiation source.')

999	RETURN
     	END
    	FUNCTION LDIGIT( IT )
C
C  THIS FUNCTION RETURNS WITH THE NUMBER OF DIGITS OF "IT"
C
    	ITT = IABS(IT)
    	IF( ITT.EQ.0 ) THEN
    	    LDIGIT = 1
    	ELSE
    	    LDIGIT = INT( LOG10(FLOAT(ITT)) ) + 1
    	    IF( IT.LT.0 ) LDIGIT = LDIGIT + 1
    	ENDIF
    	RETURN
    	END
     	SUBROUTINE LPRINT
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, FEB-1987
C
C	THIS ROUTINE WRITES OUT AN ASCII LIST FILE,
C	FROM THE COMMON BLOCKS, READY TO BE DUMPED
C	ONTO THE LINE PRINTER.
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DAY*9, TIM*8

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='UNKNOWN',
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=888 )
C
C  WRITE THE HEADER INFORMATION...
C
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )

     	WRITE(IOUT,1)
1	FORMAT(/X,80('=')/5X,'FORMAT --- An Integrated File Format',
     	1' Conversion Routine        VS:2.87'/X,80('='))

     	WRITE(IOUT,2) NAME, FILINP, (SLID(I),I=1,17), DAY, TIM,
     	1 ANODE(IELE), (WAVE(I,IELE),I=1,5), DANG(1), DANG(2),
     	1 DANG(3), DANG(10)
2	FORMAT(/
     	1' USER NAME: ',3A4,/
     	1' FILE NAME: ',A32,/
     	1' SAMPLE ID: ',17A4,/
     	1' RUN  DATE: ',A9,';   RUN  TIME: ',A8,/
     	1' ANODE: ',A2,', KA1=',F7.4,', KA2=',F7.4,', KA=',F7.4,
     	1', KB1=',F7.4,', KA1/KA2=',F5.2,//
     	1' STARTING ANGLE=',F7.3,'  ENDING ANGLE=',F7.3,
     	1'  STEPSIZE=',F7.3,'  C.T.(SEC)=',F4.1,/,X,80('-'))

     	IF( ITYI.NE.1 ) GOTO 111
C
C  WRITE OUT THE RAW PATTERN...
C
     	WRITE(IOUT,1000)
1000	FORMAT(22X,'P A T E R N   L I S T  (CPS)'/,X,80('-'))
     	WRITE(IOUT,1001) ( INT(YOBS(I)/DANG(10)), I=1, NPTS )
1001	FORMAT(10(I7,X))
     	WRITE(IOUT,1002)
1002	FORMAT(X,80('-'))
     	GOTO 999

111	IF( ITYI.NE.2 ) GOTO 999
C
C  WRITE OUT THE DIFILE...
C
     	WRITE(IOUT,2000)
2000	FORMAT(' #TH    2-THETA(O,C)     D(O)',
     	1'    D(C)  REL.INT  AREA        FWHM   H  K  L TYPE'/X,80('-'))
     	WRITE(IOUT,2001) (I, F2TH(I), C2TH(I), FDSP(I), CDSP(I), RELA(I),
     	1 AREA(I,JRES), FWHM(I), (PHKL(J,I),J=1,3), PEAK(I), I=1, NPKS)
2001	FORMAT(X,I3,2X,F7.3,X,F7.3,2X,F7.4,X,F7.4,2X,F5.1,X,G11.5,2X,
     	1 F5.2,X,3I3,X,A4)
     	WRITE(IOUT,1002)
     	GOTO 999

888	IERR= 1
999	RETURN
     	END
    	SUBROUTINE MARGIN( ITOP,IBOT )
C
C  PROGRAMMER: R.S. ZHOU
C
C  	THIS ROUTINE SETS TOP AND BOTTOM MARGINS OF SCREEN
C	FOR DIALOG IN ANSI MODE.
C
    	BYTE TEXT(9), ORGN(6)
     	DATA TEXT/ 0, 27, 91, 0, 0, 59, 0, 0, 114 /	!0<ESC>[00;00r
    	DATA ORGN/ 0, 27, 91, 63, 54, 108 /		!0<ESC>[?6l

    	IT = ITOP
    	IB = IBOT
    	LIMIT = 24
    	IF( IT.LT.1 ) IT = 1
    	IF( IT.GT.LIMIT ) IT = LIMIT
    	IF( IB.LT.1 ) IB = LIMIT
    	IF( IB.GT.LIMIT ) IB = LIMIT
    	IF( IT.GT.(IB-2)) IT = IB-2
     	IT0 = IT/10
     	IT1 = IT-10*IT0
     	IB0 = IB/10
     	IB1 = IB-10*IB0
     	TEXT(4) = IT0+48
     	TEXT(5) = IT1+48
     	TEXT(7) = IB0+48
     	TEXT(8) = IB1+48
     	IF( ITOP.GE.0 .AND. IBOT.GE.0 ) WRITE(6,1) ORGN
     	WRITE(6,2) TEXT
1	FORMAT(6A1$)
2	FORMAT(9A1$)
    	RETURN
    	END    	
    	FUNCTION NALPHA( TEXT, MAX )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  MAY-1987
C
C	THIS ROUTINE RETURNS WITH THE LENGTH OF CHARACTER STRING "TEXT"
C	IN NALPHA. IF MAX.LT.0, "TEXT" IS CONVERTED TO UPPERCASES.
C	EMBEDED NON-DISPLAYED CHARACTERS ARE STRIPPED EXCEPT TAB KEY
C	WHICH IS REPLACED BY A NUMBER OF BLANK SPACES.
C
     	COMMON/NALPHA/ NTABS
    	CHARACTER TNEW(132)*1, TEXT(1)*1

    	N = IABS(MAX)
C
C  SEARCH THE LAST NON-BLANK CHARACTER...
C
	DO IK = N, 1, -1
    	   IF( TEXT(IK).NE.' ' ) GO TO 1
    	ENDDO
	IK = 0
    	GOTO 9
C
C  STRIP "TEXT" OF NON-DISPLAYED CHARACTERS...
C
1	K = 0
     	IF( NTABS.EQ.0 ) NTABS = 5
     	DO J=1, IK
     	   N = ICHAR(TEXT(J))
     	   IF( N.LT.32 ) THEN
     	       IF( N.EQ.9 ) THEN	!TAB KEY
     		   DO I=1, NTABS
     		      K = K + 1
     		      TNEW(K) = ' '
     		   ENDDO
     	       ENDIF
     	   ELSE
     	       K = K + 1
     	       TNEW(K) = TEXT(J)
     	   ENDIF
     	ENDDO
     	IK = K
     	DO J=1, IK
     	   TEXT(J) = TNEW(J)
     	ENDDO
     	IF( MAX.GT.0 ) GOTO 9
C
C  CONVERT TO UPPERCASE CHARACTERS...
C
    	DO J=1, IK
    	   N = ICHAR(TEXT(J))
    	   IF( N.GT.96 .AND. N.LT.123 ) N = N - 32
    	   TEXT(J) = CHAR(N)
    	ENDDO

9	NALPHA = IK
    	RETURN
	END
    	SUBROUTINE NAMEXT( NAME1, NAME2, EXT )
C
C  PROGRAMMER: R.S. ZHOU
C
C  	THIS ROUTINE EXTRACTS FILENAME FROM "NAME1" AND
C	ATTACHES THE FILE EXTENSION "EXT" TO IT AND
C	STORES THE FILESPEC TO "NAME2".
C
    	CHARACTER NAME1*(*), NAME2*(*), EXT*(*)

    	IF( NAME1.EQ.' ' .OR. EXT.EQ.' ' ) RETURN
     	NAME2 = NAME1
    	N1 = INDEX( NAME2, ']' )
    	N2 = INDEX( NAME2(N1+1:), '.' )
    	IF( N2.EQ.0 ) THEN
    	    N1 = INDEX( NAME2, ' ' )
    	    NAME2(N1:N1) = '.'
    	ELSE
    	    N1 = N1 + N2
    	ENDIF
    	N1 = N1 + 1
    	NAME2(N1:) = EXT
    	RETURN
    	END
	FUNCTION NBLANK( IBD, MAX )
C
C	THIS ROUTINE RETURNS THE NUMBER OF LEADING BLANKS IN IBD
C
	CHARACTER IBD(1)*1

	DO I=1, MAX
    	   IF( IBD(I).NE.' ' ) GO TO 1
    	ENDDO
1	NBLANK = I-1

    	RETURN
	END
     	SUBROUTINE NOTWRN
C
C  BAIL OUT ROUTINE FOR NOT-WRITTEN-YET SUBROUTINES.
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER TEXT*53
     	TEXT = '_Sorry: "                        " not yet supported.'
     	TEXT(10:33) = FILTYP(JFIL)
     	CALL CLEARS( 6 )
     	CALL COLORS(-1)
     	CALL PUTEXT( TEXT, 53, 24, 1 )
     	CALL PAUSES( 3 )
     	IERR = 3
     	RETURN
     	END
    	SUBROUTINE PAUSES(ISEC)
C
C  PROGRAMMER: R.S ZHOU		FEB-1986
C
C  	THIS ROUTINE LOOPS IN ITSELF FOR ISEC SECONDS BY CALLING
C	THE SYSTEM SUPPLIED FUNCTION SUBROUTINE --- SECNDS
C
C  GET THE NUMBER OF SECONDS SINCE MIDNIGHT...
C
    	T1 = SECNDS( 0.0 )
C
C  GET THE ELAPSED TIME...
C
1    	DELTA = SECNDS( T1 )
    	IF( INT(DELTA) .GE. ISEC ) GOTO 9
    	GOTO 1
9    	RETURN
    	END
    	SUBROUTINE PUTEXT( STR, N, IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE OUTPUTS N CHARACTERS OF STR AT LINE --- IL
C	AND COLUMN --- IC
C
C		IC<0 : DISPLAY IN DOUBLE HEIGHT LINE
C		IL<0 : DISPLAY IN DOUBLE WIDTH LINE
C
    	BYTE TEXT(9), DLIN(3)
     	CHARACTER STR(1)*1
     	DATA TEXT / 0, 27, 91, 0, 0, 59, 0, 0, 72 /
    	DATA DLIN / 27, 35, 54 /
C
C  TEXT = <ESC>[00;00H
C  DLIN = <ESC>#6
C
     	N0 = IABS(N)
    	ICD = 0
    	IF( IL.LT.0 ) ICD = 1
    	IF( IC.LT.0 ) ICD = 2
    	ILL = IABS(IL)
    	ICC = IABS(IC)
     	IL0 = ILL/10
     	IL1 = ILL-10*IL0
     	IC0 = ICC/10
     	IC1 = ICC-10*IC0
    	TEXT(4) = 48 + IL0
    	TEXT(5) = 48 + IL1
    	TEXT(7) = 48 + IC0
    	TEXT(8) = 48 + IC1

     	IF( ICD.EQ.0 ) WRITE(6,1) TEXT, (STR(J),J=1,N0)
1	FORMAT(9A1,<N0>A1,$)

     	IF( ICD.EQ.1 ) WRITE(6,2) TEXT,DLIN, (STR(J),J=1,N0)
2	FORMAT(9A1,3A1,<N0>A1,$)

     	IF( ICD.EQ.2 ) THEN
    	    DLIN(3) = 51
    	    WRITE(6,2) TEXT,DLIN, (STR(J),J=1,N0)
    	    DLIN(3) = 52
    	    ILL = ILL+1
     	    IL0 = ILL/10
     	    IL1 = ILL-10*IL0
    	    TEXT(4) = 48 + IL0
    	    TEXT(5) = 48 + IL1
    	    WRITE(6,2) TEXT,DLIN, (STR(J),J=1,N0)
    	ENDIF
    	RETURN
     	END
    	SUBROUTINE PUTFFL( RP, IE, FL, IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE OUTPUTS "IE" REAL NUMBERS CONTAINED IN THE
C	ARRAY -- RP(IE) IN FIELD FORMAT DESIGNATED BY "FL" AT
C	LINE NUMBER "IL" AND COLUMN NUMBER "IC" IN THE DIALOGUE
C	AREA, WHERE "FL" IS SPECIFIED IN #1.#2 FOR FIXED POINT
C	REAL DATA FIELD "F#1.#2".
C
    	BYTE TEXT(9)
    	DIMENSION RP(1)
     	DATA TEXT / 0, 27, 91, 0, 0, 59, 0, 0, 72 /
     	PARAMETER FM = 10.0
C
C  TEXT = <ESC>[00;00H
C
     	J   = INT(FL)
     	K   = FM*(FL-FLOAT(J))+0.1
     	IR  = IE
     	IL0 = IL/10
     	IL1 = IL-10*IL0
     	IC0 = IC/10
     	IC1 = IC-10*IC0
    	TEXT(4) = 48 + IL0
    	TEXT(5) = 48 + IL1
    	TEXT(7) = 48 + IC0
    	TEXT(8) = 48 + IC1
     	WRITE(6,1) TEXT, (RP(I),I=1,IR)
1	FORMAT(9A1,<IR>F<J>.<K>,$)
    	RETURN
     	END
    	SUBROUTINE PUTGFL( RP, IE, FL, IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE OUTPUTS "IE" REAL NUMBERS CONTAINED IN THE
C	ARRAY -- RP(IE) IN FIELD FORMAT DESIGNATED BY "FL" AT
C	LINE NUMBER "IL" AND COLUMN NUMBER "IC" IN THE DIALOGUE
C	AREA, WHERE "FL" IS SPECIFIED IN #1.#2 FOR FLOATING POINT
C	REAL DATA FIELD "G#1.#2".
C
    	BYTE TEXT(9)
    	DIMENSION RP(1)
     	DATA TEXT / 0, 27, 91, 0, 0, 59, 0, 0, 72 /
     	PARAMETER FM= 10.0
C
C  TEXT = <ESC>[00;00H
C
     	J   = INT(FL)
     	K   = FM*(FL-FLOAT(J))+0.1
     	IR  = IE
     	IL0 = IL/10
     	IL1 = IL-10*IL0
     	IC0 = IC/10
     	IC1 = IC-10*IC0
    	TEXT(4) = 48 + IL0
    	TEXT(5) = 48 + IL1
    	TEXT(7) = 48 + IC0
    	TEXT(8) = 48 + IC1
     	WRITE(6,1) TEXT, (RP(I),I=1,IR)
1	FORMAT(9A1,<IR>G<J>.<K>,$)
    	RETURN
     	END
    	SUBROUTINE PUTIFL( KP, IE, IT, IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE OUTPUTS "IE" INTEGERS CONTAINED IN INTEGER
C	ARRAY -- KP(IE) IN FIELD LENGTH DESIGNATED BY "IT" AT
C	LINE "IL" AND COLUMN "IC".
C	
    	BYTE TEXT(9)
    	DIMENSION KP(1)
     	DATA TEXT / 0, 27, 91, 0, 0, 59, 0, 0, 72 /
C
C  TEXT = <ESC>[00;00H
C
     	IR = IE
    	IFL = IT
     	IL0=IL/10
     	IL1=IL-10*IL0
     	IC0=IC/10
     	IC1=IC-10*IC0
    	TEXT(4) = 48 + IL0
    	TEXT(5) = 48 + IL1
    	TEXT(7) = 48 + IC0
    	TEXT(8) = 48 + IC1
     	WRITE(6,1) TEXT, (KP(I),I=1,IR)
1	FORMAT(9A1,<IR>I<IFL>,$)
    	RETURN
     	END
     	SUBROUTINE RDI011
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A DIFFRAC-11 DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	DIMENSION NRNS(20)
     	REAL*4 LAMDA
     	CHARACTER DAY*12, TIM*8

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     	1 ACCESS='DIRECT', RECL=1, READONLY )
C
C  READ THE FILE HEADER BLOCK...
C
     	READ(IINP,REC= 1,ERR=777) SLID(1)
     	READ(IINP,REC= 2,ERR=777) SLID(2)
     	READ(IINP,REC= 3,ERR=777) SLID(3)
     	READ(IINP,REC= 4,ERR=777) SLID(4)
     	READ(IINP,REC= 5,ERR=777) DAY(1:4)
     	READ(IINP,REC= 6,ERR=777) DAY(5:8)
     	READ(IINP,REC= 7,ERR=777) DAY(9:12)
     	READ(IINP,REC= 8,ERR=777) TIM(1:4)
     	READ(IINP,REC= 9,ERR=777) TIM(5:8)
     	DATM = DATCOD( DAY(1:9) )
     	TIMM = TIMCOD( TIM(1:8) )
     	READ(IINP,REC= 10,ERR=777) NAME(1)
     	READ(IINP,REC= 11,ERR=777) NAME(2)
     	READ(IINP,REC= 12,ERR=777) NAME(3)
C
C  READ THE LINE MEASUREMENT BLOCK...
C
     	READ(IINP,REC= 13,ERR=777) BANG(1)
     	READ(IINP,REC= 14,ERR=777) BANG(2)
     	READ(IINP,REC= 15,ERR=777) BANG(3)
     	READ(IINP,REC= 16,ERR=777) BANG(10)
     	IF( BANG(3).LE.0.0 .OR. BANG(10).LE.0.0 ) GOTO 777
C
C  READ THE INSTRUMENTATION BLOCK...
C
     	READ(IINP,REC= 19,ERR=777) WAVE(1,6)	!WAVE LENGTH: KA1
     	IF( WAVE(1,6).LE.0.0 ) GOTO 777
     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I
     	ENDDO
C
C  READ THE NUMBER OF PEAKS...
C
     	READ(IINP,REC= 21,ERR=777) NPKS
     	IF( NPKS.LT.1 ) GOTO 777
C
C  READ THE DIFILE DATA BLOCK...
C
     	IREC = 40
     	LAMDA = 0.5*WAVE(1,IELE)
     	DO I=1, NPKS
     	   READ(IINP,REC= IREC+1,ERR=111) FDSP(I)
     	   READ(IINP,REC= IREC+2,ERR=111) AREA(I,1)
     	   READ(IINP,REC= IREC+3,ERR=111) FWHM(I)
     	   READ(IINP,REC= IREC+4,ERR=111) AREA(I,2)
     		IF( AREA(I,2).LT.1.0 ) AREA(I,2) = 0.0
     		IF( AREA(I,2).GE.1.0 ) IRES = 1
     	   IREC = IREC + 6
     	   PHKL(1,I) = 0
     	   PHKL(2,I) = 0
     	   PHKL(3,I) = 0
     	   PEAK(I) = 'KA1'
     	   CDSP(I) = FDSP(I)
     	   PHGH(I) = AREA(I,JRES)
     	   F2TH(I) = RTOD*ASIN( LAMDA / FDSP(I) )
     	   C2TH(I) = F2TH(I)
     	ENDDO
     	GOTO 222
111	NPKS = I - 1			!END OF THE FILE
     	IF( NPKS.EQ.0 ) GOTO 777
C
C  FIGURE OUT THE RELATIVE INTENSITY...
C
222	PMAX = AREA(1,JRES)
     	DO I=2, NPKS
     	   IF( AREA(I,JRES).GT.PMAX ) PMAX = AREA(I,JRES)
     	ENDDO
     	DO I=1, NPKS
     	   RELA(I) = 100.0*AREA(I,JRES)/PMAX
     	ENDDO
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RDI05A
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A DIFFRAC-5 (ALFRED) DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, TEXT*9

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', FORM='FORMATTED',
     	1 CARRIAGECONTROL='LIST', READONLY, ERR=888 )

     	DO I=1, 7	!SKIP 7 LINES
     	   READ(IINP,1000,ERR=777,END=777) TEXT(1:1)
     	ENDDO
1000	FORMAT(A)
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,1001,ERR=777,END=777) SLID
1001	FORMAT(11X,20A4)
C     	write(6,1001) slid
     	READ(IINP,1002,ERR=777,END=777) TEXT(1:9)
1002	FORMAT(12X,A9)
     	DATM = DATCOD( TEXT(1:9) )
     	READ(IINP,1000,ERR=777,END=777) TEXT(1:1)	!SKIP 1 LINE
     	READ(IINP,1003,ERR=777,END=777) BANG(1),BANG(10)
1003	FORMAT(16X,F9.4,18X,F7.2)
     	READ(IINP,1003,ERR=777,END=777) BANG(2)
     	READ(IINP,1003,ERR=777,END=777) BANG(3)
C     	write(6,1003) bang(1)
C     	write(6,1003) bang(2)
C     	write(6,1003) bang(3)
C     	write(6,1003) bang(10)
     	iele = 4
C
C  SEARCH FOR THE BEGINNING OF PEAK LIST...
C
     	DO I=1, MNK
     	   READ(IINP,1000,ERR=777,END=777) TEXT(1:4)
     	   IF( TEXT(1:4).EQ.'PEAK' .OR. TEXT(1:4).EQ.'peak' ) GOTO 100
     	ENDDO
     	GOTO 777		!WRONG FILE FORMAT ASSUMED
C
C  READ THE PEAK INFORMATION...
C
100	DO I=1, MNK

     	READ(IINP,1100,ERR=777,END=111) ID, F2TH(I), IQS, FDSP(I),
     	1 RELA(I), DUMY, AREA(I,JRES), FWHM(I)
1100	FORMAT(I3,F11.5,A1,F8.3,F8.2,10X,F6.4,F9.1,F9.4)
C     	write(6,1100) ID, F2TH(I), IQS, FDSP(I),
C     	1 RELA(I), DUMY, AREA(I,JRES), FWHM(I)
     	
     	C2TH(I) = F2TH(I)
     	CDSP(I) = FDSP(I)
     	if(area(i,jres) .eq.0.0) area(i,jres) = rela(i)
     	PHGH(I) = AREA(I,JRES)
     	PHKL(1,I) = 0
     	PHKL(2,I) = 0
     	PHKL(3,I) = 0
     	IF( IQS.NE.'*' ) PEAK(I) = 'KA1'
     	IF( IQS.EQ.'*' ) PEAK(I) = 'KA2'
     	   FWHM(I) = .1

     	ENDDO
     	NPKS = MNK
     	GOTO 999
111	NPKS = I - 1
     	GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RDI05S
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A DIFFRAC-5 (SIEMENS) DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, TEXT*9

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', FORM='FORMATTED',
     	1 CARRIAGECONTROL='LIST', READONLY, ERR=888 )

     	DO I=1, 7	!SKIP 7 LINES
     	   READ(IINP,1000,ERR=777,END=777) TEXT(1:1)
     	ENDDO
1000	FORMAT(A)
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,1001,ERR=777,END=777) SLID
1001	FORMAT(13X,20A4)
     	READ(IINP,1002,ERR=777,END=777) TEXT(1:9)
1002	FORMAT(14X,A9)
     	DATM = DATCOD( TEXT(1:9) )
     	READ(IINP,1000,ERR=777,END=777) TEXT(1:1)	!SKIP 1 LINE
     	READ(IINP,1003,ERR=777,END=777) BANG(1),BANG(10)
1003	FORMAT(17X,F9.4,4X,F7.2)
     	READ(IINP,1003,ERR=777,END=777) BANG(2)
     	READ(IINP,1003,ERR=777,END=777) BANG(3)
C
C  SEARCH FOR THE BEGINNING OF PEAK LIST...
C
     	DO I=1, MNK
     	   READ(IINP,1000,ERR=777,END=777) TEXT(1:4)
     	   IF( TEXT(1:4).EQ.'PEAK' .OR. TEXT(1:4).EQ.'peak' ) GOTO 100
     	ENDDO
     	GOTO 777		!WRONG FILE FORMAT ASSUMED
C
C  READ THE PEAK INFORMATION...
C
100	DO I=1, MNK

     	READ(IINP,1100,ERR=777,END=111) ID, F2TH(I), IQS, FDSP(I),
     	1 RELA(I), DUMY, AREA(I,JRES), FWHM(I)
     	
     	C2TH(I) = F2TH(I)
     	CDSP(I) = FDSP(I)
     	PHGH(I) = AREA(I,JRES)
     	PHKL(1,I) = 0
     	PHKL(2,I) = 0
     	PHKL(3,I) = 0
     	IF( IQS.NE.'*' ) PEAK(I) = 'KA1'
     	IF( IQS.EQ.'*' ) PEAK(I) = 'KA2'

     	ENDDO
1100	FORMAT(I3,F10.4,A1,F8.3,F8.2,10X,F6.4,F9.1,F9.4)
     	NPKS = MNK
     	GOTO 999
111	NPKS = I - 1
     	GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RDI500
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A DIFFRAC-500 DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C       It works for version 2 of the d-I files (i.e. 1988 and 
C       after).
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 DUMY, difser, difrng, ISDI(20), NUMP(20),
     1  diver, iloc1, iloc2, difstp
     	REAL*4 LAMDA1,LAMDA2,LAMDA3,LAMDA4
        integer*4 difstt, difsle, ipoint
	LOGICAL*1	CHANGE

	CHANGE=.TRUE.
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     	1 ACCESS='DIRECT', RECL=1, READONLY )
C
C  READ THE FILE HEADER BLOCK...
C
     	READ(IINP,REC= 1,ERR=777) diver, difstp 
     	IF( difstp.NE.2 ) GOTO 777
     	READ(IINP,REC= 2,ERR=777) NHDB
     	READ(IINP,REC= 3,ERR=777) difstt
     	READ(IINP,REC= 4,ERR=777) difsle
	ipoint=difsle+difstt       !first record after header and spec block
     	IF( difsle.LT.3 ) GOTO 777
C
C  READ THE SPECIFICATION BLOCK REFERENCES...
C
     	IREC = difstt
     	DO I=1, difsle/3
     	   READ(IINP,REC= IREC  ,ERR=777) IRPR(I,1)
     	   READ(IINP,REC= IREC+1,ERR=777) IRPR(I,2)
     	   READ(IINP,REC= IREC+2,ERR=777) IRLR(I)
     	   IREC = IREC + 3
     	ENDDO
C
C  READ THE INSTRUMENTATION BLOCK...
C
     	IREC = IRPR(1,1) + 5
     	DO I=1, 5		!READ THE WAVE SOURCES
     	   READ(IINP,REC=IREC,ERR=777) WAVE(I,6)
     	   IREC = IREC + 1
     	ENDDO
     	IF( WAVE(1,6).LE.0.0 ) GOTO 777
     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I
     	ENDDO
C
C  READ THE FILE DESCRIPTION BLOCK...
C
     	IREC = IRPR(3,1)
     	READ(IINP,REC= IREC  ,ERR=777) NAME(1)
     	READ(IINP,REC= IREC+1,ERR=777) NAME(2)
     	READ(IINP,REC= IREC+2,ERR=777) NAME(3)
     	READ(IINP,REC= IREC+3,ERR=777) DATM
     	READ(IINP,REC= IREC+4,ERR=777) TIMM
     	READ(IINP,REC= IREC+5,ERR=777) FTYP,MTYP
     	READ(IINP,REC= IREC+8,ERR=777) NREP,MPRO
     	IF( NREP.LT.1 ) GOTO 777
     	READ(IINP,REC= IREC+9,ERR=777) NRNG,SCAN
     	IF( NRNG.LT.1 .OR. SCAN.NE.'S' ) GOTO 777
     	READ(IINP,REC= IREC+14,ERR=777) STYP
     	IREC = IREC + 15
     	DO I=1, 15
     	   READ(IINP,REC= IREC,ERR=777) SLID(I)
     	   IREC = IREC + 1
    	ENDDO
C
C  READ THE LINE MEASUREMENT BLOCK 
C  We will read the d's and I's from each block and concatenate them.
C
          	IREC = IRPR(4,1)
     	DO I=1, 14
     	   READ(IINP,REC= IREC,ERR=777) BANG(I)
     	   IREC = IREC + 1
     	ENDDO
     	IF( BANG(3).LE.0.0 .OR. BANG(10).LE.0.0 ) GOTO 777
C
C  READ THE DIFILE DATA BLOCK...
C
     	IREC = IRPR(6,1)
     	READ(IINP,REC= IREC,ERR=777) difser,difrng
     	IF( difser.LT.1 .OR. difrng.LT.1 ) GOTO 777
C
C  mods to allow for automatic determination of version 1 or 2
C  If CHANGE is TRUE we are in new format.
	READ(IINP'IRPR(6,1)+1,ERR=777)ILOC1,ILOC2
	IF(ILOC1.NE.(DIFSER*DIFRNG)+2)THEN
	  CHANGE=.FALSE.			!we must have actual record
	  DIVER=2			!instead of relative
	ENDIF
     	DO I=1, difrng*difser
     	   IREC = IREC + 1
     	   READ(IINP,REC= IREC,ERR=777) ISDI(I),NUMP(I)
	    IF(CHANGE) isdi(i)=isdi(i)+irpr(6,1)-1  
     	ENDDO

     	IF( difser.GT.1 ) THEN
     	    DUMY = LDIGIT( difser )
1002	    WRITE(6,1000) difser
     	    READ(5,1001,ERR=1002,END=1002) DUMY
     	    IF( DUMY.LT.1 .OR. DUMY.GT.difser ) DUMY = 1
     	    difser = DUMY
     	ENDIF
1000	FORMAT(/
     	1' Input file contains ',I<DUMY>,' series of measurements'/
     	1' but only one measurement can be converted at a time.'/
     	1'$Which measurement to use? <1> ')
1001	FORMAT(I)

     	IRNG = 1
     	IF( difrng.GT.1 ) THEN
     	    DUMY = LDIGIT( difrng )
1003	    WRITE(6,1005) difrng
     	    READ(5,1001,ERR=1003,END=1003) IRNG
     	    IF( IRNG.LT.1 .OR. IRNG.GT.difrng ) IRNG = 1
     	ENDIF
1005	FORMAT(/
     	1' Input file contains ',I<DUMY>,' ranges of data'/
     	1' but only one range can be converted at a time.'/
     	1'$Which range to use? <1> ')

     	IRNG = IRNG+(difser-1)*difrng
     	IREC = ISDI(IRNG)		!JUMP TO THE RANG
     	NPKS = NUMP(IRNG)
     	IF( NPKS.GT.MNK ) NPKS = MNK
     	LAMDA1 = 0.5*WAVE(1,IELE)
     	LAMDA2 = 0.5*WAVE(2,IELE)
     	LAMDA3 = 0.5*WAVE(3,IELE)
     	LAMDA4 = 0.5*WAVE(4,IELE)
     	IK = 1
     	DO I=1, NPKS
     	   READ(IINP,REC= IREC  , ERR=777) F2TH(IK)
     	   READ(IINP,REC= IREC+1, ERR=777) C2TH(IK)
     	   READ(IINP,REC= IREC+2, ERR=777) PEAK(IK)
     	   READ(IINP,REC= IREC+4, ERR=777) PHGH(IK)
     	   READ(IINP,REC= IREC+6, ERR=777) AREA(IK,1)
     	   READ(IINP,REC= IREC+7, ERR=777) AREA(IK,2)
     		IF( AREA(IK,2).LT.1.0 ) AREA(IK,2) = 0.0
     		IF( AREA(IK,2).GE.1.0 ) IRES = 1
     	   READ(IINP,REC= IREC+8, ERR=777) FWHM(IK)
     	   READ(IINP,REC= IREC+9, ERR=777) difser,difrng
     		IF( IABS(difser).GT.99 ) difser = 0
     	 	IF( IABS(difrng).GT.99 ) difrng = 0
     	   	PHKL(1,I) = difser
     	   	PHKL(2,I) = difrng
     	   READ(IINP,REC= IREC+10,ERR=777) difser
     		IF( IABS(difser).GT.99 ) difser = 0
     		PHKL(3,I) = difser
     	   READ(IINP,REC= IREC+11,ERR=777) RELA(IK)
     	   	IREC = IREC + 12
	   IF( PEAK(IK).NE.'KA2' .AND. PEAK(IK).NE.'KA' .AND.
	1  PEAK(IK).NE.'KB1' ) PEAK(IK) = 'KA1'
     	   IF(PEAK(IK).EQ.'KA1') FDSP(IK) = LAMDA1/SIN(DTOR*F2TH(IK))
     	   IF(PEAK(IK).EQ.'KA2') FDSP(IK) = LAMDA2/SIN(DTOR*F2TH(IK))
     	   IF(PEAK(IK).EQ.'KA' ) FDSP(IK) = LAMDA3/SIN(DTOR*F2TH(IK))
     	   IF(PEAK(IK).EQ.'KB1') FDSP(IK) = LAMDA4/SIN(DTOR*F2TH(IK))
     	   IF(PEAK(IK).EQ.'KA1') CDSP(IK) = LAMDA1/SIN(DTOR*C2TH(IK))
c  I am going to try to push corrected values into the array to 
c be saved by storing the corrected values (when tehy exist into 
c the uncorrected array which gets output by most subroutines.
     	   if(c2th(ik) .gt. 0.) then 
     		FDSP(IK) = LAMDA1/SIN(DTOR*C2TH(IK))
     		cdsp(ik) = fdsp(ik)
     		f2th(ik) = c2th(ik)
     	   endif     		
     	   IF(PEAK(IK).EQ.'KA2') CDSP(IK) = LAMDA2/SIN(DTOR*C2TH(IK))
     	   IF(PEAK(IK).EQ.'KA' ) CDSP(IK) = LAMDA3/SIN(DTOR*C2TH(IK))
     	   IF(PEAK(IK).EQ.'KB1') CDSP(IK) = LAMDA4/SIN(DTOR*C2TH(IK))
     	   IK = IK + 1
     	ENDDO
     	NPKS = IK
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RDIAID
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE READS FROM A AIDS DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE RDIKEY
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  SEPT-1987
C
C	THIS ROUTINE READS FROM A KEYBOARD DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
C	THE FILE MUST HAVE ONE OF THE TWO PEAK ENTRY LINES:
C
C	1)	d-spacing(A), intensity(%), FWHM, H, K, L
C	2)	2-theta(deg), intensity(%), FWHM, H, K, L
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	CHARACTER TEXT*80
     	DIMENSION RP(6), KP(6)
     	PARAMETER SCALE = 1.0

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='FORMATTED', READONLY, ERR=888 )
C
C  SET THE DEFAULT RADIATION SOURCE TO CU...
C
     	IELE = 4
     	LAMDA = 0.5*WAVE(1,IELE)
C
C  READ THE PEAK LIST...
C
        HI = 0.0
     	NPKS = 0
111	READ(IINP,1000,ERR=666,END=666) TEXT
1000	FORMAT(A)
     	IF( TEXT.EQ.' ' ) GOTO 111
C
C  DECODE ENTRY LINE...
C
     	NCHS = NALPHA( TEXT, 80 )
     	CALL COMMAS( TEXT, NCHS, 6, RP, KP, IDUM )
C
C  SKIP INVALID ENTRY...
C
     	IF( NCHS.EQ.0 ) GOTO 111
     	IF( RP(1).LT.0.5*LAMDA .OR. RP(1).GE.180.0 ) GOTO 111
c     	IF( RP(2).LT.0.1 .OR. RP(2).GT.100.0 ) GOTO 111
C
C  STORE THE PEAK...
C
     	NPKS = NPKS + 1
     	F2TH(NPKS) = RP(1)
     	RELA(NPKS) = RP(2)
     	PHGH(NPKS) = SCALE*RP(2)
     	AREA(NPKS,JRES) = SCALE*RP(2)
        IF(RP(2) .GT. HI) HI = RP(2)
c debug $$$$
c    	write(6,1234) f2th(npks)
c1234	format(' doing it', 1xf10.4)
     	FWHM(NPKS) = 0.1
     	IF( KP(3).EQ.1 ) THEN
     	    IF(RP(1).GE.CUTF(1).AND.RP(1).LE.CUTF(2)) FWHM(NPKS)=RP(3)
     	ENDIF
     	IF( KP(4).EQ.1 ) PHKL(1,NPKS) = NINT(RP(4))
     	IF( KP(5).EQ.1 ) PHKL(2,NPKS) = NINT(RP(5))
     	IF( KP(6).EQ.1 ) PHKL(3,NPKS) = NINT(RP(6))
     	PEAK(NPKS) = 'KA1'
     	GOTO 111

666	IF( NPKS.EQ.0 ) GOTO 777
C
C  CHECK D-SPACING/2-THETA INPUT...
C
c     	   IF( F2TH(1).GT.8.00 ) GOTO 333
     	write(6,211)
211	format('$Are 2-Theta''s (0) or d''s (1) on the file?',
     1 ' [0]: ')
     	read(5,212) itest
212	format(i)
     	if(itest .eq. 0) go to 333
C
C  ASSUME D-SPACING ENTRIES...
C
222	DO I=1, NPKS
     	   FDSP(I) = F2TH(I)
     	   CDSP(I) = FDSP(I)
     	   F2TH(I) = RTOD*ASIN(LAMDA/FDSP(I))
     	   C2TH(I) = F2TH(I)
     	ENDDO
     	GOTO 444
C
C  ASSUME 2-THETA ENTRIES...
C
333	DO I=1, NPKS
     	   C2TH(I) = F2TH(I)
     	   FDSP(I) = LAMDA / SIN(DTOR*F2TH(I))
     	   CDSP(I) = FDSP(I)
     	ENDDO
     	GOTO 444
C
C  SCALE THE INTENSITIES TO 100%
C
444     DO I=1, NPKS
     	   RELA(I) = RELA(I) * 100./HI
        ENDDO
     	go to 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END

     	SUBROUTINE RDIMDI
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY   JUN-1988
C
C	THIS ROUTINE READS FROM A MDI DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, TEXT*9

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', FORM='FORMATTED',
     	1 CARRIAGECONTROL='LIST', READONLY, ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,1001,ERR=777,END=777) SLID
1001	FORMAT(20A4)

     	READ(IINP,1003,ERR=777,END=777) NPKS
1003	FORMAT(I4)
     	iele = 4
C
C  READ THE PEAK INFORMATION...
C
100	DO I=1, NPKS

     	READ(IINP,1100,ERR=777,END=111) FDSP(I), RELA(I)

     	ENDDO
1100	FORMAT(9X,F10.7,10X,F3.0)
     	GOTO 112
111	NPKS = I - 1
112    	DO I=1, NPKS
     	   C2TH(I) = 2.0 * asin(1.540598 / (2.*fdsp(i))) / .01745329
     	   CDSP(I) = FDSP(I)
     	   PHGH(I) = RELA(I)
     	   AREA(I,JRES) = RELA(I)
     	   PEAK(I) = 'KA1'
     	   FWHM(I) = .1
     	ENDDO
     	GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RDINIC
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A NICOLET DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 IBUF(149), HKLP(3,150), IDUM, NOD
     	DIMENSION FWAVE(3)
     	EQUIVALENCE (IBUF(1),SLID(1)), (IBUF(47), FWAVE(1))

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE HEADER INFORMATION...
C
     	READ(IINP,ERR=777,END=777) IBUF

     	WAVE(1,6) = FWAVE(2)
     	WAVE(2,6) = FWAVE(3)
     	WAVE(3,6) = FWAVE(1)
     	WAVE(5,6) = 2.0
     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I
     	ENDDO
C
C  READ THE PEAK INFORMATION...
C
     	READ(IINP,ERR=777,END=777) NOD, ( FDSP(I), RELA(I), F2TH(I),
     	1 FWHM(I), (HKLP(J,I),J=1,3), IDUM, I=1, NOD )

     	NPKS = NOD
     	DO I=1, NPKS
     	   PHKL(1,I) = HKLP(1,I)
     	   PHKL(2,I) = HKLP(2,I)
     	   PHKL(3,I) = HKLP(3,I)
     	   C2TH(I) = F2TH(I)
     	   CDSP(I) = FDSP(I)
     	   PHGH(I) = RELA(I)
     	   AREA(I,JRES) = RELA(I)
     	   PEAK(I) = 'KA1'
     	ENDDO
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RDIRIG
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  Jan 1988
C
C	THIS ROUTINE READS FROM A RIGAKU DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA, W(4)
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
     	DIMENSION NRNS(20)
     	CHARACTER DAY*12, TIM*8, JUNK*4, EL(4)*1, AST*1
C
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     	1 ACCESS='DIRECT', RECL=9, READONLY )
C
C  READ RECORD 1 - 3
C
     	JERR = 1
     	READ(IINP,REC= 1,ERR=777) JUNK, DAY, TIM
     	JERR = 2
     	READ(IINP,REC= 2,ERR=777) (SLID(I),I=1,6)
     	JERR = 3
     	READ(IINP,REC= 3,ERR=777) (SLID(I),I=7,10)
     	JERR = 4
     	DATM = DATCOD( DAY(1:9) )
     	TIMM = TIMCOD( TIM(1:8) )
C
C  READ THE LINE MEASUREMENT RECORD 4
C DMAX, DMIN, START, END, STEP, SCAN SPEED, COUNT TIME - REAL*4
C
     	READ(IINP,REC= 4,ERR=777) A,A,BANG(1),BANG(2),BANG(3),A,BANG(10)
     	IF( BANG(3).LE.0.0 .OR. BANG(10).LE.0.0 ) GOTO 777
C
C  READ THE RADIATION 
C EL SYM (A2), KA1, KA2, KB1, KBAR
C
     	JERR = 5
     	READ(IINP,REC= 5,ERR=777) EL, W
     	IELE = 0
C	WAVE(*,1) --- Cr
C	WAVE(*,2) --- Fe
C	WAVE(*,3) --- Co
C	WAVE(*,4) --- Cu
C	WAVE(*,5) --- Mo
C	WAVE(*,6) --- USER SPECIFIED
     	IF(EL(1) .EQ. 'C' .AND. EL(2) .EQ. 'r') IELE = 1
     	IF(EL(1) .EQ. 'F' .AND. EL(2) .EQ. 'E') IELE = 2
     	IF(EL(1) .EQ. 'C' .AND. EL(2) .EQ. 'o') IELE = 3
     	IF(EL(1) .EQ. 'C' .AND. EL(2) .EQ. 'u') IELE = 4
     	IF(EL(1) .EQ. 'M' .AND. EL(2) .EQ. 'o') IELE = 5
     	IF(IELE .EQ. 0) IELE = 6
     	WAVE(1,IELE) = W(1)
     	WAVE(2,IELE) = W(2)
     	WAVE(4,IELE) = W(3)
     	WAVE(3,IELE) = W(4)
C	WAVE(1,*) --- WAVELENGTH OF K-ALPHA 1
C	WAVE(2,*) --- WAVELENGTH OF K-ALPHA 2
C	WAVE(3,*) --- WAVELENGTH OF K-ALPHA
C	WAVE(4,*) --- WAVELENGTH OF K-BETA
C	WAVE(5,*) --- KA1/KA2 RATIO
C
C  SKIP THE NEXT 3 RECORDS
C
C  READ THE NUMBER OF PEAKS...
C
     	JERR = 9
     	READ(IINP,REC= 9,ERR=777) NPKS
     	IF( NPKS.LT.1 ) GOTO 777
C
C  READ THE DIFILE DATA BLOCK...
C
     	IREC = 9
     	DO I=1, NPKS
     	   IREC = IREC + 1
     	   JERR = IREC
     	   READ(IINP,REC= IREC,ERR=111) AST, F2TH(I), FDSP(I), 
     1		RELA(I), PHGH(I), FWHM(I)
     	   IF(AST.EQ.'*') WRITE(6,1010) I
1010	   FORMAT(' Warning: Line ',I3,' May be an alpha 2')
     	   CDSP(I) = FDSP(I)
     	   C2TH(I) = F2TH(I)
     	ENDDO
     	GOTO 999
111	NPKS = I - 1			!END OF THE FILE
     	IF( NPKS.EQ.0 ) GOTO 777
     	GOTO 999
C  ERROR EXIT
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RDISPP
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A SPECPLOT DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*4 DATE, YEAR

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  READ THE FILE HEADER...
C
     	READ(IINP,1000,ERR=777) MONT,DATE,YEAR,(SLID(I),I=1,12)
1000	FORMAT(7X,I2,X,I2,X,I2,9X,12A4)

     	DATM = DATE*10000 + (3*(MONT-1)+1)*100 + YEAR

     	READ(IINP,1001,ERR=777) BANG(1),BANG(3),BANG(10), ANODE(6)
1001	FORMAT(13X,F8.3,15X,F6.3,7X,F5.1,6X,A2,////)

     	IELE = 4		!DEFAULT TO CU
     	DO I=1, 5
     	   IF( ANODE(6).EQ.ANODE(I) ) IELE = I
     	ENDDO
C
C  READ THE D-SPACING AND THE INTENSITY DATA...
C
2000	FORMAT(4X,F9.3,F9.4,9X,2F9.1)
     	YMAX = 0.0
     	DO I=1, MNK
     	   READ(IINP,2000,ERR=777,END=111) F2TH(I), FDSP(I),
     	1  PHGH(I), DUMY
     	   C2TH(I) = F2TH(I)
     	   CDSP(I) = FDSP(I)
     	   FWHM(I) = 0.1
     	   PHKL(1,I) = 0
     	   PHKL(2,I) = 0
     	   PHKL(3,I) = 0
     	   PEAK(I) = 'KA1'
     	   AREA(I,JRES) = DUMY
     	   IF( DUMY.GT.YMAX ) YMAX = DUMY
     	ENDDO
111	NPKS = I-1
     	IF( NPKS.LT.1 ) GOTO 777
C
C  FIND OUT THE RELATIVE INTENSITIES...
C
     	DO I=1, NPKS
     	   RELA(I) = 100.0*AREA(I,JRES)/YMAX
     	ENDDO
     	GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RDITAG
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE READS FROM A SCINTAG DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,ERR=777,END=777) ITIT, BANG(1), BANG(2), BANG(3),
     	1 BANG(10), DUMY, WAVE(1,6)

     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I
     	ENDDO
C
C  READ THE PEAK LIST...
C
     	LAMDA = 0.5*WAVE(1,IELE)
     	DO I=1, MNK

     	   READ(IINP,ERR=777,END=666) F2TH(I), DUMY, AREA(I,JRES),
     	1  PHGH(I), FWHM(I), HH, KK, LL

     	   C2TH(I) = F2TH(I)
     	   FDSP(I) = LAMDA / SIN(DTOR*F2TH(I))
     	   CDSP(I) = FDSP(I)
     	   PHKL(1,I) = HH
     	   PHKL(2,I) = KK
     	   PHKL(3,I) = LL
     	   PEAK(I) = 'KA1'

     	ENDDO
     	NPKS = MNK
     	GOTO 999
666	NPKS = I - 1
     	IF( NPKS.GT.0 ) GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	IF( NPKS.EQ.0 ) GOTO 9999
C
C  CALCULATE THE RELATIVE INTENSITY...
C
     	DUMY = AREA(1,JRES)
     	DO I=2, NPKS
     	   IF( AREA(I,JRES).GT.DUMY ) DUMY = AREA(I,JRES)
     	ENDDO
     	DO I=1, NPKS
     	   RELA(I) = 100.0*AREA(I,JRES)/DUMY
     	ENDDO

9999	RETURN
     	END
     	SUBROUTINE RDIUNK
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE READS FROM A ??? DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE RLSNBS
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   MAY-1987
C
C	THIS ROUTINE READS THE PEAK LIST SECTION FROM A NBS
C	RIETVELD OUTPUT FILE AND STORES IN THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	CHARACTER TEXT*130
     	DIMENSION RP(10), KP(10)

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='FORMATTED', READONLY, ERR=888 )
     	TEXT = ' '
C
C  SEARCH FOR RADIATION WAVELENGTH...
C
10	READ(IINP,1000,ERR=777,END=666) TEXT(1:25)
     	IF( TEXT.EQ.' ' ) GOTO 10
     	NCH = INDEX( TEXT(1:25), 'WAVELENGTH=' )
     	IF( NCH.EQ.0 ) GOTO 10
     	NCH = INDEX( TEXT(1:25), '=' )
     	TEXT = TEXT(NCH+1:)
     	NCH = NALPHA( TEXT, 10 )
     	IF( NCH.GT.0 ) CALL COMMAS( TEXT,NCH,1,RP,KP,IDUM )
     	IF( NCH.EQ.0 ) GOTO 777
     	WAVE(1,IELE) = RP(1)
C
C  SEARCH FOR THE BEGINNING OF PEAK LIST SECTION...
C
100	READ(IINP,1000,ERR=777,END=666) TEXT(1:20)
1000	FORMAT(A)
     	IF( TEXT.EQ.' ' ) GOTO 100
     	NCH = INDEX( TEXT(1:20), 'H   K   L' )
     	IF( NCH.EQ.0 ) GOTO 100
     	READ(IINP,1000,ERR=777,END=666) TEXT(1:1)	!SKIP ONE LINE?
C
C  READ THE PEAK LIST...
C
     	NPKS = 0
     	LAMDA = 0.5*WAVE(1,IELE)
200	READ(IINP,1001,ERR=777,END=999) TEXT
1001	FORMAT(2X,A)
     	IF( TEXT.EQ.' ' ) GOTO 200
     	NCH = NBLANK( TEXT, 130 )
     	IF( NCH.GT.0 ) TEXT = TEXT(NCH+1:)
     	NCH = NALPHA( TEXT, 130 )
     	CALL COMMAS( TEXT, NCH, 8, RP, KP, IDUM )
     	IF( NCH.EQ.0 ) GOTO 999
     	NPKS = NPKS + 1
     	PEAK(NPKS) = 'KA1'
     	PHKL(1,NPKS) = RP(1)
     	PHKL(2,NPKS) = RP(2)
     	PHKL(3,NPKS) = RP(3)
     	FWHM(NPKS) = 0.100
     	F2TH(NPKS) = 0.01*RP(4)
     	C2TH(NPKS) = 0.01*RP(4)
     	FDSP(NPKS) = LAMDA/SIN(DTOR*F2TH(NPKS))
     	CDSP(NPKS) = FDSP(NPKS)
     	AREA(NPKS,JRES) = RP(8)
     	IF( NPKS.EQ.MNK ) GOTO 999
     	GOTO 200

666	CALL COLORS(-1)
     	CALL PUTEXT('ERROR: no peak list found in the input file.',
     	1 44, 24, 1 )
     	CALL PAUSES( 1 )
     	IERR = 3
     	GOTO 99
777	IERR = 1
     	GOTO 99
888	IERR = 2
     	GOTO 99
999	IF( NPKS.EQ.0 ) GOTO 666
C
C  CALCULATE THE RELATIVE INTENSITY...
C
     	DUMY = AREA(1,JRES)
     	DO I=2, NPKS
     	   IF( AREA(I,JRES).GT.DUMY ) DUMY = AREA(I,JRES)
     	ENDDO
     	DO I=1, NPKS
     	   RELA(I) = 100.0*AREA(I,JRES)/DUMY
     	ENDDO

99	RETURN
     	END
     	SUBROUTINE RLSUNK
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A ??? DATA FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE RLSXRR
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   MAY-1987
C
C	THIS ROUTINE READS THE PEAK LIST SECTION FROM AN X-RAY
C	RIETVELD OUTPUT FILE AND STORES IN THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER TEXT*95
     	DIMENSION RP(11), KP(11)

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='FORMATTED', READONLY, ERR=888 )
C
C  SEARCH FOR THE BEGINNING OF PEAK LIST SECTION...
C
     	TEXT = ' '
100	READ(IINP,1000,ERR=777,END=666) TEXT(1:40)
1000	FORMAT(A)
     	IF( TEXT.EQ.' ' ) GOTO 100
     	NCH = INDEX( TEXT(1:40), 'H   K   L     HW     POSN' )
     	IF( NCH.EQ.0 ) GOTO 100
C
C  READ THE PEAK LIST...
C
     	NPKS = 0
200	READ(IINP,1000,ERR=777,END=999) TEXT
     	IF( TEXT.EQ.' ' ) GOTO 200
     	NCH = NALPHA( TEXT, 95 )
     	CALL COMMAS( TEXT, NCH, 11, RP, KP, IDUM )
     	IF( NCH.EQ.0 ) GOTO 200
     	IF( NPKS.GT.0 .AND. F2TH(NPKS).EQ.RP(7) ) GOTO 200
     	IF( RP(2).EQ.2.0 ) GOTO 200	!SKIP KA2 PEAK
     	NPKS = NPKS + 1
     	PEAK(NPKS) = 'KA1'
     	PHKL(1,NPKS) = RP(3)
     	PHKL(2,NPKS) = RP(4)
     	PHKL(3,NPKS) = RP(5)
     	FWHM(NPKS) = RP(6)
     	F2TH(NPKS) = RP(7)
     	C2TH(NPKS) = RP(7)
     	FDSP(NPKS) = RP(10)
     	CDSP(NPKS) = RP(10)
     	RELA(NPKS) = RP(11)
     	AREA(NPKS,JRES) = RP(11)
     	IF( NPKS.EQ.MNK ) GOTO 999
     	GOTO 200

666	CALL COLORS(-1)
     	CALL PUTEXT('ERROR: no peak list found in the input file.',
     	1 44, 24, 1 )
     	CALL PAUSES( 1 )
     	IERR = 3
     	GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
     	GOTO 999
999	RETURN
     	END
     	SUBROUTINE RPLNBS
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A NBS RIETVELD OUTPUT LIST DATA FILE
C	AND WRITES OUT A BINARY PLOT DATA FILE FOR GRAFIT
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER TEXT*25
    	DIMENSION IDATA(21), YCAL(MNP)
C
C  OPEN THE INPUT FILE...
C
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='FORMATTED', READONLY, ERR=888 )

     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

     	ISEC = 0
     	NPTS = 0
C
C  SEARCH FOR THE BEGINNING OF INTENSITY LIST...
C
100     IF( ISEC.EQ.5 ) GOTO 222
     	READ(IINP,1000,ERR=222,END=222) TEXT
1000	FORMAT(A)
     	IF( TEXT.EQ.' ' ) GOTO 100
     	JUNK = INDEX( TEXT, 'POSITION  YOBS YCALC' )
     	IF( JUNK.EQ.0 ) GOTO 100
     	ISEC = ISEC + 1
     	JUNK = 0
C
C  READ THE INTENSITY POINTS...
C
111	READ(IINP,1001,ERR=100,END=777) IDATA
1001	FORMAT(X,I6,2X,20I6)
     	DO I=1, 10
     	   NPTS = NPTS + 1
     	   XOBS(NPTS) = 0.01*(IDATA(1)+(I-1)*5)
     	   YOBS(NPTS) = IDATA(2*I)
     	   YCAL(NPTS) = IDATA(2*I+1)
     	ENDDO
     	JUNK = JUNK + 1
     	IF( ISEC.NE.5 .AND. JUNK.EQ.40 ) GOTO 100
     	IF( ISEC.EQ.5 .AND. JUNK.EQ.44 ) GOTO 100
     	GOTO 111
222	IF( NPTS.EQ.0 ) GOTO 777
C
C  OPEN THE OUTPUT FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=555 )
     	JUNK = 0
     	WRITE(IOUT,ERR=555) NPTS, JUNK
     	WRITE(IOUT,ERR=555) (XOBS(I), I=1, NPTS)
     	WRITE(IOUT,ERR=555) (YOBS(I), I=1, NPTS)
     	WRITE(IOUT,ERR=555) NPTS, JUNK
     	WRITE(IOUT,ERR=555) (XOBS(I), I=1, NPTS)
     	WRITE(IOUT,ERR=555) (YCAL(I), I=1, NPTS)
     	GOTO 999

555	IERR = -1
     	GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RPLSHA
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A SHADOW OUTPUT PLOT DATA FILE
C	AND WRITES OUT A DATA FILE FOR GRAFIT.
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER TEXT*80, FILPAR*32, SLABL(20)*20
     	DIMENSION IDPL(20)

     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

C==============================================================
C  TRY TO OPEN THE INPUT FILE AS AN UNFORMATTED FILE FIRST...
C==============================================================

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE TITLE...
C
     	READ(IINP,ERR=1111,END=777) TEXT
     	READ(IINP,ERR=1111,END=777) BANG(1),BANG(2),BANG(3)
     	READ(IINP,ERR=1111,END=777) NSET,N1,N2,DUMY,N3,N4
     	DO I=1, NSET
     	   READ(IINP,ERR=1111,END=777) SLABL(I),N1,DUMY,N2,IDPL(I)
     	ENDDO
C
C  OPEN THE PARAMETER FILE...
C
     	CALL NAMEXT( FILOUT, FILPAR, 'PAR' )
     	CLOSE( UNIT=13 )
     	OPEN( UNIT=13, FILE=FILPAR, STATUS='UNKNOWN',
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=666 )

     	WRITE(13,1000,ERR=666) FILOUT, TEXT
1000	FORMAT('===> PARAMETER FILE FOR SHADOW OUTPUT FILE: ',A32,/
     	1'TITL=',A80,/'XLB1=TWO-THETA (DEGREES)'/'YLB1=INTENSITY (CPS)')
C
C  OPEN THE OUTPUT FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='FORMATTED', ERR=666 )

     	NSET = 0
     	N3 = 0
C
C  READ THE DATA RECORDS...
C
111	READ(IINP,ERR=1111,END=555) N1,N2,DUMY
     	NSET = NSET + 1

     	IF( IDPL(N1).NE.0 ) GOTO 222
C
C  INTENSITY DATA FOLLOW...
C
     	READ(IINP,ERR=1111,END=555) (YOBS(I),I=1, N2)
     	DO I=1, N2
     	   XOBS(I) = DUMY + (I-1)*BANG(3)
     	ENDDO
     	GOTO 115

222	IF( IDPL(N1).NE.1 ) GOTO 333
C
C  GENERL X,Y PAIR DATA FOLLOW...
C
     	READ(IINP,ERR=1111,END=555) (XOBS(I),YOBS(I), I=1, N2)
     	GOTO 115

333	IF( IDPL(N1).NE.2 ) GOTO 777
C
C  REFLECTION MARKER INFORMATION FOLLOWS...
C
C        WRITE(IOUT,*,ERR=666) N2+1
        WRITE(IOUT,*) N2+1
        DO 1102, I=1,N2
            READ(IINP,ERR=1111,END=555) DUMMY, YOBS(I), XOBS(I),
     1      DUMMY, N4 
            WRITE(IOUT,*) XOBS(I), DUMMY
1102        WRITE(IOUT,*) XOBS(I), YOBS(I)
        GOTO 1109
C
C  Write standard formatted XY pairs preceeded by the count
C  and label information to the .PAR file.
C
115	WRITE(IOUT,*,ERR=666) N2
        DO 1104, I=1,N2
1104        WRITE(IOUT,*,ERR=666) XOBS(I), YOBS(I)
1103    FORMAT(F10.4,1X,F10.4)
1109    WRITE(13,1101,ERR=666) NSET, NSET+1
1101	FORMAT('SSPI=',I3,',',I3,', 0, 1, 1, 1, 1, 2')
     	WRITE(13,1100,ERR=666) NSET, SLABL(N1)
1100	FORMAT('LABL=',I3,',',A20)
     	GOTO 111

C======================================================
C  OPEN THE INPUT FILE AS A FORMATTED FILE NEXT...
C======================================================

1111	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY,
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=888 )
C
C  READ THE TITLE...
C
     	READ(IINP,3000,ERR=777,END=777) TEXT
3000	FORMAT(A)
     	READ(IINP,3001,ERR=777,END=777) BANG(1),BANG(2),BANG(3)
3001	FORMAT(3F10.4)
     	READ(IINP,3002,ERR=777,END=777) NSET,N1,N2,DUMY,N3,N4
3002	FORMAT(3I6,F6.2,2I6)
     	DO I=1, NSET
     	   READ(IINP,3003,ERR=777,END=777) SLABL(I),N1,DUMY,N2,IDPL(I)
     	ENDDO
3003	FORMAT(A20,I6,F6.2,2I6)

C
C  OPEN THE PARAMETER FILE...
C
     	CALL NAMEXT( FILOUT, FILPAR, 'PAR' )
     	CLOSE( UNIT=13 )
     	OPEN( UNIT=13, FILE=FILPAR, STATUS='UNKNOWN',
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=666 )

     	WRITE(13,1000,ERR=666) FILOUT, TEXT
C
C  OPEN THE OUTPUT FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=666 )

     	NSET = 0
     	N3 = 0
C
C  READ THE DATA RECORDS...
C
2222	READ(IINP,3004,ERR=777,END=555) N1,N2,DUMY
3004	FORMAT(2I6,F10.4)
     	NSET = NSET + 1

     	IF( IDPL(N1).NE.0 ) GOTO 3333
C
C  INTENSITY DATA FOLLOW...
C
     	READ(IINP,3005,ERR=777,END=555) (YOBS(I),I=1, N2)
3005	FORMAT(10F8.1)
     	DO I=1, N2
     	   XOBS(I) = DUMY + (I-1)*BANG(3)
     	ENDDO
     	GOTO 2225

3333	IF( IDPL(N1).NE.1 ) GOTO 4444
C
C  GENERL X,Y PAIR DATA FOLLOW...
C
     	READ(IINP,3006,ERR=777,END=555) (XOBS(I),YOBS(I), I=1, N2)
3006	FORMAT(2F10.4)
     	GOTO 2225

4444	IF( IDPL(N1).NE.2 ) GOTO 777
C
C  REFLECTION MARKER INFORMATION FOLLOWS...
C
     	READ(IINP,3007,ERR=777,END=555) (DUMY,YOBS(I),XOBS(I),
     	1 DUMY,N4, I=1, N2 )
3007	FORMAT(4F10.4,I2)
     	WRITE(13,1101,ERR=666) NSET, -NSET-1

2225	WRITE(IOUT,ERR=666) N2, N3
     	WRITE(IOUT,ERR=666) ( XOBS(I), I=1, N2 )
     	WRITE(IOUT,ERR=666) ( YOBS(I), I=1, N2 )
     	WRITE(13,1100,ERR=666) NSET, SLABL(N1)
     	GOTO 2222

555	IF( NSET.GT.0 ) GOTO 999
777	IERR = 1
     	GOTO 999
666	IERR = -1
     	GOTO 999
888	IERR = 2
     	GOTO 999
999	CLOSE( UNIT=13 )
     	RETURN
     	END
     	SUBROUTINE RPLUNK
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A ??? DATA FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE RPLXRR
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM AN X-RAY RIETVELD OUTPUT PLOT
C	DATA FILE AND WRITES OUT A DATA FILE FOR GRAFIT.
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER TEXT*80, FILPAR*32, SLABL(20)*20
     	DIMENSION IDPL(20)

     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

C==============================================================
C  TRY TO OPEN THE INPUT FILE AS AN UNFORMATTED FILE FIRST...
C==============================================================

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE TITLE...
C
     	READ(IINP,ERR=1111,END=777) TEXT
     	READ(IINP,ERR=1111,END=777) BANG(1),BANG(2),BANG(3)
     	READ(IINP,ERR=1111,END=777) NSET,N1,N2,DUMY,N3,N4
     	DO I=1, NSET
     	   READ(IINP,ERR=1111,END=777) SLABL(I),N1,DUMY,N2,IDPL(I)
     	ENDDO
C
C  OPEN THE PARAMETER FILE...
C
     	CALL NAMEXT( FILOUT, FILPAR, 'PAR' )
     	CLOSE( UNIT=13 )
     	OPEN( UNIT=13, FILE=FILPAR, STATUS='UNKNOWN',
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=666 )

     	WRITE(13,1000,ERR=666) FILOUT, TEXT
1000	FORMAT('===> PARAMETER FILE FOR RIETVELD OUTPUT FILE: ',A32,/
     	1'TITL=',A80,/'XLB1=TWO-THETA (DEGREES)'/'YLB1=INTENSITY (CPS)')
C
C  OPEN THE OUTPUT FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=666 )

     	NSET = 0
     	N3 = 0
C
C  READ THE DATA RECORDS...
C
111	READ(IINP,ERR=1111,END=555) N1,N2,DUMY
     	NSET = NSET + 1

     	IF( IDPL(N1).NE.0 ) GOTO 222
C
C  INTENSITY DATA FOLLOW...
C
     	READ(IINP,ERR=1111,END=555) (YOBS(I),I=1, N2)
     	DO I=1, N2
     	   XOBS(I) = DUMY + (I-1)*BANG(3)
     	ENDDO
     	GOTO 115

222	IF( IDPL(N1).NE.1 ) GOTO 333
C
C  GENERL X,Y PAIR DATA FOLLOW...
C
     	READ(IINP,ERR=1111,END=555) (XOBS(I),YOBS(I), I=1, N2)
     	GOTO 115

333	IF( IDPL(N1).NE.2 ) GOTO 777
C
C  REFLECTION MARKER INFORMATION FOLLOWS...
C
COLD FORMAT
C     	READ(IINP,ERR=1111,END=555) (DUMY,YOBS(I),XOBS(I),DUMY,N4,I=1,N2)
COLD FORMAT
     	DO 1102 I=1,N2
1102   	READ(IINP,ERR=1111,END=555) DUMY,YOBS(I),XOBS(I),DUMY,N4
     	WRITE(13,1101,ERR=666) NSET, -NSET-1
1101	FORMAT('SSPI=',I3,',',I3,', 0, 1, 1, 1, 1, 2')

115	WRITE(IOUT,ERR=666) N2, N3
     	WRITE(IOUT,ERR=666) ( XOBS(I), I=1, N2 )
     	WRITE(IOUT,ERR=666) ( YOBS(I), I=1, N2 )
     	WRITE(13,1100,ERR=666) NSET, SLABL(N1)
1100	FORMAT('LABL=',I3,',',A20)
     	GOTO 111

C======================================================
C  OPEN THE INPUT FILE AS A FORMATTED FILE NEXT...
C======================================================

1111	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY,
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=888 )
C
C  READ THE TITLE...
C
     	READ(IINP,3000,ERR=777,END=777) TEXT
3000	FORMAT(A)
     	READ(IINP,3001,ERR=777,END=777) BANG(1),BANG(2),BANG(3)
3001	FORMAT(3F10.4)
     	READ(IINP,3002,ERR=777,END=777) NSET,N1,N2,DUMY,N3,N4
3002	FORMAT(3I6,F6.2,2I6)
     	DO I=1, NSET
     	   READ(IINP,3003,ERR=777,END=777) SLABL(I),N1,DUMY,N2,IDPL(I)
     	ENDDO
3003	FORMAT(A20,I6,F6.2,2I6)

C
C  OPEN THE PARAMETER FILE...
C
     	CALL NAMEXT( FILOUT, FILPAR, 'PAR' )
     	CLOSE( UNIT=13 )
     	OPEN( UNIT=13, FILE=FILPAR, STATUS='UNKNOWN',
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=666 )

     	WRITE(13,1000,ERR=666) FILOUT, TEXT
C
C  OPEN THE OUTPUT FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=666 )

     	NSET = 0
     	N3 = 0
C
C  READ THE DATA RECORDS...
C
2222	READ(IINP,3004,ERR=777,END=555) N1,N2,DUMY
3004	FORMAT(2I6,F10.4)
     	NSET = NSET + 1

     	IF( IDPL(N1).NE.0 ) GOTO 3333
C
C  INTENSITY DATA FOLLOW...
C
     	READ(IINP,3005,ERR=777,END=555) (YOBS(I),I=1, N2)
3005	FORMAT(10F8.1)
     	DO I=1, N2
     	   XOBS(I) = DUMY + (I-1)*BANG(3)
     	ENDDO
     	GOTO 2225

3333	IF( IDPL(N1).NE.1 ) GOTO 4444
C
C  GENERL X,Y PAIR DATA FOLLOW...
C
     	READ(IINP,3006,ERR=777,END=555) (XOBS(I),YOBS(I), I=1, N2)
3006	FORMAT(2F10.4)
     	GOTO 2225

4444	IF( IDPL(N1).NE.2 ) GOTO 777
C
C  REFLECTION MARKER INFORMATION FOLLOWS...
C
     	READ(IINP,3007,ERR=777,END=555) (DUMY,YOBS(I),XOBS(I),
     	1 DUMY,N4, I=1, N2 )
3007	FORMAT(4F10.4,I2)
     	WRITE(13,1101,ERR=666) NSET, -NSET-1

2225	WRITE(IOUT,ERR=666) N2, N3
     	WRITE(IOUT,ERR=666) ( XOBS(I), I=1, N2 )
     	WRITE(IOUT,ERR=666) ( YOBS(I), I=1, N2 )
     	WRITE(13,1100,ERR=666) NSET, SLABL(N1)
     	GOTO 2222

555	IF( NSET.GT.0 ) GOTO 999
777	IERR = 1
     	GOTO 999
666	IERR = -1
     	GOTO 999
888	IERR = 2
999	CLOSE( UNIT=13 )
     	RETURN
     	END
     	SUBROUTINE RRW011
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A DIFFRAC-11 RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	DIMENSION NRNS(20)
     	CHARACTER DAY*12, TIM*8

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     	1 ACCESS='DIRECT', RECL=1, READONLY )
C
C  READ THE FILE HEADER BLOCK...
C
     	READ(IINP,REC= 1,ERR=777) SLID(1)
     	READ(IINP,REC= 2,ERR=777) SLID(2)
     	READ(IINP,REC= 3,ERR=777) SLID(3)
     	READ(IINP,REC= 4,ERR=777) SLID(4)
     	READ(IINP,REC= 5,ERR=777) DAY(1:4)
     	READ(IINP,REC= 6,ERR=777) DAY(5:8)
     	READ(IINP,REC= 7,ERR=777) DAY(9:12)
     	READ(IINP,REC= 8,ERR=777) TIM(1:4)
     	READ(IINP,REC= 9,ERR=777) TIM(5:8)
     	DATM = DATCOD( DAY(1:9) )
     	TIMM = TIMCOD( TIM(1:8) )
     	READ(IINP,REC= 10,ERR=777) NAME(1)
     	READ(IINP,REC= 11,ERR=777) NAME(2)
     	READ(IINP,REC= 12,ERR=777) NAME(3)
     	READ(IINP,REC= 14,ERR=777) WAVE(1,6)	!WAVE LENGTH: KA1
     	IF( WAVE(1,6).LE.0.0 ) GOTO 777
     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I
     	ENDDO
C
C  READ THE LINE MEASUREMENT BLOCK...
C
     	READ(IINP,REC= 30,ERR=777) NRNG		!NUMBER OF SCAN RANGES
     	IF( NRNG.LT.1 ) GOTO 777
C
C  SHOW ALL THE RANGES...
C
     	IF( NRNG.GT.1 ) WRITE(6,2000)
2000	FORMAT(/' RANGE  BEGIN  ENDING   STEP   SECS   MAXCOUNTS',
     	1'  MAX2THETA  MINCOUNTS  MIN2THETA'/,X,80('-'))
2001	FORMAT(X,I3,2X,4(F7.3,X),X,2(G11.4,X,F8.3))
     	IREC = 31
     	DO J=1, NRNG
     	   READ(IINP,REC= IREC,ERR=777) BANG(1)
     	   	IREC = IREC + 1
     	   READ(IINP,REC= IREC,ERR=777) BANG(2)
     	   	IREC = IREC + 1
     	   READ(IINP,REC= IREC,ERR=777) BANG(3)
     	   	IF( BANG(3).LE.0.0 ) GOTO 777
     	   	IREC = IREC + 1
     	   READ(IINP,REC= IREC,ERR=777) BANG(10)
     	   	IF( BANG(10).LE.0.0 ) GOTO 777
     	   	IREC = IREC + 1
     	   	IF( J.EQ.1 ) THEN
     	   READ(IINP,REC= IREC,ERR=777) BANG(14)
     		IREC = IREC + 1
     	   	ENDIF
     	   NPTS = INT( (BANG(2)-BANG(1))/BANG(3)+0.5 ) + 1
     	   	BANG(4) = -1.0E+38
     	   	BANG(6) =  1.0E+38
     	   DO I=1, NPTS				!SEARCH FOR MAX&MIN
     	      READ(IINP,REC= IREC,ERR=777) DUMY
     	      IREC = IREC + 1
     	      IF( DUMY.GT.BANG(4) ) THEN
     		  BANG(4) = DUMY
     		  IMAX = I
     	      ENDIF
     	      IF( DUMY.LT.BANG(6) ) THEN
     		  BANG(6) = DUMY
     		  IMIN = I
     	      ENDIF
     	      YOBS(I) = DUMY
     	   ENDDO
     	   BANG(5) = BANG(1) + BANG(3)*(IMAX-1)
     	   BANG(7) = BANG(1) + BANG(3)*(IMIN-1)
     	   IF( NRNG.GT.1 ) WRITE(6,2001) J, BANG(1),BANG(2),
     	1  BANG(3),BANG(10),BANG(4),BANG(5),BANG(6),BANG(7)
     	   NRNS(J) = NPTS + 4
     	   IF( J.EQ.1 ) NRNS(J) = NPTS + 5
     	ENDDO
     	IRNG = NRNG
     	IF( NRNG.EQ.1 ) GOTO 999	!EXIT
C
C  GET A SPECIFIC RANGE...
C
2004	WRITE(6,2005)
2005	FORMAT(/
     	1' Only one range can be converted at a time.'/
     	1'$Which range to use? <1> ')
     	READ(5,1001,ERR=2004,END=2004) IRNG
1001	FORMAT(I)
     	IF( IRNG.LT.1 .OR. IRNG.GT.NRNG ) IRNG = 1
C
C  READ THE INTENSITY DATA BLOCK...
C
     	IREC = 31
     	DO I=1, IRNG-1			!JUMP TO THE RANGE
     	   IREC = IREC + NRNS(I)
     	ENDDO

     	READ(IINP,REC= IREC,ERR=777) BANG(1)
     		IREC = IREC + 1
     	READ(IINP,REC= IREC,ERR=777) BANG(2)
     	   	IREC = IREC + 1
     	READ(IINP,REC= IREC,ERR=777) BANG(3)
     		IREC = IREC + 1
     	READ(IINP,REC= IREC,ERR=777) BANG(10)
     		IREC = IREC + 1
     		IF( IRNG.EQ.1 ) THEN
     	READ(IINP,REC= IREC,ERR=777) BANG(14)
     		IREC = IREC + 1
     		ENDIF
     	NPTS = INT( (BANG(2)-BANG(1))/BANG(3)+0.5 ) + 1
     		BANG(4) = -1.0E+38
     		BANG(6) =  1.0E+38
     		DO I=1, NPTS			!SEARCH FOR MAX&MIN
     	READ(IINP,REC= IREC,ERR=777) DUMY
     		IREC = IREC + 1
     		IF( DUMY.GT.BANG(4) ) THEN
     		    BANG(4) = DUMY
     		    IMAX = I
     		ENDIF
     		IF( DUMY.LT.BANG(6) ) THEN
     		    BANG(6) = DUMY
     		    IMIN = I
     		ENDIF
     		YOBS(I) = DUMY
     		ENDDO
     	BANG(5) = BANG(1) + BANG(3)*(IMAX-1)
     	BANG(7) = BANG(1) + BANG(3)*(IMIN-1)
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRW05A
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A DIFFRAC-5 (ALFRED) RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DAY*9, TIM*8
C
C  TRY TO OPEN THE INPUT FILE AS UNFORMATTED FILE FIRST...
C
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,ERR=111,END=777) SLID
     	READ(IINP,ERR=111,END=777) DAY, TIM
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
     	READ(IINP,ERR=111,END=777) BANG(1),BANG(2),BANG(3),BANG(10)
C
C  READ THE INTENSITY DATA...
C
     	NPTS = INT((BANG(2)-BANG(1))/BANG(3)+0.1) + 1
     	IF( NPTS.LT.1 ) GOTO 777
     	NLINE = NPTS/10
     	IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1
     	DO I=1, NLINE
     	   READ(IINP,ERR=111,END=777) (YOBS(J), J=1+10*(I-1), 10*I)
     	ENDDO
     	GOTO 999
C
C  OPEN THE INPUT FILE AS FORMATTED FILE NEXT...
C
111	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,1000,ERR=777,END=777) SLID
1000	FORMAT(20A4)
     	READ(IINP,1001,ERR=777,END=777) DAY, TIM
1001	FORMAT(A9,3X,A8)
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
     	READ(IINP,1100,ERR=777,END=777) BANG(1),BANG(2),BANG(3),BANG(10)
1100	FORMAT(4F10.4)
C
C  READ THE INTENSITY DATA...
C
     	NPTS = INT((BANG(2)-BANG(1))/BANG(3)+0.1) + 1
     	IF( NPTS.LT.1 ) GOTO 777
     	READ(IINP,1200,ERR=777,END=777) (YOBS(I),I=1, NPTS)
1200	FORMAT(10F8.1)
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRW05S
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A DIFFRAC-5 (SIEMENS) RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DAY*9, TIM*8
C
C  TRY TO OPEN THE INPUT FILE AS UNFORMATTED FILE FIRST...
C
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,ERR=111,END=777) SLID
     	READ(IINP,ERR=111,END=777) DAY, TIM
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
     	READ(IINP,ERR=111,END=777) BANG(1),BANG(2),BANG(3),BANG(10)
C
C  READ THE INTENSITY DATA...
C
     	NPTS = INT((BANG(2)-BANG(1))/BANG(3)+0.1) + 1
     	IF( NPTS.LT.1 ) GOTO 777
     	NLINE = NPTS/10
     	IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1
     	DO I=1, NLINE
     	   READ(IINP,ERR=111,END=777) (YOBS(J), J=1+10*(I-1), 10*I)
     	ENDDO
     	GOTO 999
C
C  OPEN THE INPUT FILE AS FORMATTED FILE NEXT...
C
111	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,1000,ERR=777,END=777) SLID
1000	FORMAT(20A4)
     	READ(IINP,1001,ERR=777,END=777) DAY, TIM
1001	FORMAT(A9,3X,A8)
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
     	READ(IINP,1100,ERR=777,END=777) BANG(1),BANG(2),BANG(3),BANG(10)
1100	FORMAT(4F10.4)
C
C  READ THE INTENSITY DATA...
C
     	NPTS = INT((BANG(2)-BANG(1))/BANG(3)+0.1) + 1
     	IF( NPTS.LT.1 ) GOTO 777
     	READ(IINP,1200,ERR=777,END=777) (YOBS(I),I=1, NPTS)
1200	FORMAT(10F8.1)
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRW500
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C  MODIFIED: JDW 4-JUL-89 TO READ A PSD FILE.
C
C	THIS ROUTINE READS FROM A DIFFRAC-500 RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 DUMY
     	DIMENSION NRNS(20)
	REAL*4 PSDANG

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     	1 ACCESS='DIRECT', RECL=1, READONLY )
C
C  READ THE FILE HEADER BLOCK...
C
     	READ(IINP,REC= 1,ERR=777) DUMY,ITYP
     	IF( ITYP.NE.1 ) GOTO 777
     	READ(IINP,REC= 2,ERR=777) NHDB
     	READ(IINP,REC= 3,ERR=777) ISBF
     	READ(IINP,REC= 4,ERR=777) LENG
     	READ(IINP,REC= 5,ERR=777) DUMY
     	IF( LENG.LT.3 ) GOTO 777
C
C  READ THE SPECIFICATION BLOCK REFERENCES...
C
     	IREC = ISBF
     	DO I=1, LENG/3
     	   READ(IINP,REC= IREC  ,ERR=777) IRPR(I,1)
     	   READ(IINP,REC= IREC+1,ERR=777) IRPR(I,2)
     	   READ(IINP,REC= IREC+2,ERR=777) IRLR(I)
     	   IREC = IREC + 3
     	ENDDO
C
C  READ THE INSTRUMENTATION BLOCK...
C
     	IREC = IRPR(1,1) + 5
     	DO I=1, 5		!READ THE WAVE SOURCES
     	   READ(IINP,REC=IREC,ERR=777) WAVE(I,6)
     	   IREC = IREC + 1
     	ENDDO
     	IF( WAVE(1,6).LE.0.0 ) GOTO 777
     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I
     	ENDDO
	READ(IINP,REC=IRPR(1,1)+22) PSDANG	!JDW
C
C  READ THE FILE DESCRIPTION BLOCK...
C
     	IREC = IRPR(3,1)
     	READ(IINP,REC= IREC  ,ERR=777) NAME(1)
     	READ(IINP,REC= IREC+1,ERR=777) NAME(2)
     	READ(IINP,REC= IREC+2,ERR=777) NAME(3)
     	READ(IINP,REC= IREC+3,ERR=777) DATM
     	READ(IINP,REC= IREC+4,ERR=777) TIMM
     	READ(IINP,REC= IREC+5,ERR=777) FTYP,MTYP
     	READ(IINP,REC= IREC+8,ERR=777) NREP,MPRO
     	IF( NREP.LT.1 ) GOTO 777
     	READ(IINP,REC= IREC+9,ERR=777) NRNG,SCAN
C      	IF( NRNG.LT.1 .OR. SCAN.NE.'S' ) GOTO 777	!JDW
     	IF( NRNG.LT.1 ) GOTO 777	!JDW
     	READ(IINP,REC= IREC+14,ERR=777) STYP
     	IREC = IREC + 15
     	DO I=1, 15
     	   READ(IINP,REC= IREC,ERR=777) SLID(I)
     	   IREC = IREC + 1
    	ENDDO
C
C  READ THE LINE MEASUREMENT BLOCK...
C
     	IREC = IRPR(4,1)
C
C  SHOW ALL THE RANGES...
C
     	IF( NRNG.GT.1 ) WRITE(6,2000)
2000	FORMAT(/' RANGE  BEGIN  ENDING   STEP   SECS   MAXCOUNTS',
     	1'  MAX2THETA  MINCOUNTS  MIN2THETA'/,X,80('-'))
2001	FORMAT(X,I3,2X,4(F7.3,X),X,2(G11.4,X,F8.3))
     	NPTS = 0
     	DO J=1, NRNG
     	   DO I=1, 14
     	      READ(IINP,REC= IREC,ERR=777) BANG(I)
     	      IREC = IREC + 1
     	   ENDDO
     	      IF(NRNG.GT.1)IREC = IREC + 1 !this line added 4/12/88
					!by Martin McMillan
C	Fudge the count time in a PSD file.			!JDW
	   IF(SCAN.EQ.'C') BANG(10) = 60.0 * PSDANG / BANG(10)	!JDW
     	   IF( BANG(3).LE.0.0 .OR. BANG(10).LE.0.0 ) GOTO 777
     	   IF( NRNG.GT.1 ) WRITE(6,2001) J, BANG(1),BANG(2),
     	1  BANG(3),BANG(10),BANG(4),BANG(5),BANG(6),BANG(7)
     	   NRNS(J) = INT( (BANG(2)-BANG(1))/BANG(3)+0.5 ) + 1
     	   NPTS = NPTS + NRNS(J)
     	ENDDO
     	IRNG = NRNG
     	IF( NRNG.GT.1 ) THEN
C
C  GET A SPECIFIC RANGE...
C
2004	    WRITE(6,2005)
     	    READ(5,1001,ERR=2004,END=2004) DUMY
     	    IF( DUMY.LT.1 .OR. DUMY.GT.NRNG ) DUMY = 1
     	    IRNG = DUMY
     	    IREC = IRPR(4,1) + 15*(IRNG-1) !changed from ... + 14*(irng-1)
					!on 4/12/88 by Martin McMillan
     	    DO I=1, 14
     	       READ(IINP,REC= IREC,ERR=777) BANG(I)
     	       IREC = IREC + 1
     	    ENDDO
2005	FORMAT(/
     	1' Only one range can be converted at a time.'/
     	1'$Which range to use? <1> ')
     	ENDIF
C
C  READ THE INTENSITY DATA BLOCK...
C
     	IF( NREP.GT.1 ) THEN
     	    DUMY = LDIGIT( NREP )
1002	    WRITE(6,1000) NREP
     	    READ(5,1001,ERR=1002,END=1002) DUMY
     	    IF( DUMY.LT.1 .OR. DUMY.GT.NREP ) DUMY = 1
     	    NREP = DUMY
     	ENDIF
1000	FORMAT(/
     	1' Input file contains ',I<DUMY>,' series of measurements'/
     	1' but only one measurement can be converted at a time.'/
     	1'$Which measurement to use? <1> ')
1001	FORMAT(I)

     	IREC = IRPR(6,1)
     	IREC = IREC + (NREP-1)*NPTS	!JUMP TO THE MEASUEMENT
     	NPTS = 0
     	DO I=1, IRNG-1
     	   NPTS = NPTS + NRNS(I)
     	ENDDO
     	IREC = IREC + NPTS		!JUMP TO THE RANGE
     	NPTS = INT( (BANG(2)-BANG(1))/BANG(3)+0.5 ) + 1
     	DO I=1, NPTS
     	   READ(IINP,REC= IREC,ERR=777) YOBS(I)
     	   IREC = IREC + 1
     	ENDDO
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWMDI
C
C  PROGRAMMER:  R. L SNYDER
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS IN AN MDI RAW DATA FILE
C	TO THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, DAY*9, TIM*8, TMP*2

C
C  OPEN THE INPUT FILE AS FORMATTED FILE 
C
111	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C

     	READ(IINP,1000,ERR=777,END=777) 
     1 ID1,ID2,ID3,(SLID(I),I=1,14)
1000	FORMAT(7X,3(I2,1X),6X,14A4)
     	DATM = ID1*10000. + ID2*100. + ID3
     	TIMM = 0

     	IELE = 4
     	READ(IINP,1100,ERR=777,END=777) BANG(1),BANG(3),BANG(10),
     1 TMP, W, BANG(2), NPTS
1100	FORMAT(F7.3,F6.3,F6.1,1X,A2,F10.6,F8.3,I7)
     	IELE = 4
     	IF(TMP.EQ.'Cr') IELE = 1
     	IF(TMP.EQ.'Fe') IELE = 2
     	IF(TMP.EQ.'Co') IELE = 3
     	IF(TMP.EQ.'Mo') IELE = 5

C
C  READ THE INTENSITY DATA...
C
     	IF( NPTS.LT.1 ) GOTO 777
     	READ(IINP,1200,ERR=777,END=777) (YOBS(I),I=1, NPTS)
1200	FORMAT(8F8.0)
     	IF(YOBS(NPTS).LT.0) NPTS = NPTS-1
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWNBS
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A NBS RIETVELD RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1
    	DIMENSION IDATA(1000)

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', FORM='FORMATTED',
     	1 CARRIAGECONTROL='LIST', READONLY, ERR=888 )

     	WAVE(1,IELE) = 1.5416		!DEFAULT WAVELENGTH
     	SPAN = 20.0			!COVERED BY EACH DETECTOR
C
C  READ THE FILE HEADER...
C
     	READ(IINP,1000,ERR=777,END=777) SLID
1000	FORMAT(20A4)
     	READ(IINP,1000,ERR=777,END=777) IQS	!SKIP ONE LINE

     	NPTS = 0
     	ISEC = 0
C
C  READ THE SCAN PARAMETERS...
C
111	READ(IINP,1001,ERR=777,END=666) N1, N3, N2, SCALE
1001	FORMAT(3I8,2F8.0)

     	ISEC = ISEC + 1
     	IF( ISEC.EQ.1 ) THEN
     	    BANG(1) = 0.01 * N1
     	    BANG(2) = BANG(1)
     	    BANG(3) = 0.01 * N3
     	ENDIF
     	N2 = (N2-N1)/N3 + 1
     	READ(IINP,1002,ERR=777,END=666) (IDATA(I), I=1, N2)
1002	FORMAT(12I6)
     	IF( ISEC.EQ.5 ) SPAN = 0.01*(N2-1)*N3
     	N1 = SPAN / BANG(3)
     	IF( ISEC.EQ.5 ) N1 = N1 + 1
     	DO I=1, N1
     	   NPTS = NPTS + 1
     	   YOBS(NPTS) = IDATA(I)*SCALE
     	ENDDO
C
C  UPDATE THE ENDING ANGLE...
C
     	BANG(2) = BANG(2) + SPAN
     	GOTO 111

666	IF( ISEC.GT.0 ) GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWNIC
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A NICOLET RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 ITIT(40), DATTIM(6), NRNS, IDUM, IBUF(100)
     	EQUIVALENCE (ITIT, SLID)
     	REAL*4 FWAVE(4), DUMY(12), RANGE(9,100)

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,ERR=777,END=777) ITIT, DATTIM, FWAVE, DUMY, IDUM,
     	1 IDUM, IDUM, DUMY, NRNS, RANGE

     	IF( NRNS.LT.1 .OR. NRNS.GT.100 ) GOTO 777
     	NRNG = NRNS
     	WAVE(1,6) = FWAVE(2)
     	WAVE(2,6) = FWAVE(3)
     	WAVE(3,6) = FWAVE(1)
     	WAVE(5,6) = 2.0
     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I
     	ENDDO
     	IF( NRNG.EQ.1 ) GOTO 111
C
C  ONLY ONE RANGE CAN BE HANDLED AT A TIME...
C
100	NRNS = LDIGIT( NRNG )
     	WRITE(6,1000) NRNG
1000	FORMAT(/
     	1' Input file contains ',I<NRNS>,' ranges of data'/
     	1' but only one range can be converted at a time.'/
     	1'$Which range to use? <1> ')
     	READ(5,1001,ERR=100,END=100) NRNS
1001	FORMAT(I)
     	IF( NRNS.LT.1 .OR. NRNS.GT.NRNG ) NRNS = 1
     	IF( NRNS.EQ.1 ) GOTO 111
C
C  SKIP THE RANGES...
C
     	IDIR = 0
     	DO I=1, NRNS-1
     	   NPTS = RANGE(8,I)
     	   IDUM = NPTS/100
     	   IF( IDUM*100 .LT. NPTS ) IDUM = IDUM + 1
     	   IDIR = IDIR + IDUM
     	ENDDO
     	DO I=1, IDIR
     	   READ(IINP,ERR=777,END=777) IDUM
     	ENDDO
C
C  READ THE INTENSITY DATA...
C
111	BANG(1) = RANGE(1,NRNS)
     	BANG(2) = RANGE(2,NRNS)
     	BANG(3) = RANGE(5,NRNS)
     	BANG(10)= RANGE(7,NRNS)
     	NPTS = RANGE(8,NRNS)
     	IDIR = RANGE(9,NRNS)		!SCAN DIRECTION: 1=F, 2=R
     	IJ = 0
     	K  = 1
     	IF( IDIR.EQ.2 ) THEN
     	    IJ = NPTS+1			!COUNT DOWN
     	    K  = -1
     	ENDIF
     	NRNS = NPTS/100
     	IF( NRNS*100 .LT. NPTS ) NRNS = NRNS + 1
     	DO I=1, NRNS
     	   READ(IINP,ERR=777,END=777) IBUF
     	   DO J=1, 100
     	      IJ = IJ + K
     	      YOBS(IJ) = IBUF(J)
     	   ENDDO
     	ENDDO
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWPDF
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE READS FROM A JCAMP - PDF3  RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE RRWRIG
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE READS FROM A RIGAKU RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS

c
c	Updated to read unformatted Rigaku raw data files.
c	Martin McMillan: March 9,1988
c	


     	INCLUDE 'FILECONV.CBS'
	character ans*4,time*8,date*12
	integer*2 nnpts

     	CLOSE( UNIT=IINP )

c	old stuff

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
c     	INCLUDE 'FILECONV.CBS'


c     	INTEGER*2 ITIT(40)
c     	EQUIVALENCE (ITIT,SLID)

c     	CLOSE( UNIT=IINP )
c     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
c     	1 FORM='FORMATTED', READONLY, ERR=888 )


CC
CC  READ THE FILE HEADER INFORMATION...
CC


C     	READ(IINP,1,ERR=777,END=777)
C     	READ(IINP,1,ERR=777,END=777) ITIT
C1	FORMAT(40A2)
C     	READ(IINP,2,ERR=777,END=777) BANG(1)
C2	FORMAT(G)
C     	READ(IINP,2,ERR=777,END=777) BANG(2)
C     	READ(IINP,2,ERR=777,END=777) BANG(3)
C     	READ(IINP,2,ERR=777,END=777) BANG(10)
C     	READ(IINP,2,ERR=777,END=777) DUMMY
C     	READ(IINP,3,ERR=777,END=777) NPTS
C3	format(i5)
CC
CC  READ THE INTENSITY DATA...
CC
C     	DO I=1, NPTS
C     	   READ(IINP,2,ERR=777,END=666) YOBS(I)
C     	ENDDO
c666	NPTS = I-1
c     	IF( NPTS.GT.0 ) GOTO 999
C     	GOTO 999

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

c
c	update: March 9,1988
c
     	OPEN( UNIT=IINP, FILE=FILINP, ACCESS ='DIRECT', STATUS='OLD',
     	1 FORM='UNFORMATTED', RECL=1, READONLY, ERR=888 )

C
C  READ THE FILE HEADER INFORMATION...
C
	read(iinp,rec=1,err=777)ans
		if((ans(1:4).eq.'.RAW').or.(ans(1:4).eq.'.raw'))then
			ityi=1
		else
			type *,'file is not .RAW type'
			goto 777
		end if
	read(iinp,rec=2,err=777)date(1:4)
	read(iinp,rec=3,err=777)date(5:8)
	read(iinp,rec=4,err=777)date(9:12)
	read(iinp,rec=5,err=777)time(1:4)
	read(iinp,rec=6,err=777)time(5:8)
	datm=datcod(date(1:9))
	timm=timcod(time)

	do i=1,10
		read(iinp,rec=6+i,err=777)slid(i)
	enddo

	read(iinp,rec=17,err=777)junk
		if(junk.eq.1)slid(11)=' R  '
		if(junk.eq.2)slid(11)=' L  '

	read(iinp,rec=18,err=777)junk
		if(junk.eq.1)scan='C'
		if(junk.eq.2)scan='S'

	read(iinp,rec=19,err=777)junk
		if(junk.eq.1)slid(12)='Stnd'
		if(junk.eq.2)slid(12)='Int '
		if(junk.eq.3)slid(12)='Skip'

	read(iinp,rec=20,err=777)junk2
		encode(4,1000,ans)junk2
		if(junk.eq.1)slid(13)=ans
		if(junk.eq.1)slid(14)='#Rep'
		if(junk.eq.2)slid(13)=ans
		if(junk.eq.2)slid(14)='#Int'
		if(junk.eq.3)slid(13)=ans
		if(junk.eq.3)slid(14)='TVC'

	read(iinp,rec=21,err=777)bang(2)

	read(iinp,rec=23,err=777)junk
		encode(4,1000,ans)junk
		slid(15)=ans
		slid(16)=' KV '

	read(iinp,rec=24,err=777)junk
		encode(4,1000,ans)junk
		slid(17)=ans
		slid(18)=' MA '

	read(iinp,rec=25,err=777)ans(1:2)
		if((ans(1:2).eq.'Cr').or.(ans(1:2).eq.'CR'))then
			iele=1
		else if((ans(1:2).eq.'Fe').or.(ans(1:2).eq.'FE'))then
			iele=2
		else if((ans(1:2).eq.'Co').or.(ans(1:2).eq.'CO'))then
			iele=3
		else if((ans(1:2).eq.'Cu').or.(ans(1:2).eq.'CU'))then
			iele=4
		else if((ans(1:2).eq.'Mo').or.(ans(1:2).eq.'MO'))then
			iele=5
		else
			iele=6
		endif

	if(iele.eq.6)then
		read(iinp,rec=31,err=777)wave(3,iele)
		read(iinp,rec=32,err=777)wave(1,iele)
		read(iinp,rec=33,err=777)wave(2,iele)
		read(iinp,rec=34,err=777)wave(4,iele)
	endif

	read(iinp,rec=35,err=777)bang(1)
	read(iinp,rec=36,err=777)bang(3)
	read(iinp,rec=37,err=777)nnpts,mpro
		npts=nnpts
		if(mpro.eq.1)mpro=1
		if(mpro.eq.2)mpro=4
		if(mpro.eq.3)mpro=3
	read(iinp,rec=38,err=777)bang(10)
	read(iinp,rec=44,err=777)bang(4)
	

C
C  READ THE INTENSITY DATA...
	do i=1,npts
		read(iinp,rec=50+i,err=777)yobs(i)
	enddo
	goto 999

C

c	old stuff retained:

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
1000	FORMAT(I4)
     	END
     	SUBROUTINE RRWRIO
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  March 1989
C
C	THIS ROUTINE READS IN A RIGAKU ORIGINAL UNFORMATED RAW DATA FILE
C	TO THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
        INTEGER*2 FILNUM, MONTH, DAY, YEAR, MPTS
        CHARACTER INSTR*4
C
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     1 FORM='UNFORMATTED', ACCESS='SEQUENTIAL' )
C     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
C     1 FORM='UNFORMATTED', ACCESS='SEQUENTIAL',ERR=888 )
C
C *********************************************************************
C * READ FIRST RECORD OF THE RAW DATA FILE CONTAINING SAMPLE IDENTIFICATION
C * AND EXPERIMENTAL DATA COLLECTION PARAMETERS
C *********************************************************************
C
      READ( IINP, ERR=888, IOSTAT=IERR) FILNUM, MONTH, DAY, 
     &          YEAR, INSTR,
     &		(SLID(I),I=1,12), BANG(1), BANG(3), BANG(10), ANODE(6), 
     &		XLAMDA, BANG(2), MPTS
C
     	DATM = IDAY + MONTH*100 + YEAR
     	TIMM = 0.0
C
	if((ANODE(6).EQ.'Cr').or.(ANODE(6).eq.'CR'))then
			iele=1
	else if((ANODE(6).eq.'Fe').or.(ANODE(6).eq.'FE'))then
			iele=2
	else if((ANODE(6).eq.'Co').or.(ANODE(6).eq.'CO'))then
			iele=3
	else if((ANODE(6).eq.'Cu').or.(ANODE(6).eq.'CU'))then
			iele=4
	else if((ANODE(6).eq.'Mo').or.(ANODE(6).eq.'MO'))then
			iele=5
	else
			iele=6
	endif
C
     	IF( XLAMDA .NE. 0.0) WAVE(3,IELE) = XLAMDA
C
C Read the intensities from each input record 32 per record.
C
     	NPTS = MPTS
C	NREC = (MPTS-1)/32 + 1
        DO 50 I = 1, NPTS, 32
	READ( IINP, ERR=777, END=666) (YOBS(J), J=I,I+31)
50	CONTINUE
     	GO TO 999
666	NPTS = I-1
     	IF( NPTS.GT.0 ) GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWSAS
C
C  PROGRAMMER:  R. L. Snyder
C		ALFRED UNIVERSITY   Jul-1988
C
C	THIS ROUTINE READS FROM AN ASCII GSAS RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ACCESS='SEQUENTIAL',
     1 RECORDTYPE='FIXED',RECL=80,FORM='FORMATTED', ERR=888 )

C
C  READ THE FILE HEADER...
C
     	READ(IINP,1000,ERR=777,END=777) SLID
1000	FORMAT(20A4)
C
C  READ THE SCAN PARAMETERS...
C
     	READ(IINP,1001,ERR=777,END=777) NPTS, NREC, BANG(1), 
     1  BANG(3), BANG(10)
     	BANG(1) = BANG(1) / 100.
     	BANG(3) = BANG(3) / 100.
     	BANG(2) = (NPTS - 1) * BANG(3)
1001	FORMAT(6X,2I8,6X,3F10.0)
C
C  START READING THE INTENSITY DATA...
C
     	READ(IINP,1200,ERR=777,END=777) (YOBS(I),I=1, NPTS)
1200	FORMAT(10F8.0)
     	GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWSHA
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A SHADOW RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DAY*9, TIM*8
C
C  TRY TO OPEN THE INPUT FILE AS UNFORMATTED FILE FIRST...
C
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,ERR=111,END=777) SLID
     	READ(IINP,ERR=111,END=777) DAY, TIM
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
     	READ(IINP,ERR=111,END=777) BANG(1),BANG(2),BANG(3),BANG(10)
C
C  READ THE INTENSITY DATA...
C
     	NPTS = INT((BANG(2)-BANG(1))/BANG(3)+0.1) + 1
     	IF( NPTS.LT.1 ) GOTO 777
     	NLINE = NPTS/10
     	IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1
     	DO I=1, NLINE
     	   READ(IINP,ERR=111,END=777) (YOBS(J), J=1+10*(I-1), 10*I)
     	ENDDO
     	GOTO 999
C
C  OPEN THE INPUT FILE AS FORMATTED FILE NEXT...
C
111	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,1000,ERR=777,END=777) SLID
1000	FORMAT(20A4)
     	READ(IINP,1001,ERR=777,END=777) DAY, TIM
1001	FORMAT(A9,A8)
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
C
C  READ THE SCAN PARAMETERS...
C
     	READ(IINP,1100,ERR=777,END=777) BANG(1),BANG(2),BANG(3),BANG(10)
1100	FORMAT(4F10.4)
C
C  READ THE INTENSITY DATA...
C
     	NPTS = INT((BANG(2)-BANG(1))/BANG(3)+0.1) + 1
     	IF( NPTS.LT.1 ) GOTO 777
     	READ(IINP,1200,ERR=777,END=777) (YOBS(I),I=1, NPTS)
1200	FORMAT(10F7.0)
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWSPP
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A SPECPLOT RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 SNUM, MONT, DATE, YEAR, ELEM, NPTT, INST(2)
     	BYTE TITL(48)
     	DIMENSION A(32)
     	CHARACTER ANOD*2
     	EQUIVALENCE (TITL(1),SLID(1))
     	EQUIVALENCE (ELEM, ANOD)

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE HEADER INFORMATION...
C
     	READ(IINP,ERR=777,END=777) SNUM, DATE, MONT, YEAR, INST, TITL,
     	1 BANG(1), BANG(3), BANG(10), ELEM, WLEN, BANG(2), NPTT
     	ANODE(IELE) = ANOD
     	WAVE(1,IELE)= WLEN 
     	JUNK1= DATE
     	JUNK2= 3*(MONT-1)+1
     	JUNK3= YEAR
     	DATM = FLOAT(JUNK1)*1.0E+4 + FLOAT(JUNK2)*1.0E+2 + FLOAT(JUNK3)
C
C  READ THE INTENSITY DATA --- 32 POINTS PER RECORD...
C
     	NPTS = 0		!INITIALIZE THE COUNTER
111	READ(IINP,ERR=777,END=666) A
     	DO I=1, 32
     	   IF( A(I).LT.0.0 ) GOTO 666
     	   NPTS = NPTS + 1
     	   YOBS(NPTS) = A(I)
     	   IF( NPTS.EQ.MNP ) GOTO 999
     	ENDDO
     	GOTO 111

666	IF( NPTS.GT.0 ) GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWTAG
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE READS FROM A SCINTAG ASCII RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 ITIT(40)
     	EQUIVALENCE (ITIT,SLID)

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='FORMATTED', READONLY, ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,10,ERR=777,END=777) ITIT
10	FORMAT(40A2)
     	READ(IINP,15,ERR=777,END=777) BANG(10)
15	FORMAT(24X,F6.3)
C  DEFAULT THE RADIATION TO CU
     	IELE = 4
C
C  READ THE INTENSITY DATA...
C
     	READ(IINP,20,ERR=777,END=777) ANG1, YOBS(1), ESD1
20	FORMAT(1X,F6.2,F9.0,F6.0)
     	READ(IINP,20,ERR=777,END=777) ANG2, YOBS(2), ESD2
     	READ(IINP,20,ERR=777,END=777) ANG3, YOBS(3), ESD3
     	BANG(1) = ANG1
     	BANG(3) = ANG2 - ANG1
C CONVERT TO COUNTS FROM COUNTS/MIN
     	DO 25 I=1,3
25	YOBS(I) = YOBS(I) / 60. * BANG(10)
     	NPTS = 4
30     	   READ(IINP,40,ERR=776,END=666) YOBS(NPTS)
40	FORMAT(7X,F9.0)
     	IF(YOBS(NPTS) .LE. 0)GO TO 666
     	YOBS(NPTS) = YOBS(NPTS) / 60. * BANG(10)
     	NPTS = NPTS + 1
     	GOTO 30
666	NPTS = I-1
     	BANG(2) = BANG(1) + BANG(3)*(NPTS-1) + .000005
     	GO TO 999
C  THE FOLOWING ASSUMS THAT THE LINE OF TRASH NULL'S IS AT THE END OF THE FILE
776	GO TO 666
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWUNK
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE READS FROM A ??? RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE RRWX3
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY   MAR 1989
C
C	THIS ROUTINE READS FROM A NSLS-X3 (SUNY) RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
C     	CHARACTER JQS*1, TEXT*25

     	CALL CURSOR( 23, 1 )
     	CALL COLORS(-1)
     	CALL COLORS(80)
     	WRITE(6,111)
111	FORMAT(' _Sorry. This particular conversion routine has not',
     	1' been written yet.')
     	CALL PAUSES( 3 )
     	IERR= 3

C     	CLOSE( UNIT=IINP )
C     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', FORM='FORMATTED',
C     	1 CARRIAGECONTROL='LIST', READONLY, ERR=888 )
C
C  READ THE FILE HEADER...
C
C     	READ(IINP,1000,ERR=777,END=777) SLID
C1000	FORMAT(20A4)
C     	DO I=1, 4				!SKIP 4 BLANK LINES
C     	   READ(IINP,1000,ERR=777,END=777) JQS
C     	ENDDO
C
C  READ THE SCAN PARAMETERS...
C
C     	READ(IINP,1001,ERR=777,END=777) TEXT, BANG(1)
C     	IQS = INDEX( TEXT, 'Q' )
C     	IF( IQS.EQ.0 ) IQS = INDEX( TEXT, 'q' )
C     	READ(IINP,1001,ERR=777,END=777) TEXT(1:25), BANG(2)
C     	READ(IINP,1001,ERR=777,END=777) TEXT(1:25), BANG(3)
C     	READ(IINP,1001,ERR=777,END=777) TEXT(1:25), BANG(10)
C1001	FORMAT(A25,F10.4)
C     	DO I=1, 7				!SKIP 7 LINES
C     	   READ(IINP,1000,ERR=777,END=777) JQS
C     	ENDDO
C     	IF( IQS.GT.0 ) MODE = 2		!Q-SCAN FILE
C
C  START READING THE INTENSITY DATA...
C
C     	NPTS = 0
C     	MONI = 0
C1100	FORMAT(2F10.3,2F15.0)
C
C111	READ(IINP,1100,ERR=777,END=666) P1, P2, P3, P4
C
C     	IF( MONI.EQ.0 ) MONI = P4 * BANG(10)
C     	NPTS = NPTS + 1
C     	XOBS(NPTS) = P1
C     	YOBS(NPTS) = MONI*P3/P2/P4
C     	GOTO 111
C
C666	IF( NPTS.GT.0 ) GOTO 999
C777	IERR = 1
C     	GOTO 999
C888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWX7
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A NSLS-X7 (BNL) RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER JQS*1, TEXT*25

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', FORM='FORMATTED',
     	1 CARRIAGECONTROL='LIST', READONLY, ERR=888 )
C
C  READ THE FILE HEADER...
C
     	READ(IINP,1000,ERR=777,END=777) SLID
1000	FORMAT(20A4)
     	DO I=1, 4				!SKIP 4 BLANK LINES
     	   READ(IINP,1000,ERR=777,END=777) JQS
     	ENDDO
C
C  READ THE SCAN PARAMETERS...
C
     	READ(IINP,1001,ERR=777,END=777) TEXT, BANG(1)
     	IQS = INDEX( TEXT, 'Q' )
     	IF( IQS.EQ.0 ) IQS = INDEX( TEXT, 'q' )
     	READ(IINP,1001,ERR=777,END=777) TEXT(1:25), BANG(2)
     	READ(IINP,1001,ERR=777,END=777) TEXT(1:25), BANG(3)
     	READ(IINP,1001,ERR=777,END=777) TEXT(1:25), BANG(10)
1001	FORMAT(A25,F10.4)
     	DO I=1, 7				!SKIP 7 LINES
     	   READ(IINP,1000,ERR=777,END=777) JQS
     	ENDDO
     	IF( IQS.GT.0 ) MODE = 2		!Q-SCAN FILE
C
C  START READING THE INTENSITY DATA...
C
     	NPTS = 0
     	MONI = 0
1100	FORMAT(2F10.3,2F15.0)

111	READ(IINP,1100,ERR=777,END=666) P1, P2, P3, P4

     	IF( MONI.EQ.0 ) MONI = P4 * BANG(10)
     	NPTS = NPTS + 1
     	XOBS(NPTS) = P1
     	YOBS(NPTS) = MONI*P3/P2/P4
     	GOTO 111

666	IF( NPTS.GT.0 ) GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE RRWXRR
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM AN X-RAY RIETVELD RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DAY*9, TIM*8
C
C  TRY TO OPEN THE INPUT FILE AS UNFORMATTED FILE FIRST...
C
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='UNFORMATTED', READONLY, ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,ERR=111,END=777) SLID
     	READ(IINP,ERR=111,END=777) DAY, TIM
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
     	READ(IINP,ERR=111,END=777) BANG(1),BANG(2),BANG(3),BANG(10)
C
C  READ THE INTENSITY DATA...
C
     	NPTS = INT((BANG(2)-BANG(1))/BANG(3)+0.1) + 1
     	IF( NPTS.LT.1 ) GOTO 777
     	NLINE = NPTS/10
     	IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1
     	DO I=1, NLINE
     	   READ(IINP,ERR=111,END=777) (YOBS(J), J=1+10*(I-1), 10*I)
     	ENDDO
     	GOTO 999
C
C  OPEN THE INPUT FILE AS A FORMATTED FILE NEXT...
C
111	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  READ THE FILE HEADER INFORMATION...
C
     	READ(IINP,1000,ERR=777,END=777) SLID
1000	FORMAT(20A4)
     	READ(IINP,1001,ERR=777,END=777) DAY, TIM
1001	FORMAT(A9,A8)
     	DATM = DATCOD( DAY )
     	TIMM = TIMCOD( TIM )
C
C  READ THE SCAN PARAMETERS...
C
     	READ(IINP,1100,ERR=777,END=777) BANG(1),BANG(2),BANG(3),BANG(10)
1100	FORMAT(4F10.4)
C
C  READ THE INTENSITY DATA...
C
     	NPTS = INT((BANG(2)-BANG(1))/BANG(3)+0.1) + 1
     	IF( NPTS.LT.1 ) GOTO 777
     	READ(IINP,1200,ERR=777,END=777) ( YOBS(I), I=1, NPTS )
1200	FORMAT(10F7.0)
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE SCREEN( LTYP, IPEAK )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, FEB-1987
C
C	THIS ROUTINE SCREENS THE LISTED PEAKS
C		BY INTENSITY CUTOFFS "CUTI" AND
C		BY FWHM CUTOFF "CUTF"
C		LTYP = OUTPUT PEAK TYPE
C		IPEAK = CURRENT PEAK POINTER (DIADIF)
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DUMY*4
     	DIMENSION FTEP(11)

     	LP = LTYP
     	IPKS = IPEAK
     	IF( NPKS.EQ.0 ) GOTO 111
C
C  RECALCULATE THE RELATIVE INTENSITY...
C
1	DUMM = AREA(1,JRES)
     	DO I=2, NPKS
     	   IF( AREA(I,JRES).GT.DUMM ) DUMM = AREA(I,JRES)
     	ENDDO
     	DO I=1, NPKS
     	   RELA(I) = 100.0*AREA(I,JRES)/DUMM
     	   IF( RELA(I).GT.100.0 ) RELA(I) = 100.0
     	   IF( AREA(I,JRES).LT.RELA(I) ) AREA(I,JRES) = RELA(I)
     	ENDDO
     	IFLAG = 0
C
C  START THE REJECTION CHECKS...
C
     	J = 0
100	J = J + 1
     	IF( J.GT.NPKS .AND. IFLAG.EQ.0 ) GOTO 111
     	IF( J.GT.NPKS .AND. IFLAG.EQ.1 ) GOTO 1
     	IF( LP.EQ.1 .AND. PEAK(J).EQ.'KA2' ) GOTO 101
     	IF( RELA(J).LT.CUTI(1) .OR. RELA(J).GT.CUTI(2) ) GOTO 101
     	IF( FWHM(J).LT.CUTF(1) .OR. FWHM(J).GT.CUTF(2) ) GOTO 101
     	GOTO 100
C
C  REMOVE A PEAK...
C
101	IF( RELA(J).EQ.100.0 ) IFLAG = 1
     	IF( J.LT.IPKS ) IPKS = IPKS - 1
     	NPKS = NPKS - 1
     	DO I=J, NPKS
     	   F2TH(I) = F2TH(I+1)
     	   C2TH(I) = C2TH(I+1)
     	   FDSP(I) = FDSP(I+1)
     	   CDSP(I) = CDSP(I+1)
     	   RELA(I) = RELA(I+1)
     	   AREA(I,JRES) = AREA(I+1,JRES)
     	   PHGH(I) = PHGH(I+1)
     	   FWHM(I) = FWHM(I+1)
     	   PHKL(1,I) = PHKL(1,I+1)
     	   PHKL(2,I) = PHKL(2,I+1)
     	   PHKL(3,I) = PHKL(3,I+1)
     	   PEAK(I) = PEAK(I+1)
     	ENDDO
     	J = J - 1
     	GOTO 100

111	IPEAK = IPKS
     	IF( NPKS.EQ.0 ) THEN
     	    IPEAK = 1
      	    F2TH(1) = 0.0
     	    C2TH(1) = 0.0
     	    FDSP(1) = 0.0
     	    CDSP(1) = 0.0
     	    RELA(1) = 0.0
     	    AREA(1,JRES) = 0.0
     	    PHGH(1) = 0.0
     	    FWHM(1) = 0.0
     	    PHKL(1,1) = 0
     	    PHKL(2,1) = 0
     	    PHKL(3,1) = 0
     	    PEAK(1) = ' '
     	ELSE
     	    IF( NPKS.EQ.1 ) GOTO 999
C
C  REARRANGE THE PEAKS IN ASCENDING TWO-THETA ORDER...
C
    	    IPKS = NPKS-1
    	    DO I=1, NPKS-1
    	       DO J=1, IPKS
     		  IF( F2TH(J) .GT. F2TH(J+1) ) THEN
     		      IF( IPEAK.EQ.J  ) IPEAK = IPEAK + 1
     		      IF( IPEAK.EQ.J+1) IPEAK = IPEAK - 1
     		      FTEP(1) = F2TH(J)
     	    	      FTEP(2) = C2TH(J)
     	    	      FTEP(3) = FDSP(J)
     	    	      FTEP(4) = CDSP(J)
     	    	      FTEP(5) = RELA(J)
     	    	      FTEP(6) = AREA(J,JRES)
     	    	      FTEP(7) = PHGH(J)
     	    	      FTEP(8) = FWHM(J)
     	    	      FTEP(9) = PHKL(1,J)
     	    	      FTEP(10)= PHKL(2,J)
     	    	      FTEP(11)= PHKL(3,J)
     	    	      DUMY = PEAK(J)
    		      F2TH(J) = F2TH(J+1)
     	   	      C2TH(J) = C2TH(J+1)
     	   	      FDSP(J) = FDSP(J+1)
     	   	      CDSP(J) = CDSP(J+1)
     	   	      RELA(J) = RELA(J+1)
     	   	      AREA(J,JRES) = AREA(J+1,JRES)
      	   	      PHGH(J) = PHGH(J+1)
     	   	      FWHM(J) = FWHM(J+1)
     	   	      PHKL(1,J) = PHKL(1,J+1)
     	   	      PHKL(2,J) = PHKL(2,J+1)
     	   	      PHKL(3,J) = PHKL(3,J+1)
     	   	      PEAK(J) = PEAK(J+1)
    		      F2TH(J+1) = FTEP(1)
     	    	      C2TH(J+1) = FTEP(2)
     	    	      FDSP(J+1) = FTEP(3)
     	    	      CDSP(J+1) = FTEP(4)
     	    	      RELA(J+1) = FTEP(5)
     	    	      AREA(J+1,JRES) = FTEP(6)
     	    	      PHGH(J+1) = FTEP(7)
     	    	      FWHM(J+1) = FTEP(8)
     	    	      PHKL(1,J+1) = FTEP(9)
     	    	      PHKL(2,J+1) = FTEP(10)
     	    	      PHKL(3,J+1) = FTEP(11)
     	    	      PEAK(J+1) = DUMY
    	          ENDIF
    	       ENDDO
    	       IPKS = IPKS - 1
    	    ENDDO
     	ENDIF
999	RETURN
     	END
     	SUBROUTINE SHOWPN
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, FEB-1987
C
C	THIS ROUTINE LISTS THE CURRENT SECTION OF PATTERN
C	IN THE RAW DATA ARRAY "YOBS" ON THE SCREEN ----
C	10 POINTS PER LINE...
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1
     	DIMENSION IDATA(10)

     	NPN2 = 0
111	NPN1 = NPN2 + 1
     	NPN2 = NPN1 + 199
     	IF( NPN2.GT.NPTS ) NPN2 = NPTS
     	CALL CLEARS( 0 )			!CLEAR THE SCREEN
C
C  DISPLAY HEADER INFORMATION...
C
     	CALL COLORS(-1)
     	CALL COLORS(80)
     	CALL PUTEXT( '   P A T T E R N   L I S T  (CPS)   ', 36, 1, 20 )
     	CALL COLORS(1)
     	CALL COLORS(90)
     	WRITE(6,2)
2	FORMAT(' STARTING TWO-THETA =',11X,'ENDING TWO-THETA =',
     	111X,'STEPSIZE =',10X,' ')
     	BEGIN = DANG(1) + (NPN1-1)*DANG(3)
     	END   = DANG(1) + (NPN2-1)*DANG(3)
     	CALL COLORS(-1)
     	CALL PUTFFL( BEGIN,   1, 7.3, 2, 22 )
     	CALL PUTFFL( END  ,   1, 7.3, 2, 51 )
     	CALL PUTFFL( DANG(3), 1, 7.3, 2, 72 )
C
C  START DATA POINTS LISTING...
C
     	ILINE = 2
     	NPT = 0
     	NP1 = DANG(3)/BANG(3) + 0.1
     	NP2 = 1 + INT((BEGIN-BANG(1))/BANG(3)+0.1)
     	NPN1 = NPN2 - NPN1 + 1
     	DO 333 I= 1, NPN1
     	   NPT = NPT + 1
     	   IDATA(NPT) = YOBS(NP2+(I-1)*NP1)/DANG(10)
     	   IF( I.LT.NPN1 .AND. NPT.LT.10 ) GOTO 333
     	   ILINE = ILINE + 1
     	   DO J=1, NPT
     	      CALL PUTIFL( IDATA(J), 1, 7, ILINE, 1+(J-1)*8 )
     	   ENDDO
     	   NPT = 0
333	CONTINUE

     	CALL COLORS(1)
     	WRITE(6,222)
222	FORMAT(/'$Hit RETURN to continue(CTRL_Z=QUIT)...')
     	READ(5,223,ERR=999,END=999) IQS
223	FORMAT(A)
     	IF( NPN2.LT.NPTS ) GOTO 111
999	RETURN
     	END
     	SUBROUTINE SHOWPS
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, FEB-1987
C
C	THIS ROUTINE LISTS ALL PEAK PARAMETERS FOR ALL PEAKS
C	IN THE PEAK ARRAYS ON THE SCREEN.
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1

     	NPK1 = 1
     	NPK2 = NPKS
     	IF( NPK2.GT.20 ) NPK2 = 20
     	
111	CALL CLEARS( 0 )			!CLEAR THE SCREEN
C
C  DISPLAY HEADER INFORMATION...
C
     	CALL COLORS(-1)
     	CALL COLORS(80)
     	CALL PUTEXT( '  P E A K   L I S T  ', 21, 1, 28 )
     	CALL COLORS(1)
     	CALL COLORS(90)
     	WRITE(6,2)
2	FORMAT('  #TH    2-THETA(O,C)    D(O)    D(C)   REL.INT',
     	1'   AREA     FWHM    H  K  L TYPE ')
     	CALL COLORS(-1)
C
C  START PEAK LISTING...
C
     	ILINE = 2
     	DO I= NPK1, NPK2
     	   ILINE = ILINE + 1
     	   CALL PUTIFL( I, 1, 3, ILINE, 2 )
     	   CALL PUTFFL( F2TH(I), 1, 7.3, ILINE, 7 )
     	   CALL PUTFFL( C2TH(I), 1, 7.3, ILINE, 15 )
     	   CALL PUTFFL( FDSP(I), 1, 7.4, ILINE, 24 )
     	   CALL PUTFFL( CDSP(I), 1, 7.4, ILINE, 32 )
     	   CALL PUTFFL( RELA(I), 1, 5.1, ILINE, 41 )
     	   CALL PUTGFL( AREA(I,JRES), 1, 11.4, ILINE, 47 )
     	   CALL PUTFFL( FWHM(I), 1, 5.3, ILINE, 59 )
     	   CALL PUTIFL( PHKL(1,I), 3, 3, ILINE, 65 )
     	   CALL PUTEXT( PEAK(I), 4, ILINE, 75 )
     	ENDDO

     	CALL COLORS(1)
     	WRITE(6,222)
222	FORMAT(/'$Hit RETURN to continue(CTRL_Z=QUIT)...')
     	READ(5,223,ERR=999,END=999) IQS
223	FORMAT(A)
     	IF( NPK2.EQ.NPKS ) GOTO 999
     	NPK1 = NPK2 + 1
     	NPK2 = NPK1 + 19
     	IF( NPK2.GT.NPKS ) NPK2 = NPKS
     	GOTO 111
999	RETURN
     	END
     	SUBROUTINE SPAWNS( ICODE, TEXT )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY-1987
C
C	THIS ROUTINE SPAWNS A SYSTEM SUBPROCESS.
C
     	CHARACTER COMM*80, TEXT*(*)

     	COMM = TEXT
     	NCH = NALPHA( COMM, -80 )
     	NSP = INDEX( COMM(1:NCH), ' ' )
     	ICODE = 0
     	IF( NSP.GT.0 ) GOTO 111
C
C  GET THE COMMAND LINE...
C
     	CALL COLORS(1)
     	WRITE(6,1000)
1000	FORMAT('$SPAWN> ')
     	READ(5,1001,ERR=999,END=999) COMM
1001	FORMAT(A)
     	IF( COMM.EQ.' ' ) GOTO 999
     	NCH = NALPHA( COMM, -80 )

111	CALL COLORS(-1)
     	WRITE(6,222)
222	FORMAT('$Working...')
     	CALL COLORS(1)
     	CALL LIB$SPAWN( COMM(NSP+1:NCH) )
     	CALL PAUSES( 1 )
     	ICODE = 1

999	RETURN
     	END
     	FUNCTION TIMCOD( TIM )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE ENCODES D-500 SYSTEM TIME
C
     	CHARACTER TIM*8, ATIM*6

     	TIMCOD = 0.0
     	ATIM(1:2) = TIM(1:2)
     	ATIM(3:4) = TIM(4:5)
     	ATIM(5:6) = TIM(7:8)
     	DECODE( 6, 1, ATIM, ERR=9 ) VAL
     	TIMCOD = VAL
1	FORMAT(F7.0)
9	RETURN
     	END
     	SUBROUTINE WDI011
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-11 DIFILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DAY*12, TIM*8

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 ACCESS='DIRECT', RECL=1 )
C
C  WRITE THE FILE HEADER BLOCK...
C
     	WRITE(IOUT,REC= 1,ERR=888) SLID(1)
     	WRITE(IOUT,REC= 2,ERR=888) SLID(2)
     	WRITE(IOUT,REC= 3,ERR=888) SLID(3)
     	WRITE(IOUT,REC= 4,ERR=888) SLID(4)
     		CALL CODDAT( DAY, DATM )
     	WRITE(IOUT,REC= 5,ERR=888) DAY(1:4)
     	WRITE(IOUT,REC= 6,ERR=888) DAY(5:8)
     	WRITE(IOUT,REC= 7,ERR=888) DAY(9:12)
     		CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,REC= 8,ERR=888) TIM(1:4)
     	WRITE(IOUT,REC= 9,ERR=888) TIM(5:8)
     	WRITE(IOUT,REC= 10,ERR=888) NAME(1)
     	WRITE(IOUT,REC= 11,ERR=888) NAME(2)
     	WRITE(IOUT,REC= 12,ERR=888) NAME(3)
C
C  WRITE THE LINE MEASUREMENT BLOCK...
C
     	WRITE(IOUT,REC= 13,ERR=888) DANG(1)
     	WRITE(IOUT,REC= 14,ERR=888) DANG(2)
     	WRITE(IOUT,REC= 15,ERR=888) DANG(3)
     	WRITE(IOUT,REC= 16,ERR=888) DANG(10)
C
C  WRITE THE INSTRUMENTATION BLOCK...
C
     	IF( WAVE(1,IELE).EQ.0.0 ) IELE = 4		!ASSUME CU
     	WRITE(IOUT,REC= 19,ERR=888) WAVE(1,IELE)
     	WRITE(IOUT,REC= 21,ERR=888) NPKS
C
C  WRITE THE DIFILE DATA BLOCK...
C
     	IREC = 40
     	DO I=1, NPKS
     	   WRITE(IOUT,REC= IREC+1,ERR=888) FDSP(I)
C     	   WRITE(IOUT,REC= IREC+2,ERR=888) AREA(I,1)
     	   WRITE(IOUT,REC= IREC+2,ERR=888) RELA(I)
     	   WRITE(IOUT,REC= IREC+3,ERR=888) FWHM(I)
     	   WRITE(IOUT,REC= IREC+4,ERR=888) AREA(I,2)
     	   IREC = IREC + 6
     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WDI05A
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-5 (ALFRED) DIFILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, TEXT*9

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )

     	IQS = ' '
C     	DO I=1, 7	!SKIP 7 LINES
C  WE ARE MAKING 6 TO GO ALONG WITH THE INDEXING .ADR FILES
     	DO I=1, 6	!SKIP 6 LINES
     	   WRITE(IOUT,1000,ERR=888) IQS
     	ENDDO
1000	FORMAT(A)
C
C  WRITE THE FILE HEADER INFORMATION...
C
     	WRITE(IOUT,1001,ERR=888) SLID
1001	FORMAT(13X,20A4)
     	CALL CODDAT( TEXT(1:9), DATM )
     	WRITE(IOUT,1002,ERR=888) TEXT(1:9)
1002	FORMAT(14X,A9)
     	WRITE(IOUT,1000,ERR=888) IQS	!SKIP 1 LINE
     	WRITE(IOUT,1003,ERR=888) DANG(1), DANG(10)
1003	FORMAT(17X,F9.4,4X,F7.2)
     	WRITE(IOUT,1003,ERR=888) DANG(2)
     	WRITE(IOUT,1003,ERR=888) DANG(3)
     	WRITE(IOUT,1000,ERR=888) IQS
     	WRITE(IOUT,1000,ERR=888) IQS
     	TEXT = 'PEAK'				!PEAK LIST ID
     	WRITE(IOUT,1000,ERR=888) TEXT(1:4)

     	DUMY = 0.0
     	DO I=1, NPKS
     	   IQS = ' '
     	   IF( PEAK(I).EQ.'KA2' ) IQS = '*'
     	   WRITE(IOUT,1100,ERR=888) I, F2TH(I), IQS, FDSP(I),
     	1  RELA(I), DUMY, AREA(I,JRES), FWHM(I)
     	ENDDO
1100	FORMAT(I3,F10.4,A1,F8.3,F8.2,10X,F6.4,F9.1,F9.4)

     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE WDI05S
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-5 (SIEMENS) DIFILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, TEXT*9

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )

     	IQS = ' '
     	DO I=1, 7	!SKIP 7 LINES
     	   WRITE(IOUT,1000,ERR=888) IQS
     	ENDDO
1000	FORMAT(A)
C
C  WRITE THE FILE HEADER INFORMATION...
C
     	WRITE(IOUT,1001,ERR=888) SLID
1001	FORMAT(13X,20A4)
     	CALL CODDAT( TEXT(1:9), DATM )
     	WRITE(IOUT,1002,ERR=888) TEXT(1:9)
1002	FORMAT(14X,A9)
     	WRITE(IOUT,1000,ERR=888) IQS	!SKIP 1 LINE
     	WRITE(IOUT,1003,ERR=888) DANG(1), DANG(10)
1003	FORMAT(17X,F9.4,4X,F7.2)
     	WRITE(IOUT,1003,ERR=888) DANG(2)
     	WRITE(IOUT,1003,ERR=888) DANG(3)
     	WRITE(IOUT,1000,ERR=888) IQS
     	WRITE(IOUT,1000,ERR=888) IQS
     	TEXT = 'PEAK'				!PEAK LIST ID
     	WRITE(IOUT,1000,ERR=888) TEXT(1:4)

     	DUMY = 0.0
     	DO I=1, NPKS
     	   IQS = ' '
     	   IF( PEAK(I).EQ.'KA2' ) IQS = '*'
     	   WRITE(IOUT,1100,ERR=888) I, F2TH(I), IQS, FDSP(I),
     	1  RELA(I), DUMY, AREA(I,JRES), FWHM(I)
     	ENDDO
1100	FORMAT(I3,F10.4,A1,F8.3,F8.2,10X,F6.4,F9.1,F9.4)

     	GOTO 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE WDI500
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C  Updated 12/88 to allow for the Version 2 file structure.
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-500 DIFILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1
     	INTEGER*2 IDUM, HKLP(3), NPEAK

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 ACCESS='DIRECT', RECL=1 )
C
C  WRITE THE FILE HEADER BLOCK...
C
     	IDUM = 1
     	WRITE(IOUT,REC= 1,ERR=888) IDUM,ITYP
     	WRITE(IOUT,REC= 2,ERR=888) NHDB
     	WRITE(IOUT,REC= 3,ERR=888) ISBF
     	WRITE(IOUT,REC= 4,ERR=888) LENG
     	WRITE(IOUT,REC= 5,ERR=888) IDUM,IDUM
C
C  WRITE THE SPECIFICATION BLOCK REFERENCES...
C
     	IRPR(6,2) = 2 + NPKS*12
     	IREC = ISBF-1
     	DO I=1, LENG/3
     	   WRITE(IOUT,REC= IREC+1,ERR=888) IRPR(I,1)
     	   WRITE(IOUT,REC= IREC+2,ERR=888) IRPR(I,2)
     	   WRITE(IOUT,REC= IREC+3,ERR=888) IRLR(I)
     	   IREC = IREC + 3
     	ENDDO
C
C  WRITE THE INSTRUMENTATION BLOCK...
C
     	IREC = IRPR(1,1)-1
     	IDUM = 4
     	IQS = 'A'
     	IF( WAVE(1,IELE).EQ.0.0 ) IELE = 4		!ASSUME CU
     	WRITE(IOUT,REC= IREC+1,ERR=888) IDUM,IQS
     	IDUM = 1
     	WRITE(IOUT,REC= IREC+5,ERR=888) ANODE(IELE),IDUM
     	IREC = IREC + 5
     	DO I=1, 5
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) WAVE(I,IELE)
     	ENDDO
C
C  WRITE THE FILE DESCRIPTION BLOCK...
C
     	IREC = IRPR(3,1)-1
     	WRITE(IOUT,REC= IREC+1,ERR=888) NAME(1)
     	WRITE(IOUT,REC= IREC+2,ERR=888) NAME(2)
     	WRITE(IOUT,REC= IREC+3,ERR=888) NAME(3)
     	WRITE(IOUT,REC= IREC+4,ERR=888) DATM
     	WRITE(IOUT,REC= IREC+5,ERR=888) TIMM
     	WRITE(IOUT,REC= IREC+6,ERR=888) FTYP,MTYP
     	WRITE(IOUT,REC= IREC+7,ERR=888) DANG(4)/DANG(10)
     	WRITE(IOUT,REC= IREC+9,ERR=888) NREP,MPRO
     	WRITE(IOUT,REC= IREC+10,ERR=888) NRNG,SCAN
     	IREC = IREC + 15
     	WRITE(IOUT,REC= IREC,ERR=888) STYP
     	DO I=1, 15
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) SLID(I)
    	ENDDO
C
C  WRITE THE EXPERIMENTAL BLOCK ...
C
     	DUMY = 0.0
     	IREC = IRPR(10,1)-1
     	WRITE(IOUT,REC= IREC+1,ERR=888) DUMY
     	WRITE(IOUT,REC= IREC+2,ERR=888) DUMY
     	WRITE(IOUT,REC= IREC+3,ERR=888) DUMY
C
C  WRITE THE LINE MEASUREMENT BLOCK...
C
     	IREC = IRPR(4,1)-1
     	DO I=1, 14
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) DANG(I)
        ENDDO
C
C  WRITE THE DIFILE DATA BLOCK...
C
     	IDUM = 1
     	IREC = IRPR(6,1)
     	WRITE(IOUT,REC= IREC,ERR=888) IDUM,IDUM
     	IREC = IREC + 1
c
c     	IDUM = IREC + 1  version 1 file structure.
c  We now store the pointer as a relative address within the 
c  data block  (ie 3)
c
     	IDUM = 3
     	NPEAK = NPKS
     	WRITE(IOUT,REC= IREC,ERR=888) IDUM,NPEAK
     	DO I=1, NPKS
     	   WRITE(IOUT,REC= IREC+1, ERR=888) F2TH(I)
     	   WRITE(IOUT,REC= IREC+2, ERR=888) C2TH(I)
     	   WRITE(IOUT,REC= IREC+3, ERR=888) PEAK(I)
     	   WRITE(IOUT,REC= IREC+5, ERR=888) PHGH(I)
     	   WRITE(IOUT,REC= IREC+7, ERR=888) AREA(I,1)
     	   WRITE(IOUT,REC= IREC+8, ERR=888) AREA(I,2)
     	   WRITE(IOUT,REC= IREC+9, ERR=888) FWHM(I)
     		HKLP(1) = PHKL(1,I)
     		HKLP(2) = PHKL(2,I)
     		HKLP(3) = PHKL(3,I)
     	   WRITE(IOUT,REC= IREC+10,ERR=888) HKLP(1),HKLP(2)
     	   WRITE(IOUT,REC= IREC+11,ERR=888) HKLP(3)
     	   WRITE(IOUT,REC= IREC+12,ERR=888) RELA(I)
     	   IREC = IREC + 12
     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WDIAID
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A AIDS DIFILE FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE WDIKEY
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  SEPT-1987
C
C	THIS ROUTINE WRITES OUT A KEYBAORD DIFILE FROM COMMON BLOCKS
C	IN LINE FORMAT: d-spacing(A), intensity(%), FWHM, H, K, L
C
     	INCLUDE 'FILECONV.CBS'

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  WRITE THE PEAK LIST...
C
     	DO I=1, NPKS
     	WRITE(IOUT,1000,ERR=888) FDSP(I), RELA(I),
     	1 FWHM(I), PHKL(1,I), PHKL(2,I), PHKL(3,I)
     	ENDDO
1000	FORMAT(3G13.5,3I4)
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WDIMDI
C
C  PROGRAMMER:  R. L Snyder
C		ALFRED UNIVERSITY   Mar-1989
C
C	THIS ROUTINE WRITES OUT AN MDI DIFILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  WRITE THE FILE HEADER INFORMATION...
C
     	WRITE(IOUT,1001) SLID
1001	FORMAT(20A4)
     	write(iout,1003) NPKS
1003	FORMAT(I4)

     	DO I=1, NPKS
     	WRITE(IOUT,1100) FDSP(I), RELA(I)
1100	FORMAT(9X,F10.7,9X,F4.0)
     	ENDDO
     	go to 999
888	IERR = 2
999	RETURN
     	END
     	SUBROUTINE WDINIC
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A NICOLET DIFILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 IBUF(149), HKLP(3,150), IDUM, NOD
     	DIMENSION FWAVE(3)
     	EQUIVALENCE (IBUF(1),SLID(1)), (IBUF(47), FWAVE(1))

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )

     	FWAVE(1) = WAVE(3,IELE)
     	FWAVE(2) = WAVE(1,IELE)
     	FWAVE(3) = WAVE(2,IELE)
C
C  WRITE THE HEADER INFORMATION...
C
     	WRITE(IOUT,ERR=888) IBUF
C
C  WRITE THE PEAK INFORMATION...
C
     	DO I=1, NPKS
     	   HKLP(1,I) = PHKL(1,I)
     	   HKLP(2,I) = PHKL(2,I)
     	   HKLP(3,I) = PHKL(3,I)
     	ENDDO
     	IDUM = 0
     	NOD = NPKS
     	WRITE(IOUT,ERR=888) NOD, ( FDSP(I), RELA(I), F2TH(I),
     	1 FWHM(I), (HKLP(J,I),J=1,3), IDUM, I=1, NOD )
     	GOTO 999

888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WDIRIG
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  Jan-1988
C
C	THIS ROUTINE WRITES OUT A RIGAKU DIFILE FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
     	CHARACTER DAY*12, TIM*8, NEW(6)*4
     	DATA NEW(1)/'Cr  '/, NEW(2)/'Fe  '/, NEW(3)/'Co  '/,
     1 NEW(4)/'Cu  '/, NEW(5)/'Mo  '/, NEW(6)/'    '/ 
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 ACCESS='DIRECT', RECL=9 )
C
C  WRITE THE FILE FIRST 3 RECORDS 
C
     		CALL CODDAT( DAY, DATM )
     		CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,REC= 1,ERR=888) '.PKS', DAY(1:12), TIM(1:8)
     	WRITE(IOUT,REC= 2,ERR=888) (SLID(I),I=1,6)
     	WRITE(IOUT,REC= 3,ERR=888) (SLID(I),I=7,10)
C
C  WRITE THE LINE MEASUREMENT RECORD 4
C DMAX, DMIN, START, END, STEP, SCAN SPEED, COUNT TIME - REAL*4
C
     	A = 0.0
     	WRITE(IOUT,REC=4,ERR=888)A,A,DANG(1),DANG(2),DANG(3),A,DANG(10)
C
C  WRITE THE RADIATION 
C  EL SYM (A2), KA1, KA2, KB1, KBAR
C
     	WRITE(IOUT,REC= 5,ERR=888) NEW(IELE), WAVE(1,IELE), 
     1   WAVE(2,IELE), WAVE(4,IELE), WAVE(3,IELE) 
C
C  WRITE DUMMY RECORDS FOR 6 AND 7
C
     	WRITE(IOUT,REC=6,ERR=888)A,A,A,A,A,A,A,A,A
     	WRITE(IOUT,REC=7,ERR=888)A,A,A,A,A,A,A,A,A
C
C  WRITE THE DAT AND TIME AGAIN
C
     	WRITE(IOUT,REC= 8,ERR=888) DAY(1:12), TIM(1:8)
C
C  WRITE THE NUMBER OF PEAKS
C
     	WRITE(IOUT,REC=9,ERR=888) NPKS
C
C  WRITE THE D'S AND I'S
C
     	IREC = 9
     	DO I=1, NPKS
     	   WRITE(IOUT,REC= IREC+I,ERR=888) ' ', F2TH(I), FDSP(I),
     1        RELA(I), PHGH(I), FWHM(I)
     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WDISPP
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A SPECPLOT DIFILE
C	FROM THE COMMON BLOCKS
C                                                                            
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*4 SNUM, DATE, YEAR

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=888 )
C
C  WRITE THE FILE HEADER...
C
     	SNUM = 1		!????
     	DATE = INT(DATM*1.0E-4)
     	MONT = INT(DATM*1.0E-2) - DATE*100
     	YEAR = INT(DATM*1.0E-0) - DATE*10000 - MONT*100
     	MONT = (MONT-1)/3 + 1
     	WRITE(IOUT,1000,ERR=888) SNUM,MONT,DATE,YEAR,(SLID(I),I=1,12)
1000	FORMAT(1X,I5,1X,I2,'-',I2,'-',I2,1X,'DI  ',4X,12A4)
     	WRITE(IOUT,1001,ERR=888) DANG(1),DANG(3),DANG(10),
     	1 ANODE(IELE), WAVE(1,IELE)
1001	FORMAT(' START ANGLE=',F8.3,'  DELTA 2THETA=',F6.3,
     	1'  TIME=',F5.1,' TUBE=',A2,' LAMDA=',F6.3,///
     	1'   N   2THETA   DSPACE  (1/D**2)  HEIGHT     AREA'/)
C
C  WRITE THE D-SPACING AND THE INTENSITY DATA...
C
     	WRITE(IOUT,2000,ERR=888) (I,F2TH(I),FDSP(I),1.0/FDSP(I)**2,
     	1 PHGH(I), AREA(I,1), I=1, NPKS)
2000	FORMAT(I4,F9.3,2F9.4,2F9.1)
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WDITAG
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE WRITES OUT A SCINTAG DIFILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )
C
C  WRITE THE FILE HEADER INFORMATION...
C
     	IDUM = 0
     	DUMY = 0.0
     	WRITE(IOUT,ERR=888) ITIT, DANG(1), DANG(2), DANG(3),
     	1 DANG(10), DUMY, WAVE(1,IELE), (IDUM, I=1,50)
C
C  WRITE THE PEAK LIST...
C
     	DO I=1, NPKS

     	   HH = PHKL(1,I)
     	   KK = PHKL(2,I)
     	   LL = PHKL(3,I)
     	   WRITE(IOUT,ERR=888 ) F2TH(I), DUMY, AREA(I,JRES),
     	1  PHGH(I), FWHM(I), HH, KK, LL

     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WDIUNK
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A ??? DIFILE FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
     	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE WRW011
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-11 RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER DAY*12, TIM*8

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 ACCESS='DIRECT', RECL=1 )
C
C  WRITE THE FILE HEADER BLOCK...
C
     	WRITE(IOUT,REC= 1,ERR=888) SLID(1)
     	WRITE(IOUT,REC= 2,ERR=888) SLID(2)
     	WRITE(IOUT,REC= 3,ERR=888) SLID(3)
     	WRITE(IOUT,REC= 4,ERR=888) SLID(4)
     		CALL CODDAT( DAY, DATM )
     	WRITE(IOUT,REC= 5,ERR=888) DAY(1:4)
     	WRITE(IOUT,REC= 6,ERR=888) DAY(5:8)
     	WRITE(IOUT,REC= 7,ERR=888) DAY(9:12)
     		CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,REC= 8,ERR=888) TIM(1:4)
     	WRITE(IOUT,REC= 9,ERR=888) TIM(5:8)
     	WRITE(IOUT,REC= 10,ERR=888) NAME(1)
     	WRITE(IOUT,REC= 11,ERR=888) NAME(2)
     	WRITE(IOUT,REC= 12,ERR=888) NAME(3)
     		IF( WAVE(1,IELE).EQ.0.0 ) IELE = 4	!ASSUME CU
     	WRITE(IOUT,REC= 14,ERR=888) WAVE(1,IELE)
C
C  WRITE THE LINE MEASUREMENT BLOCK...
C
     	WRITE(IOUT,REC= 30,ERR=888) NRNG
     	WRITE(IOUT,REC= 31,ERR=888) DANG(1)
     	WRITE(IOUT,REC= 32,ERR=888) DANG(2)
     	WRITE(IOUT,REC= 33,ERR=888) DANG(3)
     	WRITE(IOUT,REC= 34,ERR=888) DANG(10)
     	WRITE(IOUT,REC= 35,ERR=888) DANG(14)
     	IREC = 35
     	DO I=1, NPTS
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) YOBS(I)
     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRW05A
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-5 (ALFRED) RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, DAY*9, TIM*8

     	CALL COLORS(1)
     	CALL PUTEXT('Write the output file in (A)SCII or (B)INARY <B> ',
     	1 49, 23, 1 )
     	READ(5,1000,ERR=777,END=777) IQS
     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

     	IF( IQS.NE.'A' .AND. IQS.NE.'a' ) GOTO 111
C
C  WRITE OUT AN ASCII FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST' )

     	WRITE(IOUT,1000,ERR=888) SLID
1000	FORMAT(20A4)
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,1001,ERR=888) DAY, TIM
1001	FORMAT(A9,3X,A8)
     	WRITE(IOUT,1002,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
1002	FORMAT(4F10.4)
     	WRITE(IOUT,1003,ERR=888) (YOBS(I), I=1, NPTS)
1003	FORMAT(10F8.1)
     	GOTO 999
C
C  WRITE OUT A BINARY FILE...
C
111	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )

     	IQS = ' '
     	WRITE(IOUT,ERR=888) SLID
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,ERR=888) DAY, TIM
     	WRITE(IOUT,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
     	NLINE = NPTS/10
     	IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1
     	DO I=1, NLINE
     	   WRITE(IOUT,ERR=888) (YOBS(J), J=1+(I-1)*10, I*10)
     	ENDDO
     	GOTO 999

777	IERR = 3		!BAIL OUT
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRW05S
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-5 (SIEMENS) RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, DAY*9, TIM*8

     	CALL COLORS(1)
     	CALL PUTEXT('Write the output file in (A)SCII or (B)INARY <B> ',
     	1 49, 23, 1 )
     	READ(5,1000,ERR=777,END=777) IQS
     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

     	IF( IQS.NE.'A' .AND. IQS.NE.'a' ) GOTO 111
C
C  WRITE OUT AN ASCII FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST' )

     	WRITE(IOUT,1000,ERR=888) SLID
1000	FORMAT(20A4)
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,1001,ERR=888) DAY, TIM
1001	FORMAT(A9,3X,A8)
     	WRITE(IOUT,1002,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
1002	FORMAT(4F10.4)
     	WRITE(IOUT,1003,ERR=888) (YOBS(I), I=1, NPTS)
1003	FORMAT(10F8.1)
     	GOTO 999
C
C  WRITE OUT A BINARY FILE...
C
111	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )

     	IQS = ' '
     	WRITE(IOUT,ERR=888) SLID
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,ERR=888) DAY, TIM
     	WRITE(IOUT,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
     	NLINE = NPTS/10
     	IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1
     	DO I=1, NLINE
     	   WRITE(IOUT,ERR=888) (YOBS(J), J=1+(I-1)*10, I*10)
     	ENDDO
     	GOTO 999

777	IERR = 3		!BAIL OUT
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRW500
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-500 RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 IDUM
     	CHARACTER IQS*1

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 ACCESS='DIRECT', RECL=1 )
C
C  WRITE THE FILE HEADER BLOCK...
C
     	IDUM = 1
     	WRITE(IOUT,REC= 1,ERR=888) IDUM,ITYP
     	WRITE(IOUT,REC= 2,ERR=888) NHDB
     	WRITE(IOUT,REC= 3,ERR=888) ISBF
     	WRITE(IOUT,REC= 4,ERR=888) LENG
     	WRITE(IOUT,REC= 5,ERR=888) IDUM,IDUM
C
C  WRITE THE SPECIFICATION BLOCK REFERENCES...
C
     	IRPR(6,2) = NPTS
     	IREC = ISBF-1
     	DO I=1, LENG/3
     	   WRITE(IOUT,REC= IREC+1,ERR=888) IRPR(I,1)
     	   WRITE(IOUT,REC= IREC+2,ERR=888) IRPR(I,2)
     	   WRITE(IOUT,REC= IREC+3,ERR=888) IRLR(I)
     	   IREC = IREC + 3
     	ENDDO
C
C  WRITE THE INSTRUMENTATION BLOCK...
C
     	IREC = IRPR(1,1)-1
     	IDUM = 4
     	IQS = 'A'
     	IF( WAVE(1,IELE).EQ.0.0 ) IELE = 4		!ASSUME CU
     	WRITE(IOUT,REC= IREC+1,ERR=888) IDUM,IQS
     	IDUM = 1
     	WRITE(IOUT,REC= IREC+5,ERR=888) ANODE(IELE),IDUM
     	IREC = IREC + 5
     	DO I=1, 5
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) WAVE(I,IELE)
     	ENDDO
C
C  WRITE THE FILE DESCRIPTION BLOCK...
C
     	IREC = IRPR(3,1)-1
     	WRITE(IOUT,REC= IREC+1,ERR=888) NAME(1)
     	WRITE(IOUT,REC= IREC+2,ERR=888) NAME(2)
     	WRITE(IOUT,REC= IREC+3,ERR=888) NAME(3)
     	WRITE(IOUT,REC= IREC+4,ERR=888) DATM
     	WRITE(IOUT,REC= IREC+5,ERR=888) TIMM
     	WRITE(IOUT,REC= IREC+6,ERR=888) FTYP,MTYP
     	WRITE(IOUT,REC= IREC+7,ERR=888) DANG(4)/DANG(10)
     	WRITE(IOUT,REC= IREC+9,ERR=888) NREP,MPRO
     	WRITE(IOUT,REC= IREC+10,ERR=888) NRNG,SCAN
     	IREC = IREC + 15
     	WRITE(IOUT,REC= IREC,ERR=888) STYP
     	DO I=1, 15
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) SLID(I)
    	ENDDO
C
C  WRITE THE EXPERIMENTAL BLOCK ...
C
     	DUMY = 0.0
     	IREC = IRPR(10,1)-1
     	WRITE(IOUT,REC= IREC+1,ERR=888) DUMY
     	WRITE(IOUT,REC= IREC+2,ERR=888) DUMY
     	WRITE(IOUT,REC= IREC+3,ERR=888) DUMY
C
C  WRITE THE LINE MEASUREMENT BLOCK...
C
     	IREC = IRPR(4,1)-1
     	DO I=1, 14
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) DANG(I)
        ENDDO
C
C  WRITE THE INTENSITY DATA BLOCK...
C
     	IREC = IRPR(6,1)-1
     	DO I=1, NPTS
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) YOBS(I)
     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWMDI
C
C  PROGRAMMER:  R. L SNYDER
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT AN MDI RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, DAY*9, TIM*8
     	CHARACTER JJDAT*6

     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

C
C  WRITE OUT THE ASCII FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     1 FORM='FORMATTED', CARRIAGECONTROL='LIST' )
     	IDATM = DATM
     	    ENCODE( 6, 1, JJDAT ) IDATM
1	FORMAT(I6)
     	WRITE(IOUT,1000,ERR=888) JJDAT(1:2), JJDAT(3:4), JJDAT(5:6), 
     1 (SLID(I),I=1,14)
1000	FORMAT(7X,A2,'-',A2,'-',A2,' DIF   ',14A4)

     	WRITE(IOUT,1002,ERR=888) DANG(1),DANG(3),DANG(10),
     1 ANODE(IELE), WAVE(1,IELE), DANG(2), NPTS
1002	FORMAT(F7.3,F6.3,F6.1,1X,A2,F10.6,F8.3,I7)
     	YOBS(NPTS+1) = -1
     	WRITE(IOUT,1003,ERR=888) (YOBS(I), I=1, NPTS+1)
1003	FORMAT(8F8.0)
     	GOTO 999

777	IERR = 3		!BAIL OUT
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWNBS
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A NBS RIETVLED RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'

     	CALL CURSOR( 23, 1 )
     	CALL COLORS(-1)
     	CALL COLORS(80)
     	WRITE(6,111)
111	FORMAT(' _Sorry. This particular conversion routine has not',
     	1' been written yet.')
     	CALL PAUSES( 3 )
     	IERR= 3

C     	CLOSE( UNIT=IOUT )
C     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', FORM='FORMATTED',
C     	1 CARRIAGECONTROL='LIST', ERR=888 )
C
C     	GOTO 999
C888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWNIC
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A NICOLET RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 ITIT(40), DATTIM(6), NRNS, IDUM, IBUF(100)
     	EQUIVALENCE (ITIT, SLID)
     	REAL*4 FWAVE(4), DUMY(12), RANGE(9,100)

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )
C
C  INITIALIZE THE FILE HEADER INFORMATION...
C
     	DO I=1, 6
     	   DATTIM(I) = 0
     	ENDDO
     	FWAVE(1) = WAVE(3,IELE)
     	FWAVE(2) = WAVE(1,IELE)
     	FWAVE(3) = WAVE(2,IELE)
     	FWAVE(4) = 0.0
     	DO I=1, 12
     	   DUMY(I) = 0.0
     	ENDDO
     	IDUM = 0
     	NRNS = 1
     	RANGE(1,1) = DANG(1)
     	RANGE(2,1) = DANG(2)
     	RANGE(5,1) = DANG(3)
     	RANGE(7,1) = DANG(10)
     	RANGE(8,1) = NPTS
     	RANGE(9,1) = 1.0
     	DO I=2, 100
     	   DO J=1, 9
     	      RANGE(J,I) = 0.0
     	   ENDDO
     	ENDDO
C
C  WRITE THE FILE HEADER INFORMATION...
C
     	WRITE(IOUT,ERR=888) ITIT, DATTIM, FWAVE, DUMY, DUMY,
     	1 DUMY(1), IDUM, NRNS, RANGE, (RANGE(1,I), I=1,72)
C
C  WRITE THE INTENSITY DATA...
C
     	NRNS = NPTS/100
     	IF( NRNS*100 .LT. NPTS ) NRNS = NRNS + 1
     	IJ = 0
     	DO I=1, NRNS
     	   DO J=1, 100
     	      IJ = IJ + 1
     	      IBUF(J) = YOBS(IJ)
     	   ENDDO
     	   WRITE(IOUT,ERR=888) IBUF
     	ENDDO
     	GOTO 999

888	IERR = 1
999	RETURN
     	END
    	SUBROUTINE WRWPDF
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A JCAMP - PDF3 DATA FILE FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE WRWRIG
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A RIGAKU RAW DATA FILE
C	FROM THE COMMON BLOCKS
c
c	Updated to write unformatted Rigaku raw data files.
c	Martin McMillan			EASTMAN KODAK CO.
c			   Institute for Advanced X-ray Studies: 
c	March 10,1988


     	INCLUDE 'FILECONV.CBS'
	character ans*4,time*8,date*12
	integer*2 nnpts

     	CLOSE( UNIT=IOUT )

c	old stuff

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
c     	INCLUDE 'FILECONV.CBS'
c     	INTEGER*2 ITIT(40)
c     	EQUIVALENCE (ITIT,SLID)
c
c     	CLOSE( UNIT=IOUT )
c     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
c     	1 FORM='FORMATTED', ERR=888 )
cC
cC  WRITE THE FILE HEADER INFORMATION...
cC
c     	WRITE(IOUT,1,ERR=888) FILOUT
c1	FORMAT(A32)
c     	WRITE(IOUT,2,ERR=888) ITIT
c2	FORMAT(1X,40A2)
c     	WRITE(IOUT,3,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
c3	FORMAT(1X,F7.3)
c     	WRITE(IOUT,4,ERR=888) WAVE(IELE,3)
c4	FORMAT(1X,F8.5)
c     	WRITE(IOUT,2,ERR=888) NPTS
c5	FORMAT(1X,I5)
cC
cC  WRITE THE INTENSITY DATA...
cC
c     	DO I=1, NPTS
c     	   WRITE(IOUT,6,ERR=888) YOBS(I)
c6	FORMAT(1X,F8.1)
c     	ENDDO
c     	GOTO 999
c
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

c
c	update: March 10,1988
c
     	OPEN( UNIT=IOUT, FILE=FILOUT, ACCESS ='DIRECT', STATUS='NEW',
     	1 FORM='UNFORMATTED', RECL=1, ERR=777 )

C
C  WRITE THE FILE HEADER INFORMATION...
C

	write(iout,rec=1,err=777)'.RAW'
	call coddat(date(1:9),datm)
	call codtim(time,timm)
	write(iout,rec=2,err=777)date(1:4)
	write(iout,rec=3,err=777)date(5:8)
	write(iout,rec=4,err=777)date(9:12)
	write(iout,rec=5,err=777)time(1:4)
	write(iout,rec=6,err=777)time(5:8)

	do i=1,10
		write(iout,rec=6+i,err=777)slid(i)
	enddo

	junk=2
	if(slid(11).eq.' R  ')junk=1
	write(iout,rec=17,err=777)junk

	if(scan.eq.'C')junk=1
	if(scan.eq.'S')junk=2
	write(iout,rec=18,err=777)junk

	junk=1
	if(slid(12).eq.'Stnd')junk=1
	if(slid(12).eq.'Int ')junk=2
	if(slid(12).eq.'Skip')junk=3
	write(iout,rec=19,err=777)junk

	decode(4,1000,slid(13))junk
	write(iout,rec=20,err=777)junk

	write(iout,rec=21,err=777)dang(2)

c	decode(4,1000,slid(15))junk
c	write(iout,rec=23,err=777)junk

c	decode(4,1000,slid(17))junk
c	write(iout,rec=24,err=777)junk

	if(iele.eq.1)then
		ans(1:2)='Cr'
	else if(iele.eq.2)then
		ans(1:2)='Fe'
	else if(iele.eq.3)then
		ans(1:2)='Co'
	else if(iele.eq.4)then
		ans(1:2)='Cu'
	else if(iele.eq.5)then
		ans(1:2)='Mo'
	else
		ans(1:2)='US'
	end if

	write(iout,rec=25,err=777)ans(1:2)

	if(iele.eq.6)then
		write(iout,rec=31,err=777)wave(3,iele)
		write(iout,rec=32,err=777)wave(1,iele)
		write(iout,rec=33,err=777)wave(2,iele)
		write(iout,rec=34,err=777)wave(4,iele)
	endif

	write(iout,rec=35,err=777)dang(1)
	write(iout,rec=36,err=777)dang(3)
	nnpts=npts
	if(mpro.eq.1)mpro=1
	if(mpro.eq.4)mpro=2
	if(mpro.eq.3)mpro=3
	if(mpro.ne.1.or.mpro.ne.4.or.mpro.ne.3)mpro=1
	write(iout,rec=37,err=777)nnpts,mpro
	write(iout,rec=38,err=777)dang(10)
	write(iout,rec=44,err=777)dang(4)
	write(iout,rec=45,err=777)npts
	

C
C  WRITE THE INTENSITY DATA...
C
	do i=1,npts
		write(iout,rec=50+i,err=777)yobs(i)
	enddo
	goto 999

C

c	old stuff retained:

777	IERR = 1
999	RETURN
1000	format(i4)
     	END
     	SUBROUTINE WRWRIO
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  March 1989
C
C	THIS ROUTINE WRITES A RIGAKU ORIGINAL UNFORMATED RAW DATA FILE
C	FROM THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
        INTEGER*2 FILNUM, MONTH, DAY, YEAR, MPTS
        CHARACTER INSTR*4
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ACCESS='SEQUENTIAL', ERR=777 )
C
C  SET UP THE FILE HEADER INFORMATION FOR WRITING
C
     	IDAY = DATM / 10000
     	DAY = IDAY
     	IMONTH = DATM / 100 - IDAY * 100
     	MONTH = IMONTH
     	IYEAR = DATM - (IDAY * 10000 + IMONTH * 100)
     	YEAR = IYEAR
     	FILNUM = 99
     	INSTR = '    '
C
C  WRITE THE FILE HEADER INFORMATION...
C
      WRITE(IOUT, ERR=777, IOSTAT=IERR) FILNUM, MONTH, DAY, 
     &          YEAR, INSTR,
     &		(SLID(I),I=1,12), BANG(1), BANG(3), BANG(10), 
     &          ANODE(IELE), WAVE(3,IELE), BANG(2), NPTS
C
C write the intensities 32 per record.
C
C	NREC = (MPTS-1)/32 + 1
        DO 50 I = 1, NPTS, 32
	WRITE( IOUT, ERR=777) (YOBS(J), J=I,I+31)
50	CONTINUE
     	GO TO 999
777	IERR = 1
     	GOTO 999
999	RETURN
     	END
     	SUBROUTINE WRWSAS
C
C  PROGRAMMER:  R. L. Snyder
C		ALFRED UNIVERSITY,  Jul-1988
C
C	THIS ROUTINE WRITES OUT A GSAS RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER*80 TBUF
     	INTEGER*2 ITIT(40)
     	EQUIVALENCE (ITIT,SLID)

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ACCESS='SEQUENTIAL',
     1 RECORDTYPE='FIXED',RECL=80,FORM='FORMATTED', ERR=888 )
C
C  WRITE THE FILE HEADER INFORMATION...
C
	NSTEPS = NPTS
	NREC = (NSTEPS-1)/10+1
c
c  GSAS requires all I's to be 5 digits maximum. - so we will scale them 
c  here. and if a scale factor is determined - a form breaking message will 
c  be output.
c
    	scaley = 1.0
     	DO J = 1, NPTS
     	if( YOBS(J) .gt. 99999. .and. YOBS(J) .gt. scaley) 
     1  scaley = YOBS(J)
     	ENDDO
    	if( scaley .gt. 1.0 ) then
    		scaley = 99999. / scaley 
    		write(6,1055) scaley
1055	format(' Intensities have been scaled by ',e14.7)
    	endif
C
C  Write out the header block
C
     	WRITE(IOUT, 1065) SLID
1065	FORMAT(20A4)
	WRITE(TBUF,1075) 'BANK 1',NSTEPS,NREC,'CONST',BANG(1)*100.,
     1 BANG(3)*100., BANG(10)
1075	FORMAT(A,2I8,1X,A,2F10.0,f10.2,22X)
        WRITE(IOUT,'(A)') TBUF
C
C  WRITE THE INTENSITY DATA...
C
     	DO I = 1, NPTS, 10
     	WRITE(IOUT, 1080) (YOBS(J)*scaley, J=I,I+9)
1080	FORMAT(10F8.0)
     	ENDDO
     	GOTO 999

888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWSHA
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A SHADOW RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, DAY*9, TIM*8

     	CALL COLORS(1)
     	CALL PUTEXT('Write the output file in (A)SCII or (B)INARY <A> ',
     	1 49, 23, 1 )
     	READ(5,1000,ERR=777,END=777) IQS
     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

     	IF( IQS.EQ.'B' .OR. IQS.EQ.'b' ) GOTO 111
C
C  WRITE OUT AN ASCII FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST' )

     	WRITE(IOUT,1000,ERR=888) SLID
1000	FORMAT(20A4)
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,1001,ERR=888) DAY, TIM
1001	FORMAT(A9,A8)
     	WRITE(IOUT,1002,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
1002	FORMAT(4F10.4)
     	WRITE(IOUT,1003,ERR=888) (YOBS(I), I=1, NPTS)
1003	FORMAT(10F7.0)
     	GOTO 999
C
C  WRITE OUT A BINARY FILE...
C
111	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )

     	IQS = ' '
     	WRITE(IOUT,ERR=888) SLID
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,ERR=888) DAY, TIM
     	WRITE(IOUT,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
     	NLINE = NPTS/10
     	IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1
     	DO I=1, NLINE
     	   WRITE(IOUT,ERR=888) (YOBS(J), J=1+(I-1)*10, I*10)
     	ENDDO
     	GOTO 999

777	IERR = 3		!BAIL OUT
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWSPP
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A SPECPLOT RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 SNUM, MONT, DATE, YEAR, ELEM, NPTT, INST(2)
     	BYTE TITL(48)
     	CHARACTER ANOD*2
     	EQUIVALENCE (TITL(1),SLID(1))
     	EQUIVALENCE (ELEM, ANOD)

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )
C
C  WRITE THE HEADER INFORMATION FIRST...
C
     	SNUM = 1		!????
     	JUNK1= INT(DATM*1.0E-4)
     	JUNK2= INT(DATM*1.0E-2) - JUNK1*100
     	JUNK3= INT(DATM*1.0E-0) - JUNK1*10000 - JUNK2*100
     	DATE = JUNK1
     	MONT = (JUNK2-1)/3 + 1
     	YEAR = JUNK3
     	NPTT = NPTS
     	ANOD = ANODE(IELE)
     	WLEN = WAVE(1,IELE)
     	INST(1) = 'DI'		!ID FOR DIFFRACTION FILE
     	WRITE(IOUT,ERR=888) SNUM, DATE, MONT, YEAR, INST, TITL,
     	1 DANG(1), DANG(3), DANG(10), ELEM, WLEN, DANG(2), NPTT
C
C  WRITE OUT THE INTENSITY DATA --- 32 POINTS PER RECORD...
C
     	NLINE = NPTS/32
     	IF( NLINE*32 .LT. NPTS ) NLINE = NLINE + 1
     	YOBS(NPTS+1) = -999.0				!EOF FLAG
     	DO I=1, NLINE
     	   WRITE(IOUT,ERR=888) (YOBS(J), J=1+32*(I-1), 32*I)
     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWTAG
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  FEB-1987
C
C	THIS ROUTINE WRITES OUT A SCINTAG RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 ITIT(40)
     	EQUIVALENCE (ITIT,SLID)

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='FORMATTED', ERR=888 )
C
C  WRITE THE FILE HEADER INFORMATION...
C
     	WRITE(IOUT,10,ERR=888) ITIT
10	FORMAT(40A2)
     	WRITE(IOUT,15,ERR=888) DANG(10)
15	FORMAT(24X,F6.3)
C
C  WRITE THE INTENSITY DATA...
C
     	ANG = DANG(1)
     	DO I=1, NPTS
           Y = YOBS(I) * 60. / DANG(10)
     	   WRITE(IOUT,20,ERR=888) ANG, Y, SQRT(Y)
20	FORMAT(1X,F7.2,F9.0,F6.0)
     	   ANG = ANG + DANG(3)
     	ENDDO
C  PUT A BLANK RECORD AT END TO SIMULATE THE NULL TRASH
     	   WRITE(IOUT,20,ERR=888) 
     	GOTO 999

888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWUNK
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A ??? DATA FILE FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
C
C THE FOLLOWING IS A DUMMY ROUTINE UNTIL WE GET THE CORRECT FORMAT
C
	CALL NOTWRN
     	RETURN
     	END
     	SUBROUTINE WRWX3
C
C  PROGRAMMER:  R. L SNYDER
C		ALFRED UNIVERSITY   MAR-1988
C
C	THIS ROUTINE WRITES OUT A NSLS-X3 (SUNY) RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'

     	CALL CURSOR( 23, 1 )
     	CALL COLORS(-1)
     	CALL COLORS(80)
     	WRITE(6,111)
111	FORMAT(' _Sorry. This particular conversion routine has not',
     	1' been written yet.')
     	CALL PAUSES( 3 )
     	IERR= 3

C     	CLOSE( UNIT=IOUT )
C     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', FORM='FORMATTED',
C     	1 CARRIAGECONTROL='LIST', ERR=888 )
C
C     	GOTO 999
C888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWX7
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A NSLS-X7 (BNL) RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'

     	CALL CURSOR( 23, 1 )
     	CALL COLORS(-1)
     	CALL COLORS(80)
     	WRITE(6,111)
111	FORMAT(' _Sorry. This particular conversion routine has not',
     	1' been written yet.')
     	CALL PAUSES( 3 )
     	IERR= 3

C     	CLOSE( UNIT=IOUT )
C     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', FORM='FORMATTED',
C     	1 CARRIAGECONTROL='LIST', ERR=888 )
C
C     	GOTO 999
C888	IERR = 1
999	RETURN
     	END
     	SUBROUTINE WRWXRR
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT AN X-RAY RIETVELD RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, DAY*9, TIM*8

     	CALL COLORS(1)
     	CALL PUTEXT('Write the output file in (A)SCII or (B)INARY <A> ',
     	1 49, 23, 1 )
     	READ(5,1000,ERR=777,END=777) IQS
     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

     	IF( IQS.EQ.'B' .OR. IQS.EQ.'b' ) GOTO 111
C
C  WRITE OUT AN ASCII FILE...
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 FORM='FORMATTED', CARRIAGECONTROL='LIST' )

     	WRITE(IOUT,1000,ERR=888) SLID
1000	FORMAT(20A4)
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,1001,ERR=888) DAY, TIM
1001	FORMAT(A9,A8)
     	WRITE(IOUT,1002,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
1002	FORMAT(4F10.4)
     	WRITE(IOUT,1003,ERR=888) (YOBS(I), I=1, NPTS)
1003	FORMAT(10F7.0)
     	GOTO 999
C
C  WRITE OUT A BINARY FILE...
C
111	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )

     	IQS = ' '
     	WRITE(IOUT,ERR=888) SLID
     	CALL CODDAT( DAY, DATM )
     	CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,ERR=888) DAY, TIM
     	WRITE(IOUT,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
     	NLINE = NPTS/10
     	IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1
     	DO I=1, NLINE
     	   WRITE(IOUT,ERR=888) (YOBS(J), J=1+(I-1)*10, I*10)
     	ENDDO
     	GOTO 999

777	IERR = 3		!BAIL OUT
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
