!  Support file for Class index. The Index provides a short summary of a
! given observation.
!
subroutine index_frombuf_v1(data,indl,conv,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use classcore_interfaces, except_this=>index_frombuf_v1
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Transfer the data(*) buffer from V1 to the last version of the
  ! index
  !---------------------------------------------------------------------
  integer(kind=4),          intent(in)    :: data(*)  !
  type(indx_t),             intent(out)   :: indl     !
  type(classic_fileconv_t), intent(in)    :: conv     !
  logical,                  intent(inout) :: error    !
  ! Local
  type(indx_v1_t) :: ind1
  !
  ! Read in the indx sequence of length 'lenbi' integers
  if (conv%code.eq.0) then
    ! Native, copy the whole block (NB: might be a problem with the strings)
    call r4tor4(data(1),ind1%bloc,lind_v1)
  else
    ! Non native, conversion needed
    call conv%read%i4(data(1), ind1%bloc,   3)
    call conv%read%cc(data(4), ind1%csour,  3)
    call conv%read%cc(data(7), ind1%cline,  3)
    call conv%read%cc(data(10),ind1%ctele,  3)
    call conv%read%i4(data(13),ind1%dobs,   2)
    call conv%read%r4(data(15),ind1%off1,   2)
    call conv%read%i4(data(17),ind1%type,   4)
    call conv%read%r4(data(21),ind1%posa,   1)
    call conv%read%i4(data(22),ind1%subscan,1)
  endif
  !
  if (ind1%scan.eq.0) ind1%scan = ind1%num
  !
  ! Upper case conversion
  call sic_upper(ind1%csour)
  call sic_upper(ind1%cline)
  call sic_upper(ind1%ctele)
  !
  call index_v1tovl(ind1,indl,error)
  !
end subroutine index_frombuf_v1
!
subroutine index_v1tovl(ind1,indl,error)
  use classcore_interfaces, except_this=>index_v1tovl
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Transform the index V1 into an index last version
  !---------------------------------------------------------------------
  type(indx_v1_t), intent(in)    :: ind1   !
  type(indx_t),    intent(out)   :: indl   !
  logical,         intent(inout) :: error  !
  !
  indl%bloc    = ind1%bloc  ! Record number where observation starts
  indl%word    = 1          ! In this record, the word where the observation starts
  indl%num     = ind1%num
  indl%ver     = ind1%ver
  indl%csour   = ind1%csour
  indl%cline   = ind1%cline
  indl%ctele   = ind1%ctele
  indl%dobs    = ind1%dobs
  indl%dred    = ind1%dred
  indl%off1    = ind1%off1
  indl%off2    = ind1%off2
  indl%type    = ind1%type
  indl%kind    = ind1%kind
  indl%qual    = ind1%qual
  indl%scan    = ind1%scan
  indl%posa    = ind1%posa
  indl%subscan = ind1%subscan
  indl%ut      = ut_null
  !
end subroutine index_v1tovl
!
subroutine index_frombuf_v2orv3(data,isv3,indl,conv,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use classcore_interfaces, except_this=>index_frombuf_v2orv3
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Transfer the data(*) buffer from V2 or V3 to the last version of
  ! the index
  !---------------------------------------------------------------------
  integer(kind=4),          intent(in)    :: data(*)  !
  logical,                  intent(in)    :: isv3     !
  type(indx_t),             intent(out)   :: indl     !
  type(classic_fileconv_t), intent(in)    :: conv     !
  logical,                  intent(inout) :: error    !
  ! Local
  !
  ! Read in the indx. Since the index in memory is not correctly
  ! aligned (memory padding, no SEQUENCE), we MUST read the elements
  ! one by one.
  call conv%read%i8(data(1), indl%bloc,   1)  ! bloc
  call conv%read%i4(data(3), indl%word,   1)  ! word
  call conv%read%i8(data(4), indl%num,    1)  ! num
  call conv%read%i4(data(6), indl%ver,    1)  ! ver
  call conv%read%cc(data(7), indl%csour,  3)  ! csour
  call conv%read%cc(data(10),indl%cline,  3)  ! cline
  call conv%read%cc(data(13),indl%ctele,  3)  ! ctele
  call conv%read%i4(data(16),indl%dobs,   1)  ! dobs
  call conv%read%i4(data(17),indl%dred,   1)  ! dred
  call conv%read%r4(data(18),indl%off1,   1)  ! off1
  call conv%read%r4(data(19),indl%off2,   1)  ! off2
  call conv%read%i4(data(20),indl%type,   1)  ! type
  call conv%read%i4(data(21),indl%kind,   1)  ! kind
  call conv%read%i4(data(22),indl%qual,   1)  ! qual
  call conv%read%r4(data(23),indl%posa,   1)  ! posa
  call conv%read%i8(data(24),indl%scan,   1)  ! scan
  call conv%read%i4(data(26),indl%subscan,1)  ! subscan
  if (isv3) then
    call conv%read%r8(data(27),indl%ut,   1)  ! ut
  else
    indl%ut = ut_null
  endif
  !
  if (indl%scan.eq.0) indl%scan = indl%num
  !
  ! Upper case conversion
  call sic_upper(indl%csour)
  call sic_upper(indl%cline)
  call sic_upper(indl%ctele)
  !
end subroutine index_frombuf_v2orv3
!
subroutine index_tobuf_v1(indl,data,conv,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use classcore_interfaces, except_this=>index_tobuf_v1
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Transfer last version of the index to the data(*) buffer V1
  !---------------------------------------------------------------------
  type(indx_t),             intent(in)    :: indl     !
  integer(kind=4),          intent(out)   :: data(*)  !
  type(classic_fileconv_t), intent(in)    :: conv     !
  logical,                  intent(inout) :: error    !
  ! Local
  type(indx_v1_t) :: ind1
  !
  call index_vltov1(indl,ind1,error)
  !
  if (conv%code.eq.0) then
    ! Native, copy the whole block (NB: might be a problem with the strings)
    call r4tor4(ind1%bloc,data(1),lind_v1)
  else
    ! Non native, conversion needed
    call conv%writ%i4(ind1%bloc,   data(1), 3)
    call conv%writ%cc(ind1%csour,  data(4), 3)
    call conv%writ%cc(ind1%cline,  data(7), 3)
    call conv%writ%cc(ind1%ctele,  data(10),3)
    call conv%writ%i4(ind1%dobs,   data(13),2)
    call conv%writ%r4(ind1%off1,   data(15),2)
    call conv%writ%i4(ind1%type,   data(17),4)
    call conv%writ%r4(ind1%posa,   data(21),1)
    call conv%writ%i4(ind1%subscan,data(22),1)
  endif
  !
end subroutine index_tobuf_v1
!
subroutine index_vltov1(indl,ind1,error)
  use gbl_message
  use classcore_interfaces, except_this=>index_vltov1
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Transform the index last version into an index V1
  !---------------------------------------------------------------------
  type(indx_t),    intent(in)    :: indl   !
  type(indx_v1_t), intent(out)   :: ind1   !
  logical,         intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='INDEX'
  !
  call i8toi4_fini(indl%bloc,ind1%bloc,1,error)
  if (error)  return
  if (indl%word.ne.1) then
    call class_message(seve%e,rname,  &
      'Internal error: Observation must start at the beginning of record for V1 file')
    error = .true.
    return
  endif
  call i8toi4_fini(indl%num,ind1%num,1,error)
  if (error)  return
  ind1%ver     = indl%ver
  ind1%csour   = indl%csour
  ind1%cline   = indl%cline
  ind1%ctele   = indl%ctele
  ind1%dobs    = indl%dobs
  ind1%dred    = indl%dred
  ind1%off1    = indl%off1
  ind1%off2    = indl%off2
  ind1%type    = indl%type
  ind1%kind    = indl%kind
  ind1%qual    = indl%qual
  call i8toi4_fini(indl%scan,ind1%scan,1,error)
  if (error)  return
  ind1%posa    = indl%posa
  ind1%subscan = indl%subscan
  !            = indl%ut  ! Not available in V1
  !
end subroutine index_vltov1
!
subroutine index_tobuf_v2orv3(indl,isv3,data,conv,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use classcore_interfaces, except_this=>index_tobuf_v2orv3
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Transfer last version of the index to the data(*) buffer V2 or V3
  !---------------------------------------------------------------------
  type(indx_t),             intent(in)    :: indl     !
  logical,                  intent(in)    :: isv3     !
  integer(kind=4),          intent(out)   :: data(*)  !
  type(classic_fileconv_t), intent(in)    :: conv     !
  logical,                  intent(inout) :: error    !
  ! Local
  !
  ! Write in the indx. Since the index in memory is not correctly
  ! aligned (memory padding, no SEQUENCE), we MUST write the elements
  ! one by one.
  call conv%writ%i8(indl%bloc,   data(1), 1)  ! bloc
  call conv%writ%i4(indl%word,   data(3), 1)  ! word
  call conv%writ%i8(indl%num,    data(4), 1)  ! num
  call conv%writ%i4(indl%ver,    data(6), 1)  ! ver
  call conv%writ%cc(indl%csour,  data(7), 3)  ! csour
  call conv%writ%cc(indl%cline,  data(10),3)  ! cline
  call conv%writ%cc(indl%ctele,  data(13),3)  ! ctele
  call conv%writ%i4(indl%dobs,   data(16),1)  ! dobs
  call conv%writ%i4(indl%dred,   data(17),1)  ! dred
  call conv%writ%r4(indl%off1,   data(18),1)  ! off1
  call conv%writ%r4(indl%off2,   data(19),1)  ! off2
  call conv%writ%i4(indl%type,   data(20),1)  ! type
  call conv%writ%i4(indl%kind,   data(21),1)  ! kind
  call conv%writ%i4(indl%qual,   data(22),1)  ! qual
  call conv%writ%r4(indl%posa,   data(23),1)  ! posa
  call conv%writ%i8(indl%scan,   data(24),1)  ! scan
  call conv%writ%i4(indl%subscan,data(26),1)  ! subscan
  if (isv3) then
    call conv%writ%r8(indl%ut,   data(27),1)  ! ut
  endif
  !
end subroutine index_tobuf_v2orv3
!
subroutine index_fromobs(head,ind,error)
  use gbl_constant
  use classcore_interfaces, except_this=>index_fromobs
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Set the output Index from the input Observation Header
  !---------------------------------------------------------------------
  type(header), intent(in)    :: head   ! Observation header
  type(indx_t), intent(out)   :: ind    ! Computed Index
  logical,      intent(inout) :: error  !
  !
  ind%num     = head%gen%num
  ind%ver     = head%gen%ver
  if (head%gen%kind.eq.kind_sky) then
    ind%csour = 'SKYDIP'
    ind%cline = head%sky%line
  else
    ind%csour = head%pos%sourc
    ind%cline = head%spe%line
  endif
  ind%ctele   = head%gen%teles
  ind%dobs    = head%gen%dobs
  ind%dred    = head%gen%dred
  ind%off1    = head%pos%lamof
  ind%off2    = head%pos%betof
  ind%type    = head%pos%system
  ind%kind    = head%gen%kind
  ind%qual    = head%gen%qual
  ind%scan    = head%gen%scan
  ind%posa    = head%dri%apos
  ind%subscan = head%gen%subscan
  ind%ut      = head%gen%ut
  !
end subroutine index_fromobs
!
subroutine index_toobs(ind,head,error)
  use gbl_constant
  use classcore_interfaces, except_this=>index_toobs
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Copy the Index to the in/out Observation Header
  !---------------------------------------------------------------------
  type(indx_t), intent(in)    :: ind    ! Computed Index
  type(header), intent(inout) :: head   ! Observation header
  logical,      intent(inout) :: error  !
  !
  head%gen%num     = ind%num
  head%gen%ver     = ind%ver
  head%pos%sourc   = ind%csour
  if (head%gen%kind.eq.kind_sky) then
    head%sky%line = ind%cline
  else
    head%spe%line = ind%cline
  endif
  head%gen%teles   = ind%ctele
  head%gen%dobs    = ind%dobs
  call gag_todate(ind%dobs,head%gen%cdobs,error)
  head%gen%dred    = ind%dred
  call gag_todate(ind%dred,head%gen%cdred,error)
  head%pos%lamof   = ind%off1
  head%pos%betof   = ind%off2
  head%pos%system  = ind%type
  head%gen%kind    = ind%kind
  head%gen%qual    = ind%qual
  head%gen%scan    = ind%scan
  head%dri%apos    = ind%posa
  head%gen%subscan = ind%subscan
  head%gen%ut      = ind%ut
  !
end subroutine index_toobs
!
subroutine index_tooptimize(ind,iind,long,iopt,optx,error)
  use classic_api
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !   Copy the input Index to the input 'optimize' object (collection
  ! of all the Indexes of the Observations in the file). The code
  ! assumes that the arrays are correctly allocated (enough space).
  ! This is done with reallocate_optimize.
  !  'long' index: all arrays are allocated
  !  'short' index: only ind(:), bloc(:), num(:), ver(:)
  !---------------------------------------------------------------------
  type(indx_t),               intent(in)    :: ind    ! Index
  integer(kind=entry_length), intent(in)    :: iind   ! Index number
  logical,                    intent(in)    :: long   ! Long index?
  integer(kind=entry_length), intent(in)    :: iopt   ! Position in optimized index
  type(optimize),             intent(inout) :: optx   ! Optimized index of file
  logical,                    intent(inout) :: error  !
  !
  optx%ind(iopt)     = iind
  optx%bloc(iopt)    = ind%bloc
  optx%word(iopt)    = ind%word
  optx%num(iopt)     = ind%num
  optx%ver(iopt)     = ind%ver
  optx%dobs(iopt)    = ind%dobs
  optx%ut(iopt)      = ind%ut
  optx%ctele(iopt)   = ind%ctele
  optx%scan(iopt)    = ind%scan
  optx%subscan(iopt) = ind%subscan
  !
  if (long) then
    optx%csour(iopt)   = ind%csour
    optx%cline(iopt)   = ind%cline
    !                  = ind%dred ?
    optx%off1(iopt)    = ind%off1
    optx%off2(iopt)    = ind%off2
    !                  = ind%type?
    optx%kind(iopt)    = ind%kind
    optx%qual(iopt)    = ind%qual
    !                  = ind%posa?
    !
  else
    ! optx%sort%number(iopt) = ???
    ! optx%sort%entry(iopt) = ???
  endif
  !
end subroutine index_tooptimize
!
subroutine index_fromoptimize(optx,i,ind,error)
  use classic_api
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !   Fill the given Index from the input 'optimize' object
  ! (collection of Indexes)
  !---------------------------------------------------------------------
  type(optimize),             intent(in)    :: optx   ! Optimized index of file
  integer(kind=entry_length), intent(in)    :: i      ! Index number
  type(indx_t),               intent(out)   :: ind    ! Current spectrum index
  logical,                    intent(inout) :: error  !
  !
  ind%bloc    = optx%bloc(i)
  ind%word    = optx%word(i)
  ind%num     = optx%num(i)
  ind%ver     = optx%ver(i)
  ind%csour   = optx%csour(i)
  ind%cline   = optx%cline(i)
  ind%ctele   = optx%ctele(i)
  ind%dobs    = optx%dobs(i)
  ! ind%dred  = ?
  ind%off1    = optx%off1(i)
  ind%off2    = optx%off2(i)
  ! ind%type  = ?
  ind%kind    = optx%kind(i)
  ind%qual    = optx%qual(i)
  ind%scan    = optx%scan(i)
  ! ind%posa  = ?
  ind%subscan = optx%subscan(i)
  ind%ut      = optx%ut(i)
  !
end subroutine index_fromoptimize
!
subroutine optimize_tooptimize(in,i,ou,o,long,error)
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Copy 1 element of optimize'd index IN into OU
  !---------------------------------------------------------------------
  type(optimize),             intent(in)    :: in     ! Input index
  integer(kind=entry_length), intent(in)    :: i      ! Element to be copied
  type(optimize),             intent(inout) :: ou     ! Output index
  integer(kind=entry_length), intent(in)    :: o      ! Destination
  logical,                    intent(in)    :: long   ! Long index?
  logical,                    intent(inout) :: error  ! Logical error flag
  !
  ou%ind(o)     = in%ind(i)
  ou%bloc(o)    = in%bloc(i)
  ou%word(o)    = in%word(i)
  ou%num(o)     = in%num(i)
  ou%ver(o)     = in%ver(i)
  ou%ut(o)      = in%ut(i)
  ou%ctele(o)   = in%ctele(i)
  ou%scan(o)    = in%scan(i)
  ou%subscan(o) = in%subscan(i)
  !
  if (long) then
    ou%csour(o)   = in%csour(i)
    ou%cline(o)   = in%cline(i)
    ou%dobs(o)    = in%dobs(i)
    ou%off1(o)    = in%off1(i)
    ou%off2(o)    = in%off2(i)
    ou%kind(o)    = in%kind(i)
    ou%qual(o)    = in%qual(i)
  else
    ! ou%number(o) = ???
    ! ou%entry(o) = ???
  endif
  !
end subroutine optimize_tooptimize
!
subroutine rix_to_ix(entry_num,error)
  use classic_api
  use classcore_interfaces, except_this=>rix_to_ix
  use class_index
  !---------------------------------------------------------------------
  ! @ private
  !  Read the Entry Index for given entry in FILE IN, and store it into
  ! IX. Assume IX has already been (re)allocated to a sufficient size!
  !---------------------------------------------------------------------
  integer(kind=entry_length), intent(in)    :: entry_num  !
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  type(indx_t) :: ind
  !
  call rix(entry_num,ind,error)
  if (error)  return
  !
  call index_tooptimize(ind,entry_num,.true.,entry_num,ix,error)
  if (error)  return
  !
end subroutine rix_to_ix
!
subroutine rox_to_ox(entry_num,error)
  use classic_api
  use classcore_interfaces, except_this=>rox_to_ox
  use class_index
  !---------------------------------------------------------------------
  ! @ private
  !  Read the Entry Index for given entry in FILE OUT, and store it into
  ! OX. Assume OX has already been (re)allocated to a sufficient size!
  !---------------------------------------------------------------------
  integer(kind=entry_length), intent(in)    :: entry_num  !
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  type(indx_t) :: ind
  !
  call rox(entry_num,ind,error)
  if (error)  return
  !
  call index_tooptimize(ind,entry_num,.false.,entry_num,ox,error)
  if (error)  return
  !
end subroutine rox_to_ox
!
subroutine ix_update(error)
  use gbl_message
  use gbl_format
  use gbl_constant
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>ix_update
  use class_common
  use class_index
  !---------------------------------------------------------------------
  ! @ private
  ! Check if input file has new entries, and save them in IX if yes
  !---------------------------------------------------------------------
  logical, intent(out) :: error  ! Error status
  ! Local
  character(len=*), parameter :: rname='UDPATE'
  integer(kind=entry_length) :: i
  !
  if (filein_isvlm) then
    call class_message(seve%w,rname,  &
      'Index update is not relevant for FILE IN VLM. Ignored.')
    return
  endif
  !
  ! Re-read the File Descriptor and check if file has new observations.
  call classic_file_fflush(filein,error)  ! Flush for reading
  if (error) then  ! e.g. file has disappearead
    call class_message(seve%e,rname,'Read error file '//filein%spec)
    return
  endif
  call classic_filedesc_read(filein,error)
  if (error) then
    call class_message(seve%e,rname,'Read error file '//filein%spec)
    return
  endif
  !
  if (ix%next.ge.filein%desc%xnext)  return  ! Nothing new
  !
  ! Resize The Input File Index to the new size
  call reallocate_optimize(ix,filein%desc%xnext-1,.true.,.true.,error)
  if (error)  return
  !
  ! Nullify the Entry Index buffer: it may contain a record which has
  ! been updated on disk. This forces re-reading.
  call classic_recordbuf_nullify(ibufbi)
  !
  ! Nullify the Observation buffer: in V2 files, there can be several
  ! (pieces of) observations sharing the same record. This forces
  ! re-reading from disk when GET will be done later.
  call classic_recordbuf_nullify(ibufobs)
  !
  ! And finally store the new entries
  do i=ix%next,filein%desc%xnext-1
    call rix_to_ix(i,error)  ! Append the IX% structure
    if (error)  return
    ix%next = ix%next+1
  enddo
  !
end subroutine ix_update
