program CBDump

  logical :: ASCII = .false.
  character(len=160) :: Buf
  integer :: CBMASK
  data CBMASK / O'3000' / ! Column binary if rows 11-0 set
  integer :: CKMASK
  data CKMASK / O'0400' / ! Checksum if row 1 set
  integer :: CKSUM        ! to accumulate checksum
  integer :: Cols(80)
  logical :: Err
  logical :: Full = .false.  ! Dump everything, not just the errors.
  integer :: I, R, Seq, T
  logical :: Quiet = .false. ! Don't check or report Column Binary stuff

1 format ( a, :, i0, :, a, :, i0, :, a, :, i0 )

  i = 0
  do
    i = i + 1
    call getarg ( i, buf )
    if ( buf(1:3) == '-a ' ) then
      ascii = .true.
    else if ( buf(1:3) == '-f ' ) then
      full = .true.
    else if ( buf(1:3) == '-q ' ) then
      quiet = .true.
    else
      exit
    end if
  end do

  inquire ( iolength=i ) buf
  open ( 10, file=buf, access='direct', recl=i, status='old', &
        & form='unformatted' )

  r = 0
  seq = 0
  do
    r = r + 1
    seq = mod(seq + 1, 256)
    read ( 10, rec=r, iostat=i ) buf
    if ( i /= 0 ) exit    ! Probably EOF
    do i = 2, 160, 2      ! Little Endian
      cols(i/2) = ishft(256 * ichar(buf(i:i)) + ichar(buf(i-1:i-1)),-4)
    end do

    err = full

    if ( .not. quiet ) then

      ! Check whether column binary
      if ( iand(cols(1),cbmask) /= cbmask ) then
        print 1, 'Record ', r, ' is not column binary'
        err = .true.
      end if

      ! Check for checksum
      if ( iand(cols(1),ckmask) == ckmask ) then
        cksum = cols(2)
        do i = 3, 80
          cksum = ieor(cksum, cols(i))
        end do
        if ( cksum /= 0 ) then
          print 1, 'Record ', r, ' checksum does not check'
          err = .true.
        end if
      end if

      ! Check sequence number
      t = iand(cols(1),255)
      if ( t /= seq ) then
        print 1, 'Record ', r, ' out of sequence.  Expected ', seq, &
          & ', got ', t
        err = .true.
        seq = t
      end if

    end if ! .not. quiet

    if ( err ) then
      print '("Record ", i0,":")', r
      if ( ascii ) print '(16(2x,a,1x,a))', &
        & (achar(cols(i)/64+32),achar(mod(cols(i),64)+32), i = 1, 80 )
      print '((16o5.4))', cols
    end if

  end do

end program CBDump
