      PROGRAM QUANTCONV
C
C  Program to convert a Diffrac-500 RAW file to an ascii file.
C
      CHARACTER FILE*80, NMRUN*9, NAM*6, IPHAS2*6, IPHAS3*6
      INTEGER QREC
      INTEGER*2 QUNHED, QUNLEN, JDUMY, IFLAG(4), IHKL(3),KODE,IOVLP
      INTEGER*2 IPK,NPK,NBG,NPTPK, IOPTIM,ILOC
      REAL*4 MUONRO,MUREF
	INCLUDE 'FILECONV.CBS'
	IO4=4
	IO5=5
	IO6=6
C
	WRITE(IO6,1)
1	FORMAT(/,' **** PROGRAM TO CONVERT QUANT ',
     &      'FILES TO ASCII FORMAT ****'/)
C
C  Input file name
2	WRITE(IO6,6)
6	FORMAT(' Enter the name of the Diffrac-500 file? ',$)
	READ(IO5,5,END=9800) FILINP
5	FORMAT(A)
C
C  Open the file & read the header info.
	IERR=0
	CALL RRW500
	IF(IERR.EQ.1) THEN
	   GOTO 9500
	ELSEIF(IERR.EQ.2) THEN
	   WRITE(IO6,82)
82	   FORMAT(/' ERROR OPENING FILE, TRY ANOTHER NAME')
	   GOTO 2
	ENDIF
	QREC=IRPR(5,1)
	IF(QREC.EQ.0) THEN
	   WRITE(IO6,10) FILINP
10	   FORMAT(' ERROR - File ',A,' is not a quant file.')
	   GOTO 9800
	ENDIF
	READ(IINP,REC=QREC) QUNHED,QUNLEN
	READ(IINP,REC=QREC+1) NRNG,JDUMY
	READ(IINP,REC=QREC+2) NMRUN(1:4)
	READ(IINP,REC=QREC+3) NMRUN(5:8)
	READ(IINP,REC=QREC+4) NMRUN(9:9)
	WAVEL=WAVE(1,6)
	WRITE(IO6,14) (SLID(I),I=1,16),NAME,DATM,WAVEL
14	FORMAT(' Sample ID=',16A4,/,
     &   ' Collected by ',3A4,' on ',F7.0,'   Wavelength=',F6.4)
C
C  Conversion type
	WRITE(IO6,20)
20	FORMAT(/' Output file type:',/
     &   ,/,5X,' 0 AUTO'
     &   ,/,5X,' 1 Sandia'
     &   ,/,5X,' n Several columns of numbers (for lineprinter)'
     &   ,//,' Enter number? ',$)
	READ(IO5,25,END=9800) IFLO
25	FORMAT(I)
	IF(IFLO.LT.0) GOTO 9800
C
C  Open output file
	WRITE(IO6,30)
30	FORMAT(/,' Enter name of output file: ',$)
	READ(IO5,35,END=9800) FILE
35	FORMAT(A)
	OPEN(UNIT=IO4,NAME=FILE,STATUS='NEW',CARRIAGECONTROL='LIST')
C
      IF(IFLO.EQ.0) THEN
	 WRITE(IO6,100)
100	 FORMAT(/' Creating an AUTO file')
	 IFLAG(1) = FTYP
	 IFLAG(2) = IFLAG(1)
	 IFLAG(3) = MTYP
	 IFLAG(4) = 0
	 NMOUNT=1
	 WRITE(IO4,104) (SLID(I),I=1,15),NAME, DATM,TIMM,
     &     (IFLAG(I),I=1,4), NREP,NMOUNT,0,0,0,0,NMRUN,WAVEL
104	 FORMAT(15A4,24X,3A4,8X, F7.0,T107,F7.0,T113,
     &     10I1,A9,/F32.4////)
      ELSE
	 WRITE(IO6,150)
150	 FORMAT(/' Creating a Sandia file')
C  Find length of Sample ID.
	 DO 157,LENSID=15,1,-1
	    IF(SLID(LENSID).NE.'    ') GOTO 160
157	 CONTINUE
	 LENSID=1
160      CONTINUE
      ENDIF
C
      IREC = IRPR(6,1)	! Beginning of intensity
C
      DO 1900,IREP=1,NREP
C       LREC = IRPR(4,1)	! Line info
       DO 1900,IRNG=1,NRNG
C  Read the data for this peak
	 QREC=IRPR(5,1)+((IRNG-1)*QUNLEN) + QUNHED	
	 READ(IINP,REC=QREC) PANGD
	 READ(IINP,REC=QREC+ 1) BKGTIM
	 READ(IINP,REC=QREC+ 2) TIMLIM
	 READ(IINP,REC=QREC+ 3) PKTIM
	 READ(IINP,REC=QREC+ 4) FIXERR
	 READ(IINP,REC=QREC+ 5) NAM(1:4)
	 READ(IINP,REC=QREC+ 6) NAM(5:6)	
	 READ(IINP,REC=QREC+ 8) IHKL(1),IHKL(2)
	 READ(IINP,REC=QREC+ 9) IHKL(3),JDUMY
	 READ(IINP,REC=QREC+10) KODE,IOVLP
	 READ(IINP,REC=QREC+11) IPK,NPK
	 READ(IINP,REC=QREC+12) NBG,NPTPK
	 READ(IINP,REC=QREC+13) FREL
	 READ(IINP,REC=QREC+14) SIGREL
	 READ(IINP,REC=QREC+15) RIR
	 READ(IINP,REC=QREC+16) SIGRIR
	 READ(IINP,REC=QREC+17) CONC
	 READ(IINP,REC=QREC+18) MUONRO
	 READ(IINP,REC=QREC+19) WTSPIK
	 READ(IINP,REC=QREC+20) IOPTIM,ILOC
	 READ(IINP,REC=QREC+21) SCONS
	 READ(IINP,REC=QREC+22) MUREF
C
	 READ(IINP,REC=QREC+49) BANGD
	 READ(IINP,REC=QREC+50) EANGD
	 READ(IINP,REC=QREC+51) DANGD
C
     	 NPTS = INT( (EANGD-BANGD)/DANGD+1.5 )
         DO I=1, NPTS
     	   READ(IINP,REC=IREC) YOBS(I)
     	   IREC = IREC + 1
	 IF(I.LE.NBG .OR. (EANGD.NE.0.0 .AND. I.GT.(NPTS-NBG))) THEN
	    YOBS(I) = YOBS(I) / BKGTIM * PKTIM
	 ENDIF
         ENDDO
C
C
         IF(IFLO.EQ.0) THEN
C
C  Write the peak to an AUTO file
	IF(METHOD.EQ.2) CONC=MUONRO
	IF(METHOD.EQ.2) SCONC=MUREF
	IF(METHOD.GT.2) CONC=WTSPIK
	IF(CONC.LT.-99.999 .OR. CONC.GT.999.999) CONC=0.0
	IF(SCONC.LT.-99.999 .OR. SCONC.GT.999.999) SCONC=0.0
	IF(FREL.LT.-99.999 .OR. FREL.GT.999.999) FREL=0.0
	IF(SIGREL.LT.-99.999 .OR. SIGREL.GT.999.999) SIGREL=0.0
	IF(STD.LT.-99.999 .OR. STD.GT.999.999) STD=0.0
	IF(SIGSTD.LT.-99.999 .OR. SIGSTD.GT.999.999) SIGSTD=0.0
	IF(BKGTIM.LT.-99.999 .OR. BKGTIM.GT.999.999) BKGTIM=0.0
	   WRITE(IO4,1004) BANGD,PANGD,EANGD, DANGD, 3.0, 0,
     1	TIMLIM, FIXERR, 999999., NAM, IHKL, KODE,IOVLP,IPK, NPK,NBG,
     2		FREL, SIGREL, STD, SIGSTD,
     3		CONC, PKTIM,BKGTIM, IOPTIM,ILOC, SCONC, ' '
1004  	   FORMAT(3F7.3,F7.4,F4.1,I1,
     1  	F5.1,F5.2,F7.0,A6,3I2,3I1,2I2,
     2		F6.1,F4.1,F9.4,F8.4,
     3 		 F7.3,2F7.2,2I1,F7.3, /,128A1)
C
C300   FORMAT(F7.3,2I2,I5,16I7)
C      WRITE(IO4,300) CANGD,ITIM(1),ITIM(2),ITEMP,
	    WRITE(IO4,300) (IFIX(YOBS(I)),I=1,NPTS)
300         FORMAT(7X,2X,2X,5X,16I7)
C
         ELSE
C
C  Write the peak to a Sandia file
	    WRITE(IO4,2014) (SLID(I),I=1,LENSID), IHKL, IHKL,
     &         NPTS, 10.0, BANGD,EANGD,DANGD
2014	    FORMAT(<LENSID>A4,' (',3I2,') (',3I2,')',/,
     &		I4,F10.2,3F10.4)
	    WRITE(IO4,2020) (YOBS(I),I=1,NPTS)
C  Normally IFLO=1 so this format is equivalent to (1F10.2)
2020	    FORMAT(<IFLO>F10.2)
C
         ENDIF
1900  CONTINUE
	WRITE(IO6,1904)
1904	FORMAT(/' CONVERSION COMPLETE ')
	GOTO 9999
C
C
C  Error exit
9500	WRITE(IO6,9604) IREC
	GOTO 9700
9600	WRITE(IO6,9604) QREC
9604	FORMAT(/' ERROR READING FILE AT RECORD ',I5)
9700	CLOSE(UNIT=IO4, DISP='DELETE')
9800	WRITE(IO6,9806)
9806	FORMAT(' CONVERSION ABORTED ')
C
C  Normal exit
9999	STOP
	END
     	SUBROUTINE RRW500
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
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)

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     	1 ACCESS='DIRECT', RECL=1, READONLY ,
	2 DEFAULTFILE='RA:.RAW')
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
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
     	GOTO 999
C
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
