     	SUBROUTINE RRWX3
C
C  PROGRAMMER:  David P. Matheis
C		ALFRED UNIVERSITY   May 1990
C
C	THIS ROUTINE READS FROM A NSLS-X3 (SUNY) RAW DATA FILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
      INCLUDE 'FILECONV.CBS'
      dimension junk(4),qang(20,5),knpts(20),nnset(20),TIME(15000), 
     1 rqang(20,5), xa(15000), ya(15000), nrpts(20), YREF(15000),
     2 crqang(20,4), ncrpts(20), nirq(20)
      real swave(20), junk1, junk2, junk3
      character*10 title(20), rtitle(20), crtitle(20)
      character*2 cacat
C
C added 9/20/90 ABM  : seed for random number function
C (the seed should be a very large odd integer)
      integer*4 nseed
      secs = 0.0
      nseed = ((2**30-ifix(secnds(secs)))/2)*2+1
C
      iele = 6
      close(unit=iout)
      open(unit=iout,file='nvaxc.log',status='new',
     1 form='formatted',carriagecontrol='list')
*=====================================================================
* try to open file as unformatted first
*=====================================================================
      close(unit=iinp)
      open(unit=iinp,file=filinp,status='old',form='unformatted',
     1  access='sequential', err=996)
      j = 1
      do i=1,20  
 	READ(iinp,end=50,err=996) TITLE(i)
       write(iout,27)
 27     format(' file is unformatted')
        nsets = i
	READ(iinp,end=50,err=999) swave(i),qang(i,1),
     1   qang(i,2),qang(i,3),qang(i,4)
 54     READ (iinp,end=50,err=55) junk1, ya(j), 
     1   YREF(J), time(j), xa(j)
        if(yref(j).eq.0.0.and.time(j).eq.0.0)goto 55
        j = j + 1
        go to 54
 55     backspace(1)
      enddo
*========================================================
* try to open as a formatted file
*========================================================
 996  close(unit=iinp)
      open(unit=iinp,file=filinp,status='old',form='formatted',
     1 err=997)
      j = 1
      do i=1,20  
 	READ(iinp,25,end=50,err=999) TITLE(i)
 25      format(a)
        write(iout,28)
 28     format(' file is formatted')
        write(iout,25)title(i)
        nsets = i
	READ(iinp,26,end=50,err=999) swave(i),qang(i,1),
     1   qang(i,2),qang(i,3),qang(i,4)
        write(iout,26)swave(i),qang(i,1),qang(i,2),qang(i,3),qang(i,4)
 154    READ (iinp,26,end=50,err=155) junk1, ya(j), 
     1   YREF(J), time(j), xa(j)
        if(yref(j).eq.0.0.and.time(j).eq.0.0)goto 155
        write(iout,26)junk1,ya(j),yref(j),time(j),xa(j)
        j = j + 1
        go to 154
 155    backspace(1)
      enddo
 26    format(f10.4,5x,f10.4,f15.4,f15.4,5x,f10.4)
*
 50   iran = 0
      do i=1,nsets
        if(i.eq.1)go to 60
        if(qang(i,1).eq.qang(i-1,1))go to 65
 60     knpts(i)=int((qang(i,2)-qang(i,1))/qang(i,3))+1
        write(iout,*)knpts(i)
        iran = iran + 1
        if(knpts(i).lt.700)then
         nnset(iran) = 1
        else
         nnset(iran) = knpts(i)/700
         ntest = nnset(iran) * 700
         if(ntest.ne.knpts(i))then
           nnset(iran) = nnset(iran) + 1
         endif
        endif
        rtitle(iran) = title(i)
        nrpts(iran) = knpts(i)
        rqang(iran,1) = qang(i,1)
        rqang(iran,2) = qang(i,2)
        rqang(iran,3) = qang(i,3)
 65   enddo
*
* check for only one range and if so assign common blocks
* and go to write
*
      IF(IRAN.EQ.1)then
        ians = 1
        GO TO 73
      endif
*      
* Check for strings of consecutive ranges and then
* cacatonate them
*
      j = 1
      do i=2,iran
        if(rqang(i-1,2).eq.rqang(i,1))then
          ncrpts(j) = nrpts(i-1) + nrpts(i)
          if(i.eq.2.or.cacat.eq.'no')then
            crqang(j,1) = rqang(i-1,1)
            crtitle(j) = rtitle(i-1)
          endif
          crqang(j,2) = crqang(j,1) + ncrpts(j)*rqang(i,3)        
        else
          j = j + 1
          cacat = 'no'
        endif
      enddo
      niran = j
      if(niran.eq.iran)go to 21
* cacatonate ranges
*
      write(6,2)niran
      do i=1,niran
        write(6,3)i,(crqang(i,j),j=1,2),crtitle(i)
      enddo
      write(6,4)
      read(6,*)ians
      bang(1) = crqang(ians,1)
      bang(2) = crqang(ians,2)
      bang(3) = crqang(ians,3)
*
      if(ians.eq.1)go to 101
      do i=1,ians-1
        irq = irq + ncrpts(i)
      enddo
 101  npts = nrpts(ians)
      wave(1,iele) = -swave(1)
      wave(2,iele) = 0.0
      wave(5,iele) = 0.0
      do i=1,ncrpts(ians)
        yrefn = yref(1+irq)/yref(i+irq)
        trefn = time(1+irq)/time(i+irq)
        yobs(i) = ya(i+irq)*trefn*yrefn
        xobs(i) = xa(i+irq)
      enddo
      go to 1000
* check for non consecutive ranges of data
* 
 21   write(6,2)iran
 2     format(i2,' ranges of data have been read')
      do i=1,iran
        write(6,3)i,(rqang(i,j),j=1,2),rtitle(i)
      enddo
 3    format(' range #',i3,' from ',f6.1,' to ',f6.1,
     1  ' titled: ',a10)
      write(6,4)
 4     format(' which range do you want? ')
      write(6,5)iran+1
 5     format(' if you wish ranges to be put together with
     1 simulated data'/ ' between ranges then enter a',i3,' ')
      read(6,*)ians
*
      if(ians.eq.iran+1)then
*       write(6,6)
* 6      format(' this option has not yet been implimented.'/
*     1   ' try again.')
*        go to 21
*      endif
*      go to 73
      bang(1) = rqang(1,1)
      bang(2) = rqang(iran,2)
      bang(3) = qang(1,3)
      npts = (bang(2)-bang(1))/bang(3) + 1
      irq = 0
      k = 0
      nirq(1) = 0
       do i = 1,iran
        do j = 1,nrpts(i)
         IF(i.eq.1)then
          yobs(j) = (ya(j)/yref(j))*yref(1)
          xobs(j) = xa(j)
          write(6,13)xobs(j),yobs(j)
         else
          yobs(j+irq+nirq(i-1)) = (ya(j+irq)/yref(j+irq))*yref(1)
          xobs(j+irq+nirq(i-1)) = xa(j+irq)
          write(6,13)xobs(j+irq+nirq(i-1)),yobs(j+irq+nirq(i-1))
         endif
        enddo
        if(i.eq.iran)go to 1000
        irq = irq + nrpts(i) 
        nirq(i) = (rqang(i+1,1)-rqang(i,2))/bang(3) - 1
        do k = 1,nirq(i)
C        call rand(x)
C
C the line above was replaced with the line below to correct calling of the 
C psuedo-random number generator in VAX Fortran.  9/20/90 ABM
C 
         x = ran(nseed)
         if(i.eq.1)then
          yobs(k+irq) = x*ya(nrpts(i))
          xobs(k+irq) = xa(nrpts(i)) + bang(3)*k
          write(6,13)xobs(k+irq),yobs(k+irq)
         else
          yobs(k+irq+nirq(i-1)) = x*ya(nrpts(i))
          xobs(k+irq+nirq(i-1)) = xa(nrpts(i)) + bang(3)*k
          write(6,13)xobs(k+irq+nirq(i-1)),yobs(k+irq+nirq(i-1))
         endif
        enddo
       enddo
      endif
 13   format(2f15.4)
*
 73   bang(1) = rqang(ians,1)
      bang(2) = rqang(ians,2)
      bang(3) = rqang(ians,3)
      irq = 0
      if(ians.eq.1)go to 74
      do i=1,ians-1
        irq = irq + nrpts(i)
      enddo
 74   npts = nrpts(ians)
      wave(1,iele) = -swave(1)
      wave(2,iele) = 0.0
      wave(5,iele) = 0.0
      do i=1,nrpts(ians)
        yrefn = yref(1+irq)/yref(i+irq)
        trefn = time(1+irq)/time(i+irq)
        yobs(i) = ya(i+irq)*trefn*yrefn
        xobs(i) = xa(i+irq)
      enddo
      go to 1000
 997  ierr = 2
      go to 1000
 999  ierr = 1
      CALL RRWS     ! S.Z. AUG-16-93
C      TYPE*,(YOBS(I),I=1,1000)
      go to 1000
 1000 close(unit=iinp)
      return
      end

