     	SUBROUTINE RDI5000
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C  MODIFIED:    S.I. ZDZIESZYNSKI TO READ D/I FILE FROM D5000
C               and to read data from multiple ranges with compatible
C                 parameters.    MAY-1992            
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
C==================================================================

     	INCLUDE 'FILECONV.CBS'

     	INTEGER*2 DUMY, DIFSER, DIFRNG, ISDI(20), NUMP(20),
     1  iloc1(100), iloc2(100),DUMY2(MNK),DIVER,MTHC
     	REAL*4 LAMDA1,LAMDA2,LAMDA3,LAMDA4,DUMY1(MNK),SPCAN(4)
!     &         ,RES ,INTMAX
        integer*4 ipoint
        COMMON DIFSER,DIFRNG
        CHARACTER DACOUT*1
        DIMENSION ANG(14,20)
	LOGICAL*1	CHANGE
	CHANGE=.TRUE.
     	CLOSE( UNIT=IINP )
C
         OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     &         ACCESS='DIRECT', RECL=12, READONLY )
C
C  READ THE FILE HEADER BLOCK...
C
     	READ(IINP,REC= 1) DIVER,ITYP,NHDB,ISBF,LENG 
     	IF( ITYP.NE.2 ) GOTO 777
	ipoint=LENG+ISBF       !first record after header and spec block
     	IF( LENG.LT.3 ) GOTO 777
 
C
C  READ THE SPECIFICATION BLOCK REFERENCES...
C
     	IREC = ISBF
      READ(IINP,REC= IREC)(IRPR(I,1),IRPR(I,2),IRLR(I),I=1,4)
      READ(IINP,REC= IREC+1)(IRPR(I,1),IRPR(I,2),IRLR(I),I=5,8)
      READ(IINP,REC= IREC+2)(IRPR(I,1),IRPR(I,2),IRLR(I),I=9,12)
C
C  READ THE INSTRUMENTATION BLOCK...
C
     	IREC = IRPR(1,1) + 4
     					!READ THE WAVE SOURCES
      READ(IINP,REC=IREC) DIFNUM,DIFVER,GONINT,ANODE(6),CHRLIN,
     &                   (WAVE(I,6),I=1,5)
C
     	IF( WAVE(1,6).LE.0.0 ) GOTO 777
     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.005 ) IELE = I
     	ENDDO
C
C  READ THE FILE DESCRIPTION BLOCK...
C						!250
     	IREC = IRPR(3,1)
C
       READ(IINP,REC= IREC  )(NAME(I),I=1,3),DATM,TIMM,
     & FTYP,MTYP, INTMAX,RES,NREP,MPRO,NRNG,SCAN
C
       READ(IINP,REC= IREC+1)(SPCAN(I),I=3,4),STYP,MTHC
     &                                 ,DACOUT,(SLID(I),I=1,9)
       READ(IINP,REC=IREC+2)(SLID(I),I=10,15)
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)
         IF(NREP.EQ.0 .OR. NRNG.EQ.0) THEN
           NREP=1
           NRNG=1
         ENDIF
        K=0
        DO L=1,NREP
     	READ(IINP,REC= IREC+K) (BANG(I),I=1,12)
     	READ(IINP,REC= IREC+K+1) (BANG(I),I=13,14)   
        K=K+2
        DO I=1,14
        ANG(I,L)=BANG(I)

        ENDDO
        ENDDO
        IF(NRNG.GT.1) THEN 
      ANG(2,0)=ANG(1,1)
      ANG(3,0)=ANG(3,1)
      ANG(10,0)=ANG(10,1)          
        DO L=1,NREP*NRNG
        DO I=1,14

C   Check if measurement parameters (angle range,step, count time)
C   are compatible for each range.
    
      IF(ANG(1,L).LT.ANG(2,L-1). OR .ANG(3,L-1).NE.ANG(3,L). OR .
     &   ANG(10,L-1). NE .ANG(10,L)) GO TO 260
      TYPE 251,FILINP
251   FORMAT(/////' Your file:',X,A,/,
     &' contains compatible parameters for all ranges.',/,
     &' Do you want to convert all ranges into one file Y/N <Y> ?',$)
      ACCEPT 252, CHOICE
252   FORMAT(A1)
      IF(CHOICE.NE.'N') CHOICE='Y'
      IF(CHOICE.EQ.'N') GO TO 260
      IF(CHOICE.EQ.'Y') GO TO 253
           ENDDO
           ENDDO
253   	IREC = IRPR(6,1)
        NPKS=0        
     	READ(IINP,REC= IREC) DIFSER,DIFRNG,(ILOC1(I),
     &                               ILOC2(I),I=1,11)
        IF(DIFSER*DIFRNG.GT.11) THEN
         J=0
         LAST=DIFSER*DIFRNG
 	 DO I=1,DIFSER*DIFRNG,12
         J=J+1
         LAST=LAST-12
         IF (LAST-12) 111,112,112
112       LAST=12     
111       READ(IINP,REC=IREC+J)(ILOC1(J),ILOC2(J),J=1,LAST)
         ENDDO
        ENDIF
         DO J=1,DIFSER*DIFRNG
         NPKS=ILOC2(J)+NPKS
         ENDDO
	LAMDA1 = 0.5*WAVE(1,IELE)
     	LAMDA2 = 0.5*WAVE(2,IELE)
     	LAMDA3 = 0.5*WAVE(3,IELE)
     	LAMDA4 = 0.5*WAVE(4,IELE)

        IREC=IRPR(6,1)+ILOC1(1)-1      
        IK=1
       	DO L=0, NPKS-1

        NREC=IREC+L
     	READ(IINP,REC=NREC)F2TH(IK),C2TH(IK),PEAK(IK)
     & ,DUMY1(IK),PHGH(IK),DUMY1(IK),AREA(IK,1),AREA(IK,2),FWHM(IK)
     &  ,(PHKL(I,IK),I=1,3),DUMY2(IK),RELA(IK) 

		IF( AREA(IK,2).LT.1.0 ) AREA(IK,2) = 0.0
     		IF( AREA(IK,2).GE.1.0 ) IRES = 1
     		IF( IABS(PHKL(1,IK)).GT.99 ) PHKL(1,IK) = 0
     	 	IF( IABS(PHKL(2,IK)).GT.99 ) PHKL(2,IK) = 0
     		IF( IABS(PHKL(3,IK)).GT.99 ) PHKL(3,IK) = 0
     	
	   IF( PEAK(IK).NE.'KA2' .AND. PEAK(IK).NE.'KA' .AND.
     &                            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
      BANG(1)=ANG(1,1)
      BANG(2)=ANG(2,NREP*NRNG)
        GO TO 999
        ENDIF
C
C  READ THE DIFILE DATA BLOCK... (for separated ranges)
C							!250

260   	IREC = IRPR(6,1)

     	READ(IINP,REC= IREC) DIFSER,DIFRNG,(ILOC1(I),
     &                               ILOC2(I),I=1,11)
     &  
        IF(DIFSER*DIFRNG.GT.11) THEN
         J=0
         LAST=DIFSER*DIFRNG
 	 DO I=1,DIFSER*DIFRNG,12
         J=J+1
         LAST=LAST-12
         IF (LAST-12) 11,12,12
12       LAST=12     
11       READ(IINP,REC=IREC+J)(ILOC1(J),ILOC2(J),J=1,LAST)
         ENDDO
        ENDIF							!310
     	IF( difser.LT.1 .OR. difrng.LT.1 ) GOTO 777
     	IF( difser.GT.1 ) THEN
C     	    DUMY = LDIGIT( difser )
1002	    WRITE(6,1000) difser
     	    READ(6,1001,ERR=1002,END=1002) DUMY
    	    IF( DUMY.LT.1 .OR. DUMY.GT.difser ) DUMY = 1
     	    iser = DUMY
     	ENDIF
1000	FORMAT(///
     	1' Input file contains ',I2,' series of measurements'/
     	1' but only one measurement can be converted at a time.'/
     	1'$Which measurement to use? <1> ')
1001	FORMAT(I)
        IRNG=DIFRNG    
     	IF( difrng.GT.1 ) THEN
C     	    DUMY = LDIGIT( difrng )
1003	    WRITE(6,1005) difrng
     	    READ(6,1001,ERR=1003,END=1003) IRNG
   	    IF( IRNG.LT.1 .OR. IRNG.GT.difrng ) IRNG = 1
     	ENDIF
1005	FORMAT(/
     &	' Input file contains ',I2,' ranges of data'/
     &	' but only one range can be converted at a time.'/
     &	'$Which range to use? <1> ')
C
C ****  SET RECORD NUMBER FOR CHOISEN SERIES AND RANGES
C
100     IREC = IRPR(6,1)+ILOC1(IRNG)-1 !JUMP TO THE RANG
        IF(IRNG.EQ.0 )IREC=IRPR(6,1)+ILOC1(1)
     	NPKS = ILOC2(IRNG)
     	IF( NPKS.GT.MNK) NPKS = MNK
C
	LAMDA1 = 0.5*WAVE(1,IELE)
     	LAMDA2 = 0.5*WAVE(2,IELE)
     	LAMDA3 = 0.5*WAVE(3,IELE)
     	LAMDA4 = 0.5*WAVE(4,IELE)
C      
        IK=1
       	DO L=0, NPKS-1
       
C
        NREC=IREC+L
        
     	READ(IINP,REC=NREC)F2TH(IK),C2TH(IK),PEAK(IK)
     & ,DUMY1(IK),PHGH(IK),DUMY1(IK),AREA(IK,1),AREA(IK,2),FWHM(IK)
     &  ,(PHKL(I,IK),I=1,3),DUMY2(IK),RELA(IK) 
C
		IF( AREA(IK,2).LT.1.0 ) AREA(IK,2) = 0.0
     		IF( AREA(IK,2).GE.1.0 ) IRES = 1
     		IF( IABS(PHKL(1,IK)).GT.99 ) PHKL(1,IK) = 0
     	 	IF( IABS(PHKL(2,IK)).GT.99 ) PHKL(2,IK) = 0
     		IF( IABS(PHKL(3,IK)).GT.99 ) PHKL(3,IK) = 0
     	
	   IF( PEAK(IK).NE.'KA2' .AND. PEAK(IK).NE.'KA' .AND.
     &                            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
        IERR=0
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999    	RETURN
     	END
