program classic_demo_read
  use classic_api
  implicit none
  !---------------------------------------------------------------------
  !  Demonstration program which reads a Classic file version 2, with a
  ! few entries, and 1 Entry Index, 1 section, and 1 data array per
  ! entry. The input file 'foo.bin' should have created first with the
  ! writing demonstration program.
  !
  !  * Entry Index:
  !     - Entry starting record  (I*8)
  !     - Entry starting word    (I*4)
  !     - Dummy 'foo' value      (I*4)
  !  * Section:
  !     - One R*4 value
  !     - One R*8 value
  !     - One I*4 value
  !     - One I*8 value
  !     - One C*8 value
  !  * Data:
  !     - Array of 10 R*4 values
  !---------------------------------------------------------------------
  type(classic_recordbuf_t) :: rbufind,rbufobs
  integer(kind=entry_length) :: ientry
  logical :: error
  ! File
  type(classic_file_t) :: file
  integer(kind=4), parameter :: file_lun=50  ! Arbitrary value
  character(len=*), parameter :: file_name='foo.bin'
  logical, parameter :: file_readwrite=.false.  ! Open the file read-only
  ! File Descriptor
  integer(kind=4), parameter :: fdesc_kind=classic_kind_demo
  ! Entry Index
  integer(kind=4), parameter :: ind_version=123  ! Index version (arbitrary value)
  integer(kind=4), parameter :: ind_length=4  ! 1 I*8, 2 I*4
  integer(kind=8) :: ind_rstart
  integer(kind=4) :: ind_wstart
  integer(kind=4) :: ind_foo
  integer(kind=4) :: bufind(ind_length)  ! Buffer for byte-swapping one index
  ! Entry Descriptor
  type(classic_entrydesc_t) :: edesc
  integer(kind=4), parameter :: edesc_version=456  ! Observation version (arbitrary value)
  ! Section
  integer(kind=4), parameter :: sec_id=789  ! Identifier (arbitrary value)
  integer(kind=data_length), parameter :: sec_length_max=8  ! Max section length
  integer(kind=data_length) :: sec_length                   ! Actual section length
  real(kind=4) :: sec_r4
  real(kind=8) :: sec_r8
  integer(kind=4) :: sec_i4
  integer(kind=8) :: sec_i8
  character(len=8) :: sec_c8
  integer(kind=4) :: bufsec(sec_length_max)  ! Buffer for byte-swapping one section
  ! Data
  integer(kind=data_length), parameter :: dat_length_max=10  ! Max data length
  integer(kind=data_length) :: dat_length                    ! Actual data length
  real(kind=4) :: data(dat_length_max)
  real(kind=4) :: bufdat(dat_length_max)  ! Buffer for byte-swapping one data block
  !
  write(*,'(A)')  '--- Welcome to the Classic demonstration reading program ---'
  !
  error = .false.
  !
  ! Initialize the Classic library
  call classic_init(error)
  if (error)  stop
  !
  file%lun = file_lun
  file%spec = file_name
  file%nspec = len_trim(file%spec)
  file%update = .false.
  call classic_file_open(file,file_readwrite,error)
  if (error)  stop
  !
  call classic_filedesc_open(file,error)
  if (error)  stop
  write(*,*) ''
  write(*,'(A)')  'File Descriptor:'
  call classic_filedesc_dump(file%desc,'r')
  !
  if (file%desc%kind.ne.fdesc_kind) then
    write(*,*) 'Error: unexpected file kind'
    stop
  elseif (file%desc%vind.ne.ind_version) then
    write(*,*) 'Error: unsupported index version'
    stop
  endif
  !
  call reallocate_recordbuf(rbufind,file%desc%reclen,error)
  if (error)  stop
  call reallocate_recordbuf(rbufobs,file%desc%reclen,error)
  if (error)  stop
  !
  do ientry=1,file%desc%xnext-1  ! Read all entries
    write(*,*) ''
    write(*,'(A,I0)') 'Reading entry #',ientry
    !
    ! Read the Entry Index
    call classic_entryindex_read(file,ientry,bufind,rbufind,error)
    if (error)  stop
    ! Entry Index can be anything => byte swapping is application specific
    call classic_demo_buf2ind(bufind,ind_rstart,ind_wstart,ind_foo,file%conv)
    if (error)  stop
    write(*,'(A,I0,1X,I0,1X,I0)')  &
      '  INDEX: ',ind_rstart,ind_wstart,ind_foo
    !
    ! Set the working buffer
    call classic_recordbuf_open(file,ind_rstart,ind_wstart,rbufobs,error)
    if (error)  stop
    !
    ! Read the Entry Descriptor
    call classic_entrydesc_read(file,rbufobs,edesc,error)
    if (error)  stop
    write(*,'(A,I0,1X,I0,1X,I0,1X,I0)')  &
      '  DESCRIPTOR: ',edesc%nsec,edesc%nword,edesc%adata,edesc%ldata
    if (edesc%version.ne.edesc_version) then
      write(*,*) 'Error: unsupported observation version'
      stop
    endif
    !
    ! Read section by identifier
    sec_length = sec_length_max  ! Updated in return
    call classic_entry_section_read(sec_id,sec_length,bufsec,edesc,rbufobs,  &
      error)
    if (error)  stop
    ! Section can be anything => byte swapping is application specific
    call classic_demo_buf2sec(bufsec,sec_r4,sec_r8,sec_i4,sec_i8,sec_c8,  &
      file%conv)
    write(*,'(A,F0.2,1X,F0.4,1X,I0,1X,I0,1X,A)')   &
      '  SECTION: ',sec_r4,sec_r8,sec_i4,sec_i8,sec_c8
    !
    ! Data
    dat_length = dat_length_max  ! Updated in return
    call classic_entry_data_read(bufdat,dat_length,edesc,rbufobs,error)
    if (error)  stop
    call classic_demo_buf2dat(int(dat_length,kind=4),bufdat,data,file%conv)
    write(*,'(A,I0,A,10(1X,F0.2))')  &
      '  DATA (',dat_length,' values): ',data(1:dat_length)
    !
  enddo
  !
  call classic_file_close(file,error)
  if (error)  stop
  !
  call deallocate_recordbuf(rbufobs,error)
  if (error)  stop
  call deallocate_recordbuf(rbufind,error)
  if (error)  stop
  !
  write(*,*) ''
  write(*,'(A,A,A)') 'File ',trim(file%spec),' successfully read'
  !
contains
  !
  subroutine classic_demo_buf2ind(buf,rec,word,foo,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
    integer(kind=4),          intent(out) :: foo
    type(classic_fileconv_t), intent(in)  :: conv
    !
    call conv%read%i8(buf(1),rec, 1)  ! 1-2: record
    call conv%read%i4(buf(3),word,1)  !   3: word
    call conv%read%i4(buf(4),foo, 1)  !   4: foo
    !
  end subroutine classic_demo_buf2ind
  !
  subroutine classic_demo_buf2sec(buf,r4,r8,i4,i8,c8,conv)
    use gildas_def
    use gkernel_interfaces
    use classic_api
    !---------------------------------------------------------------------
    ! Copy the section values into the given buffer, swap bytes if needed
    !---------------------------------------------------------------------
    integer(kind=4),          intent(in)  :: buf(*)
    real(kind=4),             intent(out) :: r4
    real(kind=8),             intent(out) :: r8
    integer(kind=4),          intent(out) :: i4
    integer(kind=8),          intent(out) :: i8
    character(len=*),         intent(out) :: c8
    type(classic_fileconv_t), intent(in)  :: conv
    !
    call conv%read%r4(buf(1),r4,1)  !   1: R*4
    call conv%read%r8(buf(2),r8,1)  ! 2-3: R*8
    call conv%read%i4(buf(4),i4,1)  !   4: I*4
    call conv%read%i8(buf(5),i8,1)  ! 5-6: I*8
    call conv%read%cc(buf(7),c8,2)  ! 7-8: C*8
    !
  end subroutine classic_demo_buf2sec
  !
  subroutine classic_demo_buf2dat(ldata,buf,data,conv)
    use gildas_def
    use gkernel_interfaces
    use classic_api
    !---------------------------------------------------------------------
    ! Copy the Data array into the given buffer, swap bytes if needed
    !---------------------------------------------------------------------
    integer(kind=4),          intent(in)  :: ldata
    real(kind=4),             intent(in)  :: buf(ldata)
    real(kind=4),             intent(out) :: data(ldata)
    type(classic_fileconv_t), intent(in)  :: conv
    !
    call conv%read%r4(buf,data,ldata)
    !
  end subroutine classic_demo_buf2dat
  !
end program classic_demo_read
