     	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
C       X-RAY RIETVELD PLOT IS NEW CIRCA-1990 VERSION BY
C       SCOTT HOWARD, CONVERSION MODIFICATION WRITTEN BY
C       DAVID MATHEIS
C
      INCLUDE 'FILECONV.CBS'
      CHARACTER qtext*78, FILPAR*32, title*80, qdgttl(10)*28
      character qntitl*20
      DIMENSION kdgfrq(10), pdgofs(10), kdgpen(10),
     1  kdgtyp(10), pdginc(10), kdgusd(10), pdglxy(10,3),
     2  xdata(7500,10), ydata(7500,10), PDVVL2(999,10), KDVIV1(999,10),
     3  PDVXVL(999,10),PDVYVL(999,10),PDVVL1(999,10), ndpts(10)
     	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(IINP, FILE=FILINP, STATUS='OLD',
     1   FORM='UNFORMATTED', ERR=888 )
C
C  READ THE file header...
C
     	READ(IINP,err=1111,end=777) qtext
     	READ(IINP,ERR=1111,END=777) title
       	READ(IINP,ERR=1111,END=777) xscale, jaxbox, jaxdrw
     	READ(IINP,ERR=1111,END=777) jxaxid, xaxor, xaxln, 
     1  xaxst, xaxen, xaxdv
     	READ(IINP,ERR=1111,END=777) jyaxid, yaxor, yaxln, 
     1  yaxst, yaxen, yaxdv
     	READ(IINP,ERR=1111,END=777) knum
*
C *  GET THE GROUP PARAMETERS
*
      DO  I=1,KNUM
        READ(IInp) QNTITL,I1,X1,I2,I3,X2
        QDGTTL(I)   = QNTITL
        KDGFRQ(I)   =  I1
        PDGOFS(I)   =  X1
        KDGPEN(I)   =  I2
        KDGTYP(I)   =  I3
        PDGINC(I)   =  X2
        KDGUSD(I)   =   0
        PDGLXY(I,1) = 0.0
        PDGLXY(I,2) = 0.0
        PDGLXY(I,3) = 0.0
      enddo
*
** READ THE DATA SETS
*
 100  READ(IInp,END=1) NSET,NDVPTS,PDVBEG
      WRITE(6,12) NSET,NDVPTS
 12    FORMAT(' Reading data for group ',I2,'. Number of points = ',I5)
      ndpts(nset) = ndvpts
C *
C **  READ TYPE 0 DATA, PLOTTING DATA SET
C *
      IF(KDGTYP(NSET).NE.0) GO TO 200
        NREC = ndvpts / 10
        NREM = NDVPTS - NREC * 10
        NTRK = 0
        DO  I=1,NREC
          READ(iinp,END=1) ( ydata(J,nset), J=(NTRK+1),(NTRK+10) )
          NTRK = NTRK + 10
        enddo
        IF(NREM.GT.0) THEN
          READ(iinp,END=1) ( ydata(J,nset), J=(NTRK+1),(NTRK+NREM) )
        ENDIF
        do i=1,ndvpts
          xdata(i,nset) = pdvbeg + (i-1) * pdginc(nset)
        enddo
      GO TO 100
C *
C **  READ TYPE 1 = X-Y DATA
C *
200   IF(KDGTYP(NSET).NE.1) GO TO 300
        DO  I=1,NDVPTS
          READ(iinp,END=1) xdata(I,nset),ydata(I,nset)
        enddo
      GO TO 100
C *
C **  READ TYPE 2 DATA = MARKER INFORMATION
C *
300   IF(KDGTYP(NSET).NE.2) GO TO 400
        DO I=1,NDVPTS
          READ(iinp,END=1) PDVXVL(i,nset),PDVYVL(i,nset),
     1    PDVVL1(i,nset),PDVVL2(i,nset),KDVIV1(i,nset)
        enddo
      GO TO 100
C *
C **  READ TYPE 3 DATA = VERTICAL ERROR BARS
C *
400   IF(KDGTYP(NSET).NE.3) GO TO 500
        DO I=1,NDVPTS
          READ(iinp,END=1) PDVXVL(i,nset),PDVYVL(i,nset),PDVVL1(i,nset)
        enddo
      GO TO 100
C *
C **  READ TYPE 4 DATA = HORIZONTAL ERROR BARS
C *
500   IF(KDGTYP(NSET).NE.4) GO TO 777
        DO I=1,NDVPTS
          READ(iinp,END=1) PDVXVL(i,nset),PDVYVL(i,nset),PDVVL1(i,nset)
        enddo
      GO TO 100

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) qtext
3000	FORMAT(A)
        READ(IINP,3000,ERR=777,END=777) title
        READ(IINP,3010,ERR=777,END=777) xscale, jaxbox, jaxdrw
 3010    format(f9.4,i9,i9)
     	READ(IINP,3001,ERR=777,END=777) jxaxid, xaxor, xaxln,
     1   xaxst, xaxen, xaxdv
3001	FORMAT(i9,5f9.4)
        READ(IINP,3001,ERR=777,END=777) jyaxid, yaxor, yaxln,
     1   yaxst, yaxen, yaxdv
     	READ(IINP,3002,ERR=777,END=777) knum
3002	FORMAT(I9)
     	DO I=1, knum
          READ(IINP,3003,ERR=777,END=777) qdgttl(I), kdgfrq(I),
     1     pdgofs(I), kdgpen(i), kdgtyp(i), pdginc(i)
     	ENDDO
3003	FORMAT(A28,i1,f9.2,2i9,F9.4)
C
C  READ THE DATA RECORDS...
C
2225	READ(IINP,3004,ERR=777,END=1) nset, ndvpts, pdvbeg
3004	FORMAT(2I6,F10.4)
     	IF( kdgtyp(Nset).NE.0 ) GOTO 3333
        ndpts(nset) = ndvpts
C
C  INTENSITY DATA FOLLOW...
C
     	READ(IINP,3005,ERR=777,END=1) (Ydata(I,nset),I=1, Ndvpts)
3005	FORMAT(10F8.1)
     	DO I=1, ndvpts
     	   Xdata(I,nset) = pdvbeg + (I-1) * pdginc(nset)
     	ENDDO
     	GOTO 2225

3333	IF( kdgtyp(Nset).NE.1 ) GOTO 4444
C
C  GENERL X,Y PAIR DATA FOLLOW...
C
     	READ(IINP,3006,ERR=777,END=1) (Xdata(I,nset),Ydata(I,nset), 
     1   I=1, Ndvpts)
3006	FORMAT(2F10.4)
     	GOTO 2225

4444	IF( kdgtyp(nset).NE.2 ) GOTO 777
C
C  REFLECTION MARKER INFORMATION FOLLOWS...
C
     	READ(IINP,3007,ERR=777,END=1) PDVXVL(i,nset),PDVYVL(i,nset),
     1    PDVVL1(i,nset),PDVVL2(i,nset),KDVIV1(i,nset)
3007	FORMAT(4F10.4,I2)
        goto 2225
C================================================================
C  OPEN THE PARAMETER FILE...
C================================================================
 1    	CALL NAMEXT( FILOUT, FILPAR, 'PAR' )
      	CLOSE( UNIT=13 )
     	OPEN( UNIT=13, FILE=FILPAR, STATUS='UNKNOWN',
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=666 )
        XAXDV = (XAXEN - XAXST)/5.0
     	WRITE(13,1000,ERR=666) title, xaxst, xaxen, xaxdv, FILOUT
1000	FORMAT('%This is a GRAFIT parameter/setup file: '/
     1   'TITL= ',a/
     2   'XLB1=TWO-THETA (DEGREES)'/
     3   'YLB1=INTENSITY (CPS)'/
     A   'XLB2='/
     B   'YLB2='/
     4   'OVER=   2   1   0   1   1   1   4.000   4.500   1.250
     5   1.200   0.000   0.000   1.000   1.000'/
     C   'XAX1=   1   5   1   0  11   8.000   0.000   0.000   0.000'
     C   ,f8.5,3x,f10.5,3x,f6.3/
     D   'YAX1=   1   4   1   0  11   6.000'/
     6   'PAR1=   1.00   1.00   1.00   1.00   0.00   0.00   1.00
     7   1.00   1.00   0.00'/
     8   'PAR2=   5.00   1.00   1.00   0.00   0.00   0.00   0.00
     9   0.00   0.00   0.00'/
     E   'IDEN=',A32)
*
* WRITE LABELS TO PARAMETER FILE
*
      do i=1,knum
        YOFF = 0.0
        IPN = i + 1
        IF(qdgttl(i).EQ.'Observed pattern')THEN
          YOFF = 0.5
        ENDIF
        IF(qdgttl(i).EQ.'Calculated pattern')THEN
          YOFF = -0.5
        ENDIF
        IF(qdgttl(i).EQ.'Background')THEN
          YOFF = -0.6
        ENDIF
        IF(qdgttl(i).EQ.'Difference pattern')THEN
          YOFF = 0.0
        ENDIF
        WRITE(13,1101,ERR=666)IPN,YOFF,qdgttl(i)
1101     FORMAT('SETS=',I4,'   0   1   3   1   1   0   0.100   0.000',
     1   F8.3,' 1.0000 1.0000 0.00000E+00'/
     2   'LABL=',A28)
      enddo
*
C====================================================================
C  OPEN THE OUTPUT FILE...
C====================================================================
 900	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=666 )
*
      do i=1,knum
        if(ndpts(i).eq.0)goto 910
        WRITE(IOUT,ERR=666) Ndpts(i)
     	WRITE(IOUT,ERR=666) ( Xdata(j,I), j=1, Ndpts(i) )
     	WRITE(IOUT,ERR=666) ( Ydata(j,I), j=1, Ndpts(i) )
 910  enddo
      go to 999
*
777	IERR = 1
     	GOTO 999
666	IERR = -1
     	GOTO 999
888	IERR = 2
999	CLOSE( UNIT=13 )
        CLOSE(UNIT=Iinp)
        CLOSE(UNIT=IOUT)
     	RETURN
     	END

