program classic_read
  use gbl_message
  use gkernel_interfaces
  use gkernel_types
  use classic_api, no_interface=>classic_entry_data_read
  !---------------------------------------------------------------------
  ! Read a Class file. 3 modes:
  !  1) index only
  !  2) same + entry descriptor (i.e. no header, no data)
  !  3) same + header only
  !  4) same + data (i.e. all the entry)
  !---------------------------------------------------------------------
  logical :: error
  type(classic_file_t) :: file
  integer(kind=4), parameter :: file_lun=50  ! Arbitrary value
  integer(kind=entry_length) :: ientry
  type(classic_recordbuf_t) :: rbufind,rbufobs
  integer(kind=4), allocatable :: bufind(:)  ! Buffer for byte-swapping one index
  integer(kind=4), allocatable :: bufsec(:)  ! Buffer for byte-swapping one section
  integer(kind=4), allocatable :: bufdat(:)  ! Buffer for byte-swapping one section
  integer(kind=8) :: ind_rstart
  integer(kind=4) :: ind_wstart
  integer(kind=data_length) :: ldata
  type(classic_entrydesc_t) :: edesc
  integer(kind=4) :: isec,arg_count,mode
  type(cputime_t) :: time
  character(len=8) :: cmode
  integer(kind=8) :: nwords,nrec,pirec,porec
  !
  error = .false.
  !
  ! Command line arguments
  arg_count = sic_get_arg_count()
  if (arg_count.lt.2) then
    call classic_read_usage
    stop 1
  endif
  !
  call sic_get_arg(1,file%spec)
  !
  call sic_get_arg(2,cmode)
  read(cmode,*) mode
  if (mode.lt.1 .or. mode.gt.4) then
    write(*,'(A)')  'Mode must be between 1 and 4'
    stop 2
  endif
  !
  ! Initialize the Classic library
  call classic_init(error)
  if (error)  stop 3
  file%lun = file_lun
  file%nspec = len_trim(file%spec)
  file%update = .false.
  call classic_file_open(file,.false.,error)
  if (error)  stop 4
  !
  call classic_filedesc_open(file,error)
  if (error)  stop 5
  !
  call reallocate_recordbuf(rbufind,file%desc%reclen,error)
  if (error)  stop 6
  call reallocate_recordbuf(rbufobs,file%desc%reclen,error)
  if (error)  stop 7
  call reallocate_buffer(bufind,int(file%desc%lind,kind=8),error)
  if (error)  stop 8
  !
  nwords = 0
  nrec = 0
  pirec = 0  ! Previous index record
  porec = 0  ! Previous observation record
  call gag_cputime_init(time)
  do ientry=1,file%desc%xnext-1  ! Read all entries
    !
    ! Read the Entry Index
    call classic_entryindex_read(file,ientry,bufind,rbufind,error)
    if (error)  stop 9
    nwords = nwords + file%desc%lind
    if (rbufind%rstart+rbufind%roff.ne.pirec) then
      nrec = nrec+1
      pirec = rbufind%rstart+rbufind%roff
    endif
    !
    if (mode.eq.1)  cycle
    !
    call classic_read_buf2ind(bufind,ind_rstart,ind_wstart,file%conv)
    if (error)  stop 10
    !
    ! Set the working buffer
    call classic_recordbuf_open(file,ind_rstart,ind_wstart,rbufobs,error)
    if (error)  stop 11
    ! Read the Entry Descriptor
    call classic_entrydesc_read(file,rbufobs,edesc,error)
    if (error)  stop 12
    !
    nwords = nwords + entrydescv2_nw1+entrydescv2_nw2*edesc%nsec
    if (rbufobs%rstart+rbufobs%roff.ne.porec) then
      nrec = nrec+rbufobs%roff+1
      porec = rbufobs%rstart+rbufobs%roff
    endif
    !
    if (mode.eq.2)  cycle
    !
    do isec=1,edesc%nsec
      !
      call reallocate_buffer(bufsec,edesc%secleng(isec),error)
      if (error)  stop 13
      call classic_entry_section_read(edesc%seciden(isec),edesc%secleng(isec),  &
        bufsec,edesc,rbufobs,error)
      if (error)  stop 14
      !
      nwords = nwords + edesc%secleng(isec)
      if (rbufobs%rstart+rbufobs%roff.ne.porec) then
        nrec = nrec + (rbufobs%rstart+rbufobs%roff) - porec
        porec = rbufobs%rstart+rbufobs%roff
      endif
    enddo
    !
    if (mode.eq.3)  cycle
    !
    ! Also read the data
    ldata = edesc%ldata
    call reallocate_buffer(bufdat,ldata,error)
    if (error)  stop 15
    call classic_entry_data_read(bufdat,ldata,edesc,rbufobs,error)
    if (error)  stop 16
    !
    nwords = nwords + edesc%ldata
    if (rbufobs%rstart+rbufobs%roff.ne.porec) then
      nrec = nrec + (rbufobs%rstart+rbufobs%roff) - porec
      porec = rbufobs%rstart+rbufobs%roff
    endif
    !
  enddo
  !
  call gag_cputime_get(time)
  write(*,'(A,3(1X,F8.3))')  'System, user, elapsed: ',  &
    time%diff%system,time%diff%user,time%diff%elapsed
  write(*,'(A,2(1X,F8.2))')  'Gross and net rates [MB/sec]: ',  &
    nrec*file%desc%reclen/1024.d0/256.d0/time%diff%elapsed,  &
    nwords/1024.d0/256.d0/time%diff%elapsed
  !
  ! Cleaning
  call deallocate_recordbuf(rbufind,error)
  if (error)  stop 17
  call deallocate_recordbuf(rbufobs,error)
  if (error)  stop 18
  if (allocated(bufind)) deallocate(bufind)
  if (allocated(bufsec)) deallocate(bufsec)
  if (allocated(bufdat)) deallocate(bufdat)
  !
  call classic_file_close(file,error)
  if (error)  stop 19
  !
contains
  subroutine classic_read_usage
    write(*,'(A)')  'Usage:'
    write(*,'(A)')  '  classic-read file mode'
    write(*,'(A)')  ''
    write(*,'(A)')  '  Read (part of) the contents of any kind of Classic file'
    write(*,'(A)')  '  and return statistics.'
    write(*,'(A)')  ''
    write(*,'(A)')  '  Mode can be:'
    write(*,'(A)')  '  1: read the index for all entries,'
    write(*,'(A)')  '  2: same as 1 + entry descriptors'
    write(*,'(A)')  '  3: same as 2 + entry headers'
    write(*,'(A)')  '  4: same as 3 + entry data'
    write(*,'(A)')  ''
  end subroutine classic_read_usage
  !
  subroutine classic_read_buf2ind(buf,rec,word,conv)
    use gildas_def
    use gkernel_interfaces
    use classic_api
    !---------------------------------------------------------------------
    ! Copy the Entry Index into the given buffer, swap bytes if needed
    !---------------------------------------------------------------------
    integer(kind=4),          intent(in)  :: buf(*)
    integer(kind=8),          intent(out) :: rec
    integer(kind=4),          intent(out) :: word
    type(classic_fileconv_t), intent(in)  :: conv
    ! Local
    integer(kind=4) :: addr4
    !
    if (file%desc%version.eq.1) then
      call conv%read%i4(buf(1),addr4,1)  !   1: record
      rec = addr4
      word = 1
    else
      call conv%read%i8(buf(1),rec, 1)  ! 1-2: record
      call conv%read%i4(buf(3),word,1)  !   3: word
    endif
  end subroutine classic_read_buf2ind
  !
  subroutine reallocate_buffer(buf,l,error)
    integer(kind=4), allocatable   :: buf(:)
    integer(kind=8), intent(in)    :: l
    logical,         intent(inout) :: error
    ! Local
    integer(kind=4) :: ier
    !
    if (allocated(buf)) then
      if (size(buf).ge.l) then
        return
      else
        deallocate(buf)
      endif
    endif
    allocate(buf(l),stat=ier)
    if (failed_allocate('DUMP','buffer',ier,error))  return
    !
  end subroutine reallocate_buffer
  !
end program classic_read
