	program vusdecode
c decode vus data
c **28-Feb-04**
c input vusc.* in ../vuscs
c output vusd.* in ../vusds, 400-bytes/block
c out(1-18) = 72-byte (576-bit) header from SEISF file
c out(19) = vus file record and block numbers, 2-bytes each
c out(20) = GCSC (24 bits)
c out(21) = command status (22 bits)
c out(22) = change code
c out(23) = source ID (for mode change within buffer only)
c out(24) = vusc start bit number and number of data bytes, 2-bytes each
c out(25-101) = data
c normal and high-data-rate modes: 1 byte/sample, x, y, z, x, y, z, ...
c event mode: 2 bytes/sample, x amplitude, x axis crossings, y amplitude, etc.
	character nva*4
	integer out
	integer*2 sbn(2)
	byte bout(308)
	equivalence (out(24),sbn(1)),(out(25),bout(1))
	common in(83),out(101),k,ip,kr,kd,jp,mr
c
	write(*,"('vusc range: '$)")
	read(*,*) nvs,nvl
	do nv=nvs,nvl
	 write(*,*) nv
	 write(nva,'(i4)') nv
	 if (nva(1:1).eq.' ') nva(1:1)='0'
	 open(1,file='../vuscs/vusc.'//nva,access='direct',form='unformatted'
&	 ,recl=332,status='old',err=89)
	 open(2,file='../vusds/vusd.'//nva,access='direct',form='unformatted'
&	 ,recl=404)
	 open(3,file='../logs/vusdlog.'//nva)
	 nr=0
	 mr=0
10	 nr=nr+1
	 read(1,rec=nr,end=79) in
c 72-byte header and vusc record and block numbers
	 do k=1,19
	  out(k)=in(k)
	  end do
c gcsc, command status and change code
	 k=83
	 ip=0
	 kr=in(k)
	 call get(23,.true.)
	 out(20)=lshift(and(kd,'7fffff'x),1)
	 call get(22,.true.)
	 out(21)=and(kd,'3fffff'x)
	 call get(8,.true.)
	 out(22)=and(kd,'ff'x)
	 out(23)=0
	 sbn(1)=1
c decode data
20	 jp=1
	 if (and(out(21),2).eq.0) then
c normal or high-data-rate mode
30	  call get(15,.false.)
	  if (and(kd,'7fff'x).eq.'5370'x) go to 60
	  call get(8,.true.)
	  bout(jp)=and(kd,'ff'x)
	  jp=jp+1
	  if (k.gt.20.or.(k.eq.20.and.ip.le.24)) go to 30
	  go to 50
	 else
c event mode
40      call get(15,.false.)
	  if (and(kd,'7fff'x).eq.'5370'x) go to 60
	  call get(8,.true.)
	  bout(jp)=and(kd,'ff'x)
	  call get(5,.true.)
	  bout(jp+1)=and(kd,'1f'x)
	  jp=jp+2
	  if (k.gt.20.or.(k.eq.20.and.ip.le.19)) go to 40
	  end if
50     call output
	 go to 10
c mode change
60	 call output
	 sbn(1)=(83-k)*32+ip+1
	 call get(15,.true.)
	 out(22)=and(kd,'7fff'x)
	 call get(5,.true.)
	 out(23)=and(kd,'1f'x)
	 call get(24,.true.)
	 out(20)=and(kd,'ffffff'x)
	 call get(22,.true.)
	 out(21)=and(kd,'3fffff'x)
	 go to 20
79	 do l=1,3
	  close(l)
	  end do
89	 end do
	stop
	end
	     
	subroutine get(n,pa)
c geta a n-byte data from data buffer; advance pinter if pa is true
	integer out
	logical pa
	common in(83),out(101),k,ip,kr,kd
c
	nr=32-ip
	if (nr.ge.n) then
	 kd=kr
	else
	 kd=or(lshift(in(k-1),nr),and(kr,2**nr-1))
	 end if
	if (pa) then
	 ip=ip+n
	 if (ip.lt.32) then
	  kr=rshift(kr,n)
	 else
	  k=k-1
	  kr=in(k)
	  ip=ip-32
	  if (ip.gt.0) kr=rshift(kr,ip)
	  end if
	 end if
	return
	end

	subroutine output
c output routine
	byte bout(404)
	integer out
	integer*2 hdr(38),sbn(2)
	equivalence (out(1),hdr(1)),(out(24),sbn(1))
	common in(83),out(101),k,ip,kr,kd,jp,mr
c
	sbn(2)=jp-1
	do j=jp,404
	 bout(j)=0
	 end do
	mr=mr+1
	write(2,rec=mr) out
	write(3,1) mr,hdr(9),hdr(6),hdr(37),hdr(38),sbn(1),(out(i),i=20,23),sbn(2)
1	format(i4,z3,z4,i4,i3,i5,i9,z7,z5,z3,i4)
	return
	end


