!  Support file for any Entry Index (Class, Clic, ...). The Entry Index
! provides a short summary of a given observation.
!
subroutine classic_entryindex_read(file,entry_num,data,buf,error)
  use gkernel_interfaces
  use classic_interfaces, except_this=>classic_entryindex_read
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ public
  !  Read an entry in the given file, and return its Entry Index in the
  ! 'data(*)' buffer
  !---------------------------------------------------------------------
  type(classic_file_t),       intent(in)    :: file       !
  integer(kind=entry_length), intent(in)    :: entry_num  ! Entry number
  integer(kind=4),            intent(out)   :: data(*)    !
  type(classic_recordbuf_t),  intent(inout) :: buf        ! Working buffer
  logical,                    intent(inout) :: error      ! Logical errror flag
  ! Local
  integer(kind=data_length) :: lind
  !
  ! Read the record in 'buf'
  call entryindex_readrec(file,entry_num,buf,error)
  if (error)  return
  !
  ! Now fill the 'data' array. NB: recordbuf_read is optimized to avoid
  ! re-reading the buffer if it is already in the 'buf' buffer.
  lind = file%desc%lind
  call recordbuf_read(1_8,lind,data,buf,error)
  if (error)  return
  !
end subroutine classic_entryindex_read
!
subroutine entryindex_new(file,entry_num,full,error)
  use gbl_message
  use classic_interfaces, except_this=>entryindex_new
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  !   Allocate room (i.e. a new extension index), if needed, for the
  ! entry 'entry_num'.
  !---------------------------------------------------------------------
  type(classic_file_t),       intent(inout) :: file       !
  integer(kind=entry_length), intent(in)    :: entry_num  ! Entry number
  logical,                    intent(out)   :: full       ! Index is full?
  logical,                    intent(inout) :: error      ! Logical errror flag
  ! Local
  character(len=*), parameter :: rname='INDEX'
  !
  full = .false.
  if (file%lun.le.0) then
    call classic_message(seve%e,rname,'File not opened')
    error = .true.
    return
  endif
  !
  ! Do we need a new extension?
  if (entry_num.gt.file%desc%lexn(file%desc%nex)) then
    !
    ! Allocate one new Extension in file
    call filedesc_incr(file%lun,file%desc,full,error)
    if (error) return
    !
    ! Check again now that 'nex' has been increased
    if (entry_num.gt.file%desc%lexn(file%desc%nex)) then
      ! More than 1 new extension needed for 1 new entry!? Should never happen!
      call classic_message(seve%e,rname,  &
        'Internal logic error: more than 1 new extension needed for 1 new entry!')
      error = .true.
      return
    endif
  endif
  !
  if (file%desc%version.eq.1 .and. file%desc%nextword.ne.1) then
    ! V1 file: entries must always start at beginning of next available record
    call classic_message(seve%e,rname,  &
      'Internal error: V1 entries must start at beginning of records')
    error = .true.
    return
  endif
  !
end subroutine entryindex_new
!
subroutine classic_entryindex_write(file,entry_num,data,buf,error)
  use gbl_message
  use classic_interfaces, except_this=>classic_entryindex_write
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ public
  !   Write the given Entry Index ('data(*)' buffer) for the given entry
  ! in the given file. There must be room already provisioned for the
  ! entry in the Extension Index.
  !---------------------------------------------------------------------
  type(classic_file_t),       intent(in)    :: file       !
  integer(kind=entry_length), intent(in)    :: entry_num  ! Entry number
  integer(kind=4),            intent(in)    :: data(*)    !
  type(classic_recordbuf_t),  intent(inout) :: buf        ! Working buffer
  logical,                    intent(inout) :: error      ! Logical errror flag
  ! Local
  character(len=*), parameter :: rname='INDEX'
  character(len=message_length) :: mess
  integer(kind=data_length) :: lind
  !
  ! Safeguard: ensure that the programmer has allocated a new Extension
  ! Index for this entry (if needed)
  if (entry_num.gt.file%desc%lexn(file%desc%nex)) then
    write(mess,'(A,I0)')  &
      'Programming error: no room allocated for entry index #',entry_num
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! First read the record, which can contain other entry indexes
  call entryindex_readrec(file,entry_num,buf,error)
  if (error)  return
  !
  ! Now write the 'data' array. NB: recordbuf_write is optimized to avoid
  ! re-reading the buffer if it is already in the 'buf' buffer.
  lind = file%desc%lind
  call recordbuf_write(1_8,lind,data,buf,error)
  if (error)  return
  !
  ! Flush the buffer, always, because the whole file must be consistant
  ! in particular if file%desc%xnext has been updated in the file descriptor.
  call recordbuf_close(buf,error)
  if (error)  return
  !
end subroutine classic_entryindex_write
!
subroutine entryindex_readrec(file,entry_num,buf,error)
  use gildas_def
  use gbl_message
  use gkernel_interfaces
  use classic_interfaces, except_this=>entryindex_readrec
  use classic_params
  use classic_types
  !---------------------------------------------------------------------
  ! @ private
  !   Read the record where the entry index 'entry_num' starts. Return
  ! this record in the given buffer. This subroutine has 2 goals:
  !  - from 'entry_num' find in which extension the entry is, and in
  !    which record its index is found,
  !  - set up the 'buffer' type correctly i.e. description and buffer.
  !---------------------------------------------------------------------
  type(classic_file_t),       intent(in)    :: file       !
  integer(kind=entry_length), intent(in)    :: entry_num  !
  type(classic_recordbuf_t),  intent(inout) :: buf        !
  logical,                    intent(inout) :: error      !
  ! Local
  character(len=*), parameter :: rname='READ'
  integer(kind=8) :: ken,kb,kbl
  integer(kind=4) :: k
  integer(kind=size_length) :: nex,kex
  character(len=message_length) :: mess
  !
  if (file%lun.le.0) then
    call classic_message(seve%e,rname,'File not opened')
    error = .true.
    return
  endif
  if (entry_num.le.0 .or. entry_num.gt.file%desc%xnext) then
    write(mess,'(A,I0)') 'Wrong index address ',entry_num
    call classic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Find kex (the extension where the entry goes).
  if (file%desc%gex.eq.10) then
    ! Linear growth (historical). For efficiency purpose, do not use
    ! the generic code
    kex = (entry_num-1)/file%desc%lex1 + 1
  else
    ! Generic for any extension growth (including gex==10)
    nex = file%desc%nex+1  ! lexn(:) numbering starts at 0!
    call gi8_dicho(nex,file%desc%lexn,entry_num,.true.,kex,error)
    if (error)  return
    kex = kex-1  ! lexn(:) numbering starts at 0!
  endif
  !
  ! Find ken (relative entry number in the extension, starts from 1)
  ken = entry_num - file%desc%lexn(kex-1)
  !
  kb = ((ken-1)*file%desc%lind)/file%desc%reclen  ! In the extension, the
      ! relative record position (as an offset, starts from 0) where the
      ! Entry Index starts. NB: there can be a non-integer number of Entry
      ! Indexes per record
  kbl = file%desc%aex(kex)+kb  ! The absolute record number where the Entry Index goes
  !
  k = mod((ken-1)*file%desc%lind,file%desc%reclen)+1  ! = in the record, the
    ! first word of the Entry Index of the entry number 'entry_num'
  !
  ! Declare the buffer to be used for this index. NB: classic_recordbuf_open
  ! is optimized so that it does not re-read the needed record if it is
  ! already in memory
  call classic_recordbuf_open(file,kbl,k,buf,error)
  if (error)  return
  if (k+file%desc%lind-1.gt.file%desc%reclen) then
    ! This entry index overlaps 2 records. Ensure that recordbuf_read won't
    ! complain.
    buf%nrec = 2
  else
    ! Usually the entry index uses a part of a single record
    buf%nrec = 1
  endif
  !
end subroutine entryindex_readrec
!
subroutine indexaddr_frombuf_v1(data,ind,conv,error)
  use gildas_def
  use gkernel_interfaces
  use classic_types
  use classic_interfaces, except_this=>indexaddr_frombuf_v1
  !---------------------------------------------------------------------
  ! @ private
  !  Read the Index previously loaded in buf%data, position k
  !  This routine is generic and do not know the details about the
  ! Index, so it reads only the first element: in File Version 1 it
  ! must be the Entry Address coded as an Integer*4 (returned in addr8)
  !---------------------------------------------------------------------
  integer(kind=4),          intent(in)    :: data(*)  !
  type(indx_basic_v2_t),    intent(out)   :: ind      !
  type(classic_fileconv_t), intent(in)    :: conv     !
  logical,                  intent(inout) :: error    !
  ! Local
  integer(kind=4) :: addr4
#if !defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  integer(kind=address_length) :: adi4
  integer(kind=1) :: membyt(8)
  !
  adi4 = bytpnt(conv%read%i4,membyt)
#endif
  !
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call conv%read%i4(data(1),addr4,1)
#else
  call convert_buf(membyt(adi4),data(1),addr4,1)
#endif
  !
  ! V1 to V2
  ind%rec = addr4
  ind%word = 1
  !
end subroutine indexaddr_frombuf_v1
!
subroutine indexaddr_frombuf_v2(data,ind,conv,error)
  use gildas_def
  use gkernel_interfaces
  use classic_types
  use classic_interfaces, except_this=>indexaddr_frombuf_v2
  !---------------------------------------------------------------------
  ! @ private
  !  Read the Index previously loaded in buf%data, position k
  !  This routine is generic and do not know the details about the
  ! Index, so it reads only the 2 first elements: in File Version 2 it
  ! must be the Entry Address (record and word)
  !---------------------------------------------------------------------
  integer(kind=4),          intent(in)    :: data(*)  !
  type(indx_basic_v2_t),    intent(out)   :: ind      !
  type(classic_fileconv_t), intent(in)    :: conv     !
  logical,                  intent(inout) :: error    !
  ! Local
#if !defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  integer(kind=address_length) :: adi4,adi8
  integer(kind=1) :: membyt(8)
  !
  adi4 = bytpnt(conv%read%i4,membyt)
  adi8 = bytpnt(conv%read%i8,membyt)
#endif
  !
#if defined(FORTRAN2003_PP) /* Fortran 2003 Procedure Pointers */
  call conv%read%i8(data(1),ind%rec,1)
  call conv%read%i4(data(3),ind%word,1)
#else
  call convert_buf(membyt(adi8),data(1),ind%rec,1)
  call convert_buf(membyt(adi4),data(3),ind%word,1)
#endif
  !
end subroutine indexaddr_frombuf_v2
