     	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
C     	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
C     	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
C     	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
     	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
