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