     	SUBROUTINE RPLNBS
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A NBS RIETVELD OUTPUT LIST DATA FILE
C	AND WRITES OUT A BINARY PLOT DATA FILE FOR GRAFIT
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER TEXT, ans*3, cjunk*6, title*80, parfil*80
    	DIMENSION YCALC(MNP), xob(10,mnp)
        integer yob(10,mnp), yca(10,mnp)
        dimension ban(10,5), npt(10)
C
C  OPEN THE INPUT FILE...
C
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     	1 FORM='FORMATTED', READONLY, ERR=888 )

        call putext('Is file DBW or NBS plotfile format? <DBW>',41,24,1)
        read(5,1)ans
 1       format(a3)
     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)
        if(ans(1:1).eq.' '.or.ans(1:3).eq.'DBW'.or.ans(1:3).eq.'dbw')
     * goto 666
*** read NBS file
**
        ISEC = 0
 111   	if(isec.eq.5)goto 200
        NPTS = 0
     	READ(IINP,1001,END=777)n1,n3,n2
 1001	FORMAT(10i8)
        isec = isec + 1
        ban(isec,1) = 0.01 * n1
        ban(isec,2) = 0.01 * n2
        ban(isec,3) = 0.01 * n3        
        npt(isec) = (ban(isec,2) - ban(isec,1))/ban(isec,3) + 1
        nlns = npt(isec) / 10
        nrem = mod(npt(isec),10)
        write(6,1005)isec,nlns,nrem
 1005    format(' The number of lines and remainder of section '
     * ,i3,/,' are :',i5,i3)
        read(iinp,1000,end=777)text
 1000    format(a)
C
C  READ THE INTENSITY POINTS...
C
      do i = 1,nlns
        READ(IINP,1001,err=3000,END=777)(yob(isec,npts+j),j=1,10)
        READ(IINP,1001,err=3001,END=777)(yca(isec,npts+j),j=1,10)
        do k=1,10
          xob(isec,npts+k) = ban(isec,1) + ban(isec,3) * (npts+k)
        enddo
        npts = npts + 10
      enddo
      read(iinp,1001,end=777)(yob(isec,npts+j),j=1,nrem)
     *,(yca(isec,npts+j),j=1,10-nrem)
      if(nrem.gt.5)then
      read(iinp,1001,end=777)(yca(isec,npts+j),j=11-nrem,nrem)
      endif
      do k=1,nrem
        xob(isec,npts+k) = ban(isec,1) + ban(isec,3) * (npts+k)
      enddo
      GOTO 111
 200  write(6,2000)isec
 2000   format(' There are',i3,' ranges of data'/
     * ' range  from     to      step')
      do i=1,isec
        write(6,2001)i,(ban(i,j),j=1,3)
      enddo
 2001   format(2x,i3,3f8.2)
      write(6,2002)
 2002   format(' Which range do you want?')
      read(6,2003)nran
 2003   format(i)
      npts = npt(nran)
      do i=1,npts
        yobs(i) = real(yob(nran,i))
        ycalc(i) = real(yca(nran,i))
        xobs(i) = xob(nran,i)
       enddo
C
C  OPEN THE OUTPUT FILE...
C
*
        CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=555 )
     	JUNK = 0
     	WRITE(IOUT,ERR=555) NPTS, JUNK
     	WRITE(IOUT,ERR=555) (XOBS(I), I=1, NPTS)
     	WRITE(IOUT,ERR=555) (YOBS(I), I=1, NPTS)
     	WRITE(IOUT,ERR=555) NPTS, JUNK
     	WRITE(IOUT,ERR=555) (XOBS(I), I=1, NPTS)
     	WRITE(IOUT,ERR=555) (YCALc(I), I=1, NPTS)
     	GOTO 999
*** read DBW file
**
*
 666    CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='FORMATTED', carriagecontrol='list', ERR=555 )
        write(iout,4010)
 4010   format('-3')
*
        read(iinp,4001)slid
 4001   format(20a4,/,/)
        do i=1,2000
          read(iinp,4002)cjunk,npts
          if(cjunk(2:6).eq.'NPTSZ')goto 670
        enddo
 4002   format(a6,i5)
 670    read(iinp,4003)bang(1)
 4003   format(7x,f8.3)
        read(iinp,4004)bang(3)
 4004   format(7x,f7.3,/)
        do i=1,npts
          read(iinp,4005)yobs(i),ycalc(i)
          xobs(i) = bang(1) + bang(3) * (i-1)
          write(iout,4006)xobs(i),yobs(i),ycalc(i),ycalc(i)-yobs(i)
        enddo
        write(iout,4011)
 4005   format(1x,2f8.0)
 4006   format(f8.4,3f8.0)
 4011   format('! Observed pattern',/,'! Calculated Pattern',/,
     * '! Difference')
C================================================================
C  OPEN THE PARAMETER FILE...
C================================================================
*      	CALL NAMEXT( FILOUT, FILPAR, 'PAR' )
        do i=1,20
          if(filout(i:i).eq.'.')goto 675
          parfil(i:i) = filout(i:i)
        enddo
675   CLOSE( UNIT=13 )
      OPEN(UNIT=13,FILE=PARFIL(1:i),defaultfile='.par',STATUS='UNKNOWN',
     1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=666 )
       XAXDV = (XAXEN - XAXST)/5.0
        do i=1,18
          j = 4*(i-1) + 1
          title(j:j+3) = slid(i)
        enddo
      xaxdv = (xobs(npts) - xobs(1))/5.0
      WRITE(13,4015,ERR=666)title,bang(1),xobs(npts),xaxdv,FILOUT
4015    FORMAT('%This is a GRAFIT parameter/setup file: '/
     1   'TITL=',a72/
     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.00   0.00   0.00'
     C   ,3f7.2,/
     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,/
     F   'SETS= 2 0 1 1 1 1 0 0.100 0.000  0.500 1.0000 1.0000',/
     G   'SETS= 3 0 1 1 1 1 0 0.100 0.000 -0.500 1.0000 1.0000',/
     H   'SETS= 4 0 1 1 1 1 0 0.100 0.000  0.000 1.0000 1.0000')
        goto 999
 3000   write(6,3002)
 3002   format(' Error reading yob')
        goto 777
 3001   write(6,3003)
 3003   format(' Error reading yca')
        goto 777
555	IERR = -1
     	GOTO 999
777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
