module bin_io
!
!  Byte-wise reading and writing data to binary files. This module reserves
!  the Fortran file-units MinUnit .. MaxUnit for this purpose.
!
!  Version 0.8a, August 99, only for incomplete f90 compilers (else use v1.0)
!
!  Written by Jos Bergervoet
!

implicit none     !  Only for the full F90 compiler: check all declarations!

public  :: open_for_read, open_for_write, close_block_io,  &
           integer_block_read, integer_block_write,  &
           char_block_write, char_read
private :: init_file_block

integer, private, parameter     :: MinUnit = 90, MaxUnit = 99, RecLen = 1

type, public :: FileHandle   ! Can be used outside this module (is public)
  private                    ! fields accessible only in this module
  integer                       :: FilePos
end type FileHandle

type(FileHandle), private, dimension(MinUnit:MaxUnit), save  :: Info

contains

subroutine init_file_block(Funit)
  integer, intent(in)           :: Funit

  if (Funit<MinUnit .or. Funit>MaxUnit) then
    write(unit=*,fmt=*) "Error: binary file-unit",Funit, "out of range."
    stop
  end if
  Info(Funit) % FilePos = 0
  return
end subroutine init_file_block

subroutine open_for_read(Funit, Fname)
  integer, intent(in)           :: Funit
  character(len=*), intent(in)  :: Fname

  call init_file_block(Funit)
  open (unit=Funit, file=Fname, form="unformatted", access="direct", &
        recl=RecLen, status="old", action="read")
  return
end subroutine open_for_read

subroutine open_for_write(Funit, Fname)
  integer, intent(in)           :: Funit
  character(len=*), intent(in)  :: Fname

  call init_file_block(Funit)
  open (unit=Funit, file=Fname, form="unformatted", access="direct", &
        recl=RecLen, status="replace", action="write")
  return
end subroutine open_for_write

subroutine close_block_io(Funit)
  integer, intent(in)           :: Funit
  close(unit=Funit)
  return
end subroutine close_block_io

subroutine char_block_write(Funit, s)
  integer, intent(in)           :: Funit
  character(len=*), intent(in)  :: s
  integer                       :: fp, i

  fp = Info(Funit) % FilePos
  do i=1,len(s)
    write(unit=Funit,rec=fp+i) s(i:i)
  end do
  Info(Funit) % FilePos = fp + len(s)
  return
end subroutine char_block_write

subroutine char_read(Funit, c, ReadErr)
  integer, intent(in)            :: Funit
  character(len=*), intent(out)  :: c        ! only c(1:1) will be written
  integer, intent(out), optional :: ReadErr
  integer                        :: fp, ErrCod

  fp = Info(Funit) % FilePos
  read(unit=Funit,rec=fp+1,iostat=ErrCod) c(1:1)
  if (present(ReadErr)) then
    ReadErr = ErrCod
  end if
  Info(Funit) % FilePos = fp+1 
  return
end subroutine char_read

subroutine integer_block_read(Funit, iread, length)
  integer, intent(in)           :: Funit, length
  integer, intent(out)          :: iread
  integer                       :: i
  character(len=1)              :: c

  iread = 0
  do i=1,length
    call char_read(Funit, c)
    iread = iread + ichar(c)*256**(i-1)
  end do
  return
end subroutine integer_block_read

subroutine integer_block_write(Funit, iwrite, length)
  integer, intent(in)           :: Funit, length, iwrite
  integer                       :: i
  character(len=length)         :: c

  do i=1,length
    c(i:i) = char(modulo( iwrite/256**(i-1), 256))
  end do
  call char_block_write(Funit, c)
  return
end subroutine integer_block_write

end module bin_io