	program vuscor
c Viking vus correction
c **11-Mar-04**
	character nv*4
	byte in(450,25),inc(11250)
	integer*2 in2(225,25),last2
	logical err
	parameter (last2='d35'x,last4='2c3e0d35'x)
	equivalence (in(1,1),inc(1)),(in(1,1),in2(1,1))
c
	open(3,file='../logs/vuscor.log')
	do n=101,1049
	 write(nv,'(i4)') n
	 if (nv(1:1).eq.' ') nv(1:1)='0'
	 open(1,file='../vuss/vus.'//nv,access='direct',form='unformatted'
&	 ,recl=11250,status='old',err=59)
	 nr=1
	 err=.false.
10	 read(1,rec=nr,end=49) in
	 do k=1,25
	  if (in2(54,k).ne.last2) then
	   if (in2(1,k).ne.'909'x.and.in2(1,k).ne.'ffff'x) then
	    lhdr=in2(53,k)
	    lhdr=or(lshift(lhdr,16),in2(54,k))
	    is=0
20	    khdr=xor(lhdr,last4)
	    if (khdr.ne.0) then
	     ne=0
	     do i=1,32
	      if (khdr.lt.0) ne=ne+1
	      if (ne.gt.3) go to 25
	      khdr=lshift(khdr,1)
	      end do
	     go to 29
25	     is=is+1
	     if (is.lt.108) then
	      khdr=in(105-is,k)
	      lhdr=or(lshift(khdr,24),rshift(lhdr,8))
	      go to 20
	      end if
	     is=109
	     end if
29	    if (is.gt.0) then
	     if (.not.err) then
	      call system('cp ../vuss/vus.'//nv//' ../vussc/vus.'//nv)
	      open(2,file='../vussc/vus.'//nv,access='direct'
&	      ,form='unformatted',recl=11250,status='old')
	      err=.true.
	      end if
	     do i=11250,450*k-449,-1
	      io=i-is
	      if (io.gt.0) then
	       inc(i)=inc(io)
	      else
	       inc(i)=0
	       end if
	      end do
	     it=is
	     do j=103,1,-6
	      if (in(j,k).gt.3) then
	       if (j.gt.1) then
	        do i=1,j-1
	         in(i,k)=in(i+1,k)
	         end do
	        end if
	       in(j,k)=0
	       it=it-1
	       if (it.eq.0) go to 30
	       end if
	      end do
30	     write(3,'(a4,2i3,2i4)') nv,nr,k,is,it
	     end if
	    end if
	   end if
	  end do
	 if (err) write(2,rec=nr) inc
39	 nr=nr+1
	 go to 10
49	 close(1)
	 if (err) close(2)
59	 end do
	stop
	end
