	program vuscstr
c put vus data in continuous bit strings
c **27-Feb-04**
c input from vus.* in ../vuss
c output to vusc.* in ../vuscs
c out(1-18) = SEISF header
c out(19) = vus file record and block numbers, 2-bytes each
c out(20-83) = 2048-bit data string
	character nv*4
	byte in(6,75,25),din(3,150,25)
	integer out(83)
	integer*2 nrb(2)
	equivalence (in(1,1,1),din(1,1,1)),(out(19),nrb(1))
c
	write(*,"('vus range: '$)")
	read(*,*) ns,nl
	do n=ns,nl
	 write(nv,'(i4)') n
	 if (nv(1:1).eq.' ') nv(1:1)='0'
	 write(*,*) nv
	 open(1,file='../vuss/vus.'//nv,access='direct',form='unformatted'
&	 ,recl=11250,status='old',err=39)
	 open(2,file='../vuscs/vusc.'//nv,access='direct',form='unformatted'
&	 ,recl=332)
	 nr=1
	 mr=0
10	 read(1,rec=nr,end=39) in
	 do k=1,25
	  if (in(1,1,k).eq.9.and.in(2,1,k).eq.9.and.in(3,1,k).eq.9) go to 29
c decode 576-bit (72-byte) header
	  do j=1,18
	   if (in(1,j,k).gt.3) write(201,*) 'A',n,nr,k,j,in(1,j,k)
	   kh=0
	   do i=1,6
	    if (in(i,j,k).gt.63) write(201,*) 'B',n,nr,k,j,i,in(i,j,k)
	    kh=kh*64+in(i,j,k)
	    end do
	   out(j)=kh
	   end do
	  nrb(1)=nr
	  nrb(2)=k
c decode 2048-bit (256-byte) data
	  if (din(1,150,k).gt.3) write(201,*) 'C',n,nr,k,din(1,150,k)
	  ip=83
	  nd=0
	  kd=0
	  do j=37,150
	   ks=0
	   do i=1,3
	    ks=ks*64+din(i,j,k)
	    end do
	   kd=or(lshift(ks,nd),kd)
	   nd=nd+18
	   if (nd.ge.32) then
	    out(ip)=kd
	    if (ip.eq.20) go to 19
	    ip=ip-1
	    nd=nd-32
	    kd=rshift(ks,18-nd)
	    end if
	   end do
19	  mr=mr+1
	  write(2,rec=mr) out
	  end do
29	 nr=nr+1
	 go to 10
39	 end do
	stop
	end

