C   TEST PROGRAM TO VERIFY BELOW SUBROUTINES (FORT/D_LINES)
D	INCLUDE 'FILECONV.CBS'
D	CALL OBREAD(5,6,WAVEL)
D	WRITE(IO6,4) (SLID(I),I=1,16),NAME,DATM,NPKS
D4	FORMAT(' SAMPLE ID=',16A4,/,'COLLECTED BY ',3A4,' ON ',F7.0,
D    &	   '   NUMBER OF PEAKS=',I5)
D	TYPE*,'WAVE=',(WAVE(I,6),I=1,5)
D	WRITE(IO10,24) (C2TH(I),CDSP(I),PHKL(1,I),
D     &	   PHKL(2,I),PHKL(3,I),PHGH(I),I=1,NPKS)
D24	FORMAT(2F10.4,3I3,F10.4)
D	CALL OBWRIT(IO6)
D	END

	SUBROUTINE OBREAD(IO5,IO6,WAVEL)
	INCLUDE 'FILECONV.CBS'
1	WRITE(IO6,6)
6	FORMAT(' Enter the filename with the observed peaks? ',$)
	READ(IO5,5,END=9800) FILINP
5	FORMAT(A)
	IERR=0
	CALL RDI500
	IF(IERR.EQ.1) THEN
	   WRITE(IO6,81) IERR,IREC
81	   FORMAT(/' ERROR READING FILE.  IERR=',I5,' IREC=',I5)
	   GOTO 9800
	ELSEIF(IERR.EQ.2) THEN
	   WRITE(IO6,82)
82	   FORMAT(/' ERROR OPENING FILE, TRY ANOTHER NAME')
	   GOTO 1
	ENDIF
	WAVEL=WAVE(1,6)
	WRITE(IO6,14) (SLID(I),I=1,16),NAME,DATM,NPKS,WAVEL
14	FORMAT(' Sample ID=',16A4,/,
     &   ' Collected by ',3A4,' on ',F7.0,'   Number of peaks=',I5,
     &   ' Wavelength=',F6.4)
	RETURN
9800	STOP ' RUN CANCELED '
	END

	SUBROUTINE OBWRIT(IO10)
	INCLUDE 'FILECONV.CBS'
	DO 7,I=1,NPKS
	IF(C2TH(I).NE.0.0) WRITE(IO10,24) C2TH(I),PHGH(I)
7	CONTINUE
24	FORMAT(2F10.4)
	RETURN
	END

	SUBROUTINE OBWRIN(IO10)
	INCLUDE 'FILECONV.CBS'
	DO 7,I=1,NPKS
	IF(C2TH(I).NE.0.0) WRITE(IO10,24) C2TH(I),AREA(I,1)
7	CONTINUE
24	FORMAT(2F10.4)
	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
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 DUMY, NDIS, NDIR, ISDI(20), NUMP(20)
     	REAL*4 LAMDA1,LAMDA2,LAMDA3,LAMDA4

     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     	1 ACCESS='DIRECT', RECL=1, READONLY,
	2 DEFAULTFILE='DI:.DIF')	!JDW FOR NBS
C
C  READ THE FILE HEADER BLOCK...
C
     	READ(IINP,REC= 1,ERR=777) DUMY,ITYP
     	IF( ITYP.NE.2 ) GOTO 777
     	READ(IINP,REC= 2,ERR=777) NHDB
     	READ(IINP,REC= 3,ERR=777) ISBF
     	READ(IINP,REC= 4,ERR=777) LENG
     	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
C
C  READ THE LINE MEASUREMENT BLOCK (FIRST RANGE ONLY)...
C
     	IREC = IRPR(4,1)
     	DO I=1, 14
     	   READ(IINP,REC= IREC,ERR=777) BANG(I)
     	   IREC = IREC + 1
     	ENDDO
CC     	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) NDIS,NDIR
     	IF( NDIS.LT.1 .OR. NDIR.LT.1 ) GOTO 777
     	DO I=1, NDIR*NDIS
     	   IREC = IREC + 1
     	   READ(IINP,REC= IREC,ERR=777) ISDI(I),NUMP(I)
     	ENDDO

     	IF( NDIS.GT.1 ) THEN
     	    DUMY = LDIGIT( NDIS )
1002	    WRITE(6,1000) NDIS
     	    READ(5,1001,ERR=1002,END=1002) DUMY
     	    IF( DUMY.LT.1 .OR. DUMY.GT.NDIS ) DUMY = 1
     	    NDIS = 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( NDIR.GT.1 ) THEN
     	    DUMY = LDIGIT( NDIR )
1003	    WRITE(6,1005) NDIR
     	    READ(5,1001,ERR=1003,END=1003) IRNG
     	    IF( IRNG.LT.1 .OR. IRNG.GT.NDIR ) 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+(NDIS-1)*NDIR
     	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)
     		IF( PEAK(IK).EQ.' ' ) PEAK(IK) = 'KA1'
     	   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) NDIS,NDIR
     		IF( IABS(NDIS).GT.99 ) NDIS = 0
     	 	IF( IABS(NDIR).GT.99 ) NDIR = 0
     	   	PHKL(1,I) = NDIS
     	   	PHKL(2,I) = NDIR
     	   READ(IINP,REC= IREC+10,ERR=777) NDIS
     		IF( IABS(NDIS).GT.99 ) NDIS = 0
     		PHKL(3,I) = NDIS
     	   READ(IINP,REC= IREC+11,ERR=777) RELA(IK)
     	   	IREC = IREC + 12
     	   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))
     	   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))
     	   IF(FDSP(IK).GT.0.5*LAMDA4) IK = IK + 1
     	ENDDO
     	NPKS = IK
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
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

