program deblock

! Deblock the 10-cards-per-block FSU 1401 utility tape.

  character(800) :: Block
  character(132) :: File
  character(132) :: Line
  character(132) :: OutDir ! Output directory; file names are numbers

  integer :: F, File1, Filen  ! First and last files to do.  File1 > 1.
  integer :: I, J, N, Stat

  call getarg ( 1, line )   ! get input file name
  open ( 10, trim(line), form='formatted' )
  call getarg ( 2, outdir ) ! Get directory for output files

  print *, 'Enter first and last file numbers: '
  read *, file1, filen
  file1 = max(file1,2)

  do ! find files
    read ( 10, '(a)', end=9 ) line
    if ( line(1:4) /= 'File' ) cycle
    read ( line(6:8), * ) f
    if ( f < file1 ) cycle
    if ( f > filen ) exit

    ! Found a file

    file = trim(outDir) // adjustl(trim(line(6:)))
    open ( 11, file=trim(file), form='formatted' )

    n = 0 ! Number in BLOCK
    do
      read ( 10, '(a)', end=1, iostat=stat ) line
      do i = 1, 132
        if ( line(i:i) == '^' ) line(i:i) = ''
      end do
      if ( line(1:4) == 'File' ) exit
      i = index(line,':')
      if ( i == 0 ) cycle
      i = index(line,'Record')
      if ( i /= 0 ) then
        read ( line(i+6:), * ) j
        if ( j == 1 ) then
          print '(a85,5x,a)', line(8:92), trim(file)
          cycle
        end if
      end if
      read ( line(1:5), * ) j
      if ( j == 1 ) then
        if ( n /= 0 ) write ( 11, '(a80)' ) (block(i:i+79), i = 1, n, 80)
        n = 0
      end if
      if ( j > 800 ) then
        print *, "Record too long -- you probably didn't mean to dump file ", f
        exit
      end if
      block(j:j+99) = line(8:107)
      n = j + 99
    end do
1   continue
    if ( n /= 0 ) write ( 11, '(a80)' ) (block(i:i+79), i = 1, n, 80)
    if ( stat /= 0 ) exit
    backspace ( 10 )
  end do
9 continue

end program deblock
