! Convert_LF_Unf
!
! Program to convert Lahey Fortran unformatted sequential
! data files to the format used by DIGITAL Visual Fortran.
!
! Usage from command line:
!
!  cvtlf input-file [output-file]
!
!  input-file: File in Lahey format to be converted
!
!  output-file: Output file specification - if omitted,
!  input file is replaced with converted file
!
program Convert_LF_Unf
use dflib
implicit none

integer*2 StatusS, StatusD
character*($MAXPATH) SrcFile, DestFile
integer*4 i4
logical error, ConvertFromLF

! Read arguments, display usage information if there 
! is a problem
!
call getarg(1,SrcFile, StatusS)
call getarg(2,DestFile,StatusD)

if( StatusS < 0) then
  print *,'usage: cvtlf source [destination]'
else
  if( StatusD < 0 ) DestFile = '$$cvtlf.tmp'
	error = .not. ConvertFromLF( SrcFile, DestFile)

    ! If the destination was not specified, replace the source
    !
    if( .not. error .and. StatusD < 0 ) then
	  i4 = DelFilesQQ( SrcFile )
	  i4 = RenameFileQQ( DestFile, SrcFile )
      end if
    end if
end program

logical function ConvertFromLF( from, to)
implicit none
character*(*) from, to
character buff1
character*(65536) record
integer start, len, ios, i
integer elen, ntbytes, nrbytes, remaining

open( unit=1, file=from, access='sequential', blocksize=65536, &
      err=10, form='binary', mode='read', status='old' )
open( unit=2, file=to, access='sequential', blocksize=65536, &
      err=20, form='binary', mode='write', status='replace' )

! Check beginning-of-file indicator
!
read( 1, err=10 ) buff1
if( ichar(buff1) /= Z'FD' ) then
  print *,'ERROR: ',from(:len_trim(from)),&
		' is not a Lahey unformatted sequential file'
  ConvertFromLF = .false.
  return
  end if

! Read and convert records
!
do 
  read( 1,iostat=ios ) buff1; 
  if (ios > 0) goto 10
  if (ios < 0 ) exit		! EOF

  ! Read and decode the beginning of record length.
  ! The low two bits of the first byte indicate the
  ! number of bytes to follow (0-3).  The remaining
  ! 6 bits are the low-order bits of the length.
  ! Successive bytes are successive high-order bits
  ! of the length.
  !
  len = ichar(buff1)
  nrbytes = iand(len,3)
  len = ishft(len,-2)
  do i=1,nrbytes
    read (1,err=10) buff1
    len = ior(len,ishft(ichar(buff1),(i*8)-2))
	end do

  ! Write the record length in DVF format (a 32-bit
  ! integer)
  !
  write (2,err=20) len
  remaining = len

  ! Write the data in chunks up to size 65536
  !
  do while (remaining > 65536)
    read (1,err=10) record
	write (2,err=20) record
	remaining = remaining - 65536
	end do
  if (remaining > 0) then
	read (1,err=10) record(1:remaining)
	write (2,err=20) record(1:remaining)
	end if

  ! Write the end-of-record length in DVF format
  !
  write(2,err=20) len

  ! Read and verify the end record length
  ! The end record length includes the length
  ! of the beginning record length (but not vice
  ! versa!)  The number of bytes in the end record
  ! length never have extra zero bytes, but the
  ! beginning length might, so we have to compute
  ! the correct number here.

  ntbytes = 1 ! Number of terminator bytes
  if (len+nrbytes > Z'3E') ntbytes = ntbytes + 1
  if (len+nrbytes > Z'3FFE') ntbytes = ntbytes + 1
  if (len+nrbytes > Z'3FFFFE') ntbytes = ntbytes + 1
  read (1,err=10) record(1:ntbytes) ! Read end recl
  i = ichar(record(ntbytes:ntbytes))
  if (iand(i,3) /= ntbytes-1) goto 30 ! Sanity check
  elen = ishft(ichar(record(ntbytes:ntbytes)),-2)
  do i=1,ntbytes-1
    elen = ior(ishft(ichar(record(ntbytes-i:ntbytes-i)), &
	       (i*8)-2),elen)
	end do
  if (len+nrbytes+1 /= elen) goto 30 ! Sanity check
  end do

close( 1, err=10 )
close( 2, err=20 )
ConvertFromLF = .true.
return

10 print *,"ERROR: File open or read error on file '",from(:len_trim(from)),"'"
ConvertFromLF = .false.
return
20 print *,"ERROR: File open or write error on file '",to(:len_trim(to)),"'"
ConvertFromLF = .false.
return
30 print *,"ERROR: End of record doesn't verify on file '", &
  from(1:len_trim(from)),"'"
ConvertFromLF = .false.
return
end function ConvertFromLF