BinaryFileReader.f90

Go to the documentation of this file.

module binaryfilereadermodule
 
  use kindmodule, only: i4b, i8b, dp, lgp
  use errorutilmodule, only: pstop
  use inputoutputmodule, only: fseek_stream
 
  public :: binaryfileheadertype, binaryfilereadertype
 
  type :: binaryfileheadertype
    integer(I4B) :: pos, size
    integer(I4B) :: kper, kstp
    real(dp) :: pertim, totim
  contains
    procedure :: get_str
  end type binaryfileheadertype
 
  type, abstract :: binaryfilereadertype
    integer(I4B) :: inunit
    integer(I4B) :: nrecords
    logical(LGP) :: indexed
    logical(LGP) :: endoffile
    integer(I4B), allocatable :: record_sizes(:)
    class(binaryfileheadertype), allocatable :: header
    class(binaryfileheadertype), allocatable :: headernext
  contains
    procedure(read_header_if), deferred :: read_header
    procedure(read_record_if), deferred :: read_record
    procedure :: build_index
    procedure :: peek_record
    procedure :: rewind
  end type binaryfilereadertype
 
  abstract interface
    subroutine read_header_if(this, success, iout)
      import binaryfilereadertype
      import i4b, lgp
      class(binaryfilereadertype), intent(inout) :: this
      logical(LGP), intent(out) :: success
      integer(I4B), intent(in), optional :: iout
    end subroutine read_header_if
 
    subroutine read_record_if(this, success, iout)
      import binaryfilereadertype
      import i4b, lgp
      class(binaryfilereadertype), intent(inout) :: this
      logical(LGP), intent(out) :: success
      integer(I4B), intent(in), optional :: iout
    end subroutine read_record_if
  end interface
contains
 
  !> @brief Get a string representation of the header.
  function get_str(this) result(str)
    class(binaryfileheadertype), intent(in) :: this
    character(len=:), allocatable :: str
 
    write (str, '(*(G0))') &
      'Binary file header (pos: ', this%pos, &
      ', kper: ', this%kper, &
      ', kstp: ', this%kstp, &
      ', pertim: ', this%pertim, &
      ', totim: ', this%totim, &
      ')'
    str = trim(str)
  end function get_str
 
  !> @brief Build an index of data sizes in the file
  subroutine build_index(this)
    class(binaryfilereadertype), intent(inout) :: this
    ! local
    logical(LGP) :: success
    integer(I4B) :: pos, record_size
 
    this%indexed = .false.
    this%nrecords = 0
    call this%rewind()
    if (allocated(this%record_sizes)) deallocate (this%record_sizes)
 
    ! first pass: count
    do
      call this%read_record(success)
      if (.not. success) exit
      this%nrecords = this%nrecords + 1
    end do
    call this%rewind()
    allocate (this%record_sizes(this%nrecords))
    ! second pass: save
    do
      call this%read_record(success)
      inquire (this%inunit, pos=pos)
      record_size = pos - this%header%pos
      if (.not. success) exit
      this%record_sizes(this%nrecords) = this%header%size + record_size
    end do
    call this%rewind()
 
    this%indexed = .true.
  end subroutine build_index
 
  !> @brief Peek to see if another record is available.
  subroutine peek_record(this)
    class(binaryfilereadertype), intent(inout) :: this
    ! local
    integer(I4B) :: iostat
 
    if (.not. this%endoffile) then
      inquire (this%inunit, pos=this%headernext%pos)
      read (this%inunit, iostat=iostat) this%headernext%kstp, this%headernext%kper
      if (iostat == 0) then
        call fseek_stream(this%inunit, -2 * i4b, 1, iostat)
      else if (iostat < 0) then
        this%endoffile = .true.
        if (allocated(this%headernext)) deallocate (this%headernext)
      end if
    end if
  end subroutine peek_record
 
  !> @brief Rewind the file to the beginning.
  subroutine rewind (this)
    class(binaryfilereadertype), intent(inout) :: this
 
    rewind(this%inunit)
    if (allocated(this%header)) deallocate (this%header)
    if (allocated(this%headernext)) deallocate (this%headernext)
    allocate (binaryfileheadertype :: this%header)
    allocate (binaryfileheadertype :: this%headernext)
    this%header%pos = 1
    this%headernext%pos = 1
    this%endoffile = .false.
  end subroutine rewind
 
end module binaryfilereadermodule