module class_sort_types
  use gmath_dicho_types
  use class_types
  !---------------------------------------------------------------------
  !
  !---------------------------------------------------------------------
  !
  ! Type for sorting an index by date, time, and telescope
  type, extends(gi8_dicho_t) :: class_sort_dtt_t
    type(optimize), pointer :: optx
    integer(kind=8) :: searched_entry = 0
  contains
    procedure, public :: compare       => class_sort_compare_dtt
    procedure, public :: compare_value => class_sort_compare_dtt_value
  end type class_sort_dtt_t
  !
contains
  !
  function class_sort_compare_dtt(self,m,l)
    !-------------------------------------------------------------------
    ! Compare first by DOBS, then by UT, then by TELES
    !-------------------------------------------------------------------
    integer(kind=4) :: class_sort_compare_dtt
    class(class_sort_dtt_t), intent(in) :: self
    integer(kind=8),         intent(in) :: m,l
    if (self%optx%dobs(m).ne.self%optx%dobs(l)) then
      if (self%optx%dobs(m).gt.self%optx%dobs(l)) then
        class_sort_compare_dtt = 1
      else
        class_sort_compare_dtt = -1
      endif
      return
    endif
    if (self%optx%ut(m).ne.self%optx%ut(l)) then
      if (self%optx%ut(m).gt.self%optx%ut(l)) then
        class_sort_compare_dtt = 1
      else
        class_sort_compare_dtt = -1
      endif
      return
    endif
    if (self%optx%ctele(m).eq.self%optx%ctele(l)) then
      class_sort_compare_dtt = 0
    elseif (lgt(self%optx%ctele(m),self%optx%ctele(l))) then
      class_sort_compare_dtt = 1
    else
      class_sort_compare_dtt = -1
    endif
  end function class_sort_compare_dtt
  !
  function class_sort_compare_dtt_value(self,m)
    !-------------------------------------------------------------------
    ! Compare the m-th entry to the searched entry
    !-------------------------------------------------------------------
    integer(kind=4) :: class_sort_compare_dtt_value
    class(class_sort_dtt_t), intent(in) :: self
    integer(kind=8),         intent(in) :: m
    class_sort_compare_dtt_value = self%compare(m,self%searched_entry)
  end function class_sort_compare_dtt_value
end module class_sort_types
!
subroutine fix(set,idx,lx,nfound,error,erange,more)
  use phys_const
  use gbl_message
  use gkernel_types
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>fix
  use class_index
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !   Search in the input index for entries matching the parameters in
  ! flg% and smin%/smax%. Selected entries are appended to the output
  ! index (it is the responsibility of the caller to check for
  ! duplicates between old and new entries).
  !---------------------------------------------------------------------
  type(class_setup_t),        intent(in)           :: set        !
  type(optimize),             intent(in)           :: idx        ! The index to search in
  type(optimize),             intent(inout)        :: lx         ! The optimize'd index to be updated
  integer(kind=entry_length), intent(out)          :: nfound     ! Number of observations actually found
  logical,                    intent(inout)        :: error      ! Error status
  integer(kind=entry_length), intent(in), optional :: erange(2)  ! Entry range to search in (default all)
  integer(kind=entry_length), intent(in), optional :: more       ! Size of allocation extension
  ! Local
  character(len=*), parameter :: rname='FIX'
  logical :: lire
  integer(kind=4) :: tver
  integer(kind=entry_length) :: iobs,inew,jnew,k,ient,extend
  real(kind=4) :: r,any
  type(observation) :: obs
  logical :: readsec(-mx_sec:0)  ! Which section are to be read
  logical :: readobs,readhead,found
  type(indx_t) :: ind
  type(time_t) :: time
  !
  ! Set the range of entries to search in
  if (present(erange)) then
    inew = erange(1)
    jnew = erange(2)
  else
    inew = 1
    jnew = idx%next-1
  endif
  !
  if (jnew.lt.inew) then
    ! Input index is empty (or erange has null size): nothing can be found.
    ! lx%next unmodified (caller could be working in append mode)
    nfound = 0
    return
  endif
  !
  ! Set the size of allocation extension.
  if (present(more)) then
    ! Caller thinks he knows how many entries will be found here
    extend = more
  else
    ! Default is to enlarge lx so that is can store all the range of
    ! entries
    extend = jnew-inew+1
  endif
  ! Enlarge lx size so that it can append all the found entries
  call reallocate_optimize(lx,lx%next-1+extend,.true.,.true.,error)
  if (error) return
  !
  call chtoby('ANY ',any,4)
  !
  k = 0
  lire = flg%dobs.or.flg%dred.or.flg%posa
! lire = flg%line.or.flg%sourc.or.flg%teles.or.flg%dobs.or.flg%dred   &
!    .or.flg%off1.or.flg%off2.or.flg%scan.or.flg%subscan.or.flg%posa
  !
  ! readhead: need to read the entry descriptor and header
  readhead = flg%freq .or. flg%user .or. flg%dopos .or.  &
             flg%doswitch .or. flg%dodri .or. flg%dodir
  ! readobs: need to read the entry descriptor
  readobs  = flg%sect .or. readhead
  if (readobs) then
    call init_obs(obs)
    if (readhead) then
      readsec(:) = .false.  ! Read none...
      readsec(class_sec_spe_id)  = flg%freq                  ! except spectroscopic section
      readsec(class_sec_pos_id)  = flg%dopos                 ! and position section
      readsec(class_sec_swi_id)  = flg%doswitch              ! and switching section
      readsec(class_sec_dri_id)  = flg%dodri .or. flg%dodir  ! and drift section
      readsec(class_sec_user_id) = flg%user                  ! and user section (if any)
    endif
  endif
  !
  ! Loop on entries
  call gtime_init(time,jnew-inew+1,error)
  if (error)  return
  do iobs = inew,jnew
     ient = idx%ind(iobs)
     if (sic_ctrlc()) then
       call class_message(seve%w,rname,'Aborted by ^C, index may be incomplete')
       exit
     endif
     if (lire .or. readobs) then
        ! In these cases the informations are not in the input index in memory
        ! * lire = information is the input index on disk (was not saved in
        !          memory),
        ! * readobs = information is in the entry descriptor or in the entry on
        !             disk.
        ! This takes much more time, let's give feedback.
        call gtime_current(time)
     endif
     !
     ! General search in memory
     call index_fromoptimize(idx,iobs,ind,error)
     if (error)  return
     !
     if (flg%kind) then
       if (ind%kind.ne.smin%kind) cycle
     endif
     if (ind%qual.gt.smin%qual) cycle
     if (flg%last) then
        if (ind%ver.lt.0) cycle
     endif
     if (flg%num) then
        if (ind%num.lt.smin%num .or. ind%num.gt.smax%num) cycle
     endif
     if (flg%ver) then
        tver = abs(ind%ver)
        if (tver.lt.smin%ver .or. tver.gt.smax%ver) cycle
     endif
     if (flg%sourc) then
        if (flg%isourc.ge.1) then  ! There is a '*' in the source name
           if (.not.match_string(ind%csour,smin%csour)) cycle
        else
           if (ind%csour.ne.smin%csour) cycle
        endif
     endif
     if (flg%line) then
        if (flg%iline.ge.1) then  ! There is a '*' in the line name
           if (.not.match_string(ind%cline,smin%cline)) cycle
        else
           if (ind%cline.ne.smin%cline) cycle
        endif
     endif
     if (flg%teles) then
        if (flg%iteles.ge.1) then  ! There is a '*' in the telescope name
           if (.not.match_string(ind%ctele,smin%ctele)) cycle
        else
           if (ind%ctele.ne.smin%ctele) cycle
        endif
     endif
     if (flg%off1) then
        if (ind%off1.lt.smin%off1 .and. smin%off1.ne.any) cycle
        if (ind%off1.gt.smax%off1 .and. smax%off1.ne.any) cycle
     endif
     if (flg%off2) then
        if (ind%off2.lt.smin%off2 .and. smin%off2.ne.any) cycle
        if (ind%off2.gt.smax%off2 .and. smax%off2.ne.any) cycle
     endif
     if (flg%scan) then
        if (ind%scan.lt.smin%scan .or. ind%scan.gt.smax%scan) cycle
     endif
     if (flg%subscan) then
        if (ind%subscan.lt.smin%subscan .or. ind%subscan.gt.smax%subscan) cycle
     endif
     if (flg%dobs) then
        if (ind%dobs.lt.smin%dobs .or. ind%dobs.gt.smax%dobs) cycle
     endif
     if (flg%domask) then
        if (.not.fix_by_mask(ind%off1,ind%off2,flg%mask))  cycle
     endif
     ! The next tests need to read more data in the observation header
     if (readobs) then
        call robs(obs,ient,error)
        if (error)  return
        if (readhead) then
          call rheader_sub(set,obs,readsec,error)
          if (error)  return
        endif
     endif
     if (flg%sect) then
       if (.not.obs%head%presec(flg%sectval))  cycle
     endif
     if (flg%freq) then
        if (.not.fix_by_freq(obs,flg%freqmin,flg%freqmax,flg%freqsig)) cycle
     endif
     if (flg%doswitch) then
        if (.not.fix_by_switch(obs,flg%switch)) cycle
     endif
     if (flg%dodri) then
        if (.not.fix_by_drift(obs,flg%driang,pis)) cycle
     endif
     if (flg%dodir) then
        if (.not.fix_by_drift(obs,flg%dirang,2.*pis)) cycle
     endif
     if (flg%dopos) then
        if (.not.fix_by_posi(obs,flg%poslam,flg%posbet,flg%possys,flg%posequ,set%tole)) cycle
     endif
     if (flg%user) then
        call user_sec_fix(obs,found,error)
        if (error)  return
        if (.not.found)  cycle
     endif
     !
     ! More restrictive search
     if (lire) then
        call rix(ient,ind,error)
        if (error) return
        if (flg%dred) then
           if (ind%dred.lt.smin%dred .or. ind%dred.gt.smax%dred) cycle
        endif
        if (flg%posa) then
           r = mod(ind%posa,pis)
           if (r.lt.smin%posa .or. r.gt.smax%posa) cycle
        endif
     endif
     k = k+1
     !
     ! Update the input index
     if (lx%next.gt.lx%mobs) then
        call class_message(seve%e,rname,'Current Index is full')
        error = .true.
        return
     endif
     call index_tooptimize(ind,ient,.true.,lx%next,lx,error)
     if (error)  return
     lx%next = lx%next + 1
  enddo
  !
  nfound = k
  !
  ! Reset search flags
  flg%last = .true.
  flg%num = .false.
  flg%ver = .false.
  flg%line = .false.
  flg%sourc = .false.
  flg%teles = .false.
  flg%dobs = .false.
  flg%dred = .false.
  flg%off1 = .false.
  flg%off2 = .false.
  flg%freq = .false.
  flg%dopos = .false.
  flg%sect = .false.
  flg%domask = .false.
  flg%doswitch = .false.
  !
end subroutine fix
!
function fix_by_freq(obs,fmin,fmax,fsig)
  use classcore_interfaces, except_this=>fix_by_freq
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! CLASS internal routine
  !  Return .true. if the input range intersects the frequency range
  ! of the input observation.
  !---------------------------------------------------------------------
  logical                       :: fix_by_freq  ! Function value on return
  type(observation), intent(in) :: obs          ! Input observation
  real(kind=8),      intent(in) :: fmin         ! Frequency range (min)
  real(kind=8),      intent(in) :: fmax         ! Frequency range (max)
  logical,           intent(in) :: fsig         ! Signal or image frequencies?
  ! Local
  real(kind=8) :: freqmin,freqmax
  !
  if (fsig) then
    ! Signal frequencies
    if (obs%head%spe%fres.gt.0.d0) then
      ! Left side of spectrum:
      call abscissa_sigabs_left(obs%head,freqmin)
      ! Right side of spectrum
      call abscissa_sigabs_right(obs%head,freqmax)
    else
      call abscissa_sigabs_right(obs%head,freqmin)
      call abscissa_sigabs_left(obs%head,freqmax)
    endif
  else
    ! Image frequencies
    if (obs%head%spe%fres.gt.0.d0) then
      call abscissa_imaabs_right(obs%head,freqmin)
      call abscissa_imaabs_left(obs%head,freqmax)
    else
      call abscissa_imaabs_left(obs%head,freqmin)
      call abscissa_imaabs_right(obs%head,freqmax)
    endif
  endif
  !
  if (fmax.lt.0.d0) then
    ! Select from fmin to infinite
    fix_by_freq = freqmax.ge.fmin
  elseif (fmin.lt.0.d0) then
    ! Select from 0 to fmax
    fix_by_freq = freqmin.le.fmax
  else
    ! Select from fmin to fmax (which may be equal)
    fix_by_freq = freqmin.le.fmax .and. freqmax.ge.fmin
  endif
  !
end function fix_by_freq
!
function fix_by_switch(obs,swmode)
  use classcore_interfaces, except_this=>fix_by_switch
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Return .true. if the observation matches the given switching mode
  !---------------------------------------------------------------------
  logical                       :: fix_by_switch ! Function value on return
  type(observation), intent(in) :: obs           ! Input observation
  integer(kind=4),   intent(in) :: swmode        ! Switching mode code
  !
  if (obs%head%presec(class_sec_swi_id)) then
    fix_by_switch = obs%head%swi%swmod.eq.swmode
  else
    fix_by_switch = swmode.eq.mod_unk
  endif
end function fix_by_switch
!
function fix_by_drift(obs,driang,modu)
  use phys_const
  use classcore_interfaces, except_this=>fix_by_drift
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Return .true. if the drift matches the required angle modulo some
  ! angle
  !---------------------------------------------------------------------
  logical                       :: fix_by_drift  ! Function value on return
  type(observation), intent(in) :: obs           ! Input observation
  real(kind=4),      intent(in) :: driang        ! [rad] Drift angle
  real(kind=4),      intent(in) :: modu          ! [rad] Modulo angle
  !
  real(kind=4) :: thisang
  real(kind=4), parameter :: tolerance=1.0*rad_per_min  ! [rad] 1 minute tolerance
  !
  if (obs%head%presec(class_sec_dri_id)) then
    thisang = obs%head%dri%apos
    ! Set angle in range [0,modu[
    do while (thisang.lt.0.)  ! Strictly lower than
      thisang = thisang+modu
    enddo
    do while (thisang.ge.modu)  ! Greater or equal to
      thisang = thisang-modu
    enddo
    fix_by_drift = abs(thisang-driang).le.tolerance
  else
    fix_by_drift = .false.
  endif
end function fix_by_drift
!
function fix_by_posi(obs,reflam,refbet,refsys,refequ,tole)
  use gbl_message
  use gkernel_types
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>fix_by_posi
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! CLASS internal routine
  !  Return .true. if the observation position matches the reference
  ! position with the given tolerance
  !---------------------------------------------------------------------
  logical                          :: fix_by_posi  ! Function value on return
  type(observation), intent(inout) :: obs          ! Input observation
  real(kind=8),      intent(in)    :: reflam       ! [rad]  Reference lambda position
  real(kind=8),      intent(in)    :: refbet       ! [rad]  Reference beta position
  integer(kind=4),   intent(in)    :: refsys       ! [code] Reference system of coordinates
  real(kind=4),      intent(in)    :: refequ       ! [year] Reference equinox (if relevant)
  real(kind=4),      intent(in)    :: tole         ! [rad]  Tolerance
  ! Local
  character(len=*), parameter :: rname='FIND'
  type(projection_t) :: proj
  real(kind=8) :: rlam,rbet,rxoff,ryoff
  real(kind=4) :: rlamof,rbetof
  logical :: error
  !
  error = .false.
  fix_by_posi = .false.
  !
  ! 1) Convert reference position system to current observation system of
  ! coordinates. NB: conversion routines translate the old absolute reference
  ! to the new absolute reference, and the old offsets (from old reference) to
  ! new offsets (from new reference). If old offsets were 0 (i.e. considering
  ! only the reference position), they are also 0 in the new system! Which is
  ! our case here as we convert the reference position.
  select case (refsys)
  case (type_eq)
    if (obs%head%pos%system.eq.type_eq .and. obs%head%pos%equinox.eq.refequ) then  ! Same system
      rlam = reflam
      rbet = refbet
    elseif (obs%head%pos%system.eq.type_eq .and. obs%head%pos%equinox.ne.refequ) then
      call equ_to_equ(reflam,refbet,0.0,   0.0,   refequ,  &
                      rlam,  rbet,  rlamof,rbetof,obs%head%pos%equinox,error)
    elseif (obs%head%pos%system.eq.type_ga) then
      call equ_to_gal(reflam,refbet,0.0,   0.0,   refequ,  &
                      rlam,  rbet,  rlamof,rbetof,error)
    elseif (obs%head%pos%system.eq.type_ic) then
      call class_message(seve%e,rname,  &
        'Conversion between ICRS and Equatorial system not implemented')
      error = .true.
    endif
  case (type_ga)
    if (obs%head%pos%system.eq.type_ga) then  ! Same system
      rlam = reflam
      rbet = refbet
    elseif (obs%head%pos%system.eq.type_eq) then
      call gal_to_equ(reflam,refbet,0.0,   0.0,  &
                      rlam,  rbet,  rlamof,rbetof,obs%head%pos%equinox,error)
    elseif (obs%head%pos%system.eq.type_ic) then
      call class_message(seve%e,rname,  &
        'Conversion between ICRS and Equatorial system not implemented')
      error = .true.
    endif
  case (type_ic)
    if (obs%head%pos%system.eq.type_ic) then  ! Same system
      rlam = reflam
      rbet = refbet
    else
      call class_message(seve%e,rname,  &
        'Conversion between ICRS and other system not implemented')
      error = .true.
    endif
  case default
    call class_message(seve%e,rname,'Coordinate system not supported')
    error = .true.
  end select
  if (error)  return
  !
  ! 2) Convert absolute reference position to relative position in current
  !    observation projection system
  call gwcs_projec(obs%head%pos%lam,obs%head%pos%bet,obs%head%pos%projang,  &
    obs%head%pos%proj,proj,error)
  if (error)  return
  call abs_to_rel(proj,rlam,rbet,rxoff,ryoff,1)
  !
  ! 3) Compare using tolerance. Same selection as FIND /OFFSET, i.e. selection
  ! in a square, not a circle.
  fix_by_posi = obs%head%pos%lamof.ge.rxoff-tole .and.  &
                obs%head%pos%lamof.le.rxoff+tole .and.  &
                obs%head%pos%betof.ge.ryoff-tole .and.  &
                obs%head%pos%betof.le.ryoff+tole
  !
end function fix_by_posi
!
function fix_by_mask(lamof,betof,mask)
  use image_def
  use classcore_interfaces, except_this=>fix_by_mask
  !---------------------------------------------------------------------
  ! @ private
  !  Return .true. if the observation is selected by the input
  ! position-position mask.
  !  Note there is no consistency checking with the center of
  ! projection, kind of projection, and projection angle. This is the
  ! same feature as FIND /RANGE
  !---------------------------------------------------------------------
  logical :: fix_by_mask  ! Function value on return
  real(kind=4), intent(in) :: lamof,betof  ! Offsets
  type(gildas), intent(in) :: mask         ! The GDF 2D mask
  ! Local
  integer(kind=index_length) :: xc,yc
  integer(kind=4) :: xaxi,yaxi
  !
  xaxi = mask%gil%xaxi
  yaxi = mask%gil%yaxi
  !
  xc = nint((lamof-mask%gil%val(xaxi))/mask%gil%inc(xaxi)+mask%gil%ref(xaxi),kind=8)
  yc = nint((betof-mask%gil%val(yaxi))/mask%gil%inc(yaxi)+mask%gil%ref(yaxi),kind=8)
  !
  ! Out of area = not selected
  ! Negative or null value = not selected
  ! Blank value = not selected
  fix_by_mask = xc.ge.1                   .and.  &
                xc.le.mask%gil%dim(xaxi)  .and.  &
                yc.ge.1                   .and.  &
                yc.le.mask%gil%dim(yaxi)  .and.  &
                mask%r2d(xc,yc).gt.0.     .and.  &
                abs(mask%r2d(xc,yc)-mask%gil%bval).gt.mask%gil%eval
  !
end function fix_by_mask
!
!-----------------------------------------------------------------------
! Tools for fast search in Output File
!-----------------------------------------------------------------------
!
subroutine ox_sort_reset(set,error)
  use classcore_interfaces, except_this=>ox_sort_reset
  use class_index
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Recompute the sorting arrays of the Output indeX
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set
  logical,             intent(inout) :: error
  !
  call fox_reset
  if (set%uniqueness) then
    call optimize_sort_set_dtt(ox,error)
    if (error)  return
  endif
  !
end subroutine ox_sort_reset
!
subroutine ox_sort_add(set,obs,dupl,error)
  use gbl_message
  use classcore_interfaces, except_this=>ox_sort_add
  use class_common
  use class_index
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Add a new observation in the sorting arrays of the Output indeX
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set
  type(observation),   intent(in)    :: obs
  logical,             intent(out)   :: dupl
  logical,             intent(inout) :: error
  !
  dupl = .false.
  if (set%uniqueness) then
    if (fileout%desc%vind.ne.3) then
      call class_message(seve%w,'UNIQUENESS',  &
        'Not checked (index version in output file must be 3)')
      return
    elseif (.not.fileout%desc%single) then
      call class_message(seve%w,'UNIQUENESS',  &
        'Not checked (output file must be single)')
      return
    endif
    call optimize_sort_add_dtt(ox,obs,dupl,error)
    if (error)  return
  endif
  !
  ! Do it last so that this sorting array remains correct in case of
  ! error above
  call fox_add(obs%head%gen%num,fileout%desc%xnext-1)
  !
end subroutine ox_sort_add
!
subroutine fox(anum,ifound)
  use gbl_message
  use classcore_interfaces, except_this=>fox
  use class_parameter
  use class_index
  !----------------------------------------------------------------------
  ! @ private
  ! Search for observation number Anum (last version) in the sorted
  ! index.
  !----------------------------------------------------------------------
  integer(kind=obsnum_length), intent(in)  :: anum    ! Obs number being searched for
  integer(kind=entry_length),  intent(out) :: ifound  ! Corresponding Entry Number (0 if none)
  ! Local
  integer(kind=entry_length) :: jprev,jnext
  !
  ifound = 0
  if (ox%sort%nsort.eq.0) return
  call locplus(ox%sort%number,ox%sort%nsort,anum,jprev,jnext)
  !
  ! Not found
  if (ox%sort%number(jprev).eq.anum) then
    ifound = ox%sort%entry(jprev)
  else if (ox%sort%number(jnext).eq.anum) then
    ifound = ox%sort%entry(jnext)
  endif
  ! print *,'ox%sort%nsort ',ox%sort%nsort,jprev,jnext
end subroutine fox
!
subroutine fox_reset
  use gbl_message
  use classic_api
  use class_parameter
  use class_index
  !----------------------------------------------------------------------
  ! @ private
  ! Build up the Sorted Entry/Number list when opening an output file
  ! The Sorted list will then be kept up-to-date at each writing.
  !----------------------------------------------------------------------
  ! Local
  integer(kind=entry_length) :: iobs,j,ifound,jprev,jnext
  integer(kind=obsnum_length) :: anum
  !
  ox%sort%nsort = 0
  do iobs=1,ox%next-1
    if (ox%ver(iobs).lt.0) cycle ! Ignore "old" versions
    if (ox%sort%nsort.eq.0) then
      ox%sort%nsort = 1
      ox%sort%number(1) = ox%num(iobs)
      ox%sort%entry(1) = iobs
    else
      anum = ox%num(iobs)
      if (anum.gt.ox%sort%number(ox%sort%nsort)) then
        ox%sort%nsort = ox%sort%nsort+1
        ox%sort%number(ox%sort%nsort) = anum
        ox%sort%entry(ox%sort%nsort) = iobs
      else if (anum.lt.ox%sort%number(1)) then
        do j=ox%sort%nsort,1,-1
          ox%sort%number(j+1) = ox%sort%number(j)
          ox%sort%entry(j+1) = ox%sort%entry(j)
        enddo
        ox%sort%number(1) = anum
        ox%sort%entry(1) = iobs
        ox%sort%nsort = ox%sort%nsort+1
      else
        call locplus(ox%sort%number,ox%sort%nsort,anum,jprev,jnext)
        if (ox%sort%number(jprev).eq.anum) then
          ifound = ox%sort%entry(jprev)
        else if (ox%sort%number(jnext).eq.anum) then
          ifound = ox%sort%entry(jnext)
        else
          ! Insert between jprev and jnext
          do j=ox%sort%nsort,jnext,-1
            ox%sort%number(j+1) = ox%sort%number(j)
            ox%sort%entry(j+1) = ox%sort%entry(j)
          enddo
          ox%sort%number(jnext) = anum
          ox%sort%entry(jnext) = iobs
          ox%sort%nsort = ox%sort%nsort+1
        endif
      endif
    endif
  enddo
end subroutine fox_reset
!
subroutine fox_next(anum)
  use gbl_message
  use class_parameter
  use class_index
  !---------------------------------------------------------------------
  ! @ private
  ! RW  Returns next available ObsNumber Anum (last version)
  !---------------------------------------------------------------------
  integer(kind=obsnum_length), intent(out) :: anum  !
  !
  if (ox%sort%nsort.eq.0) then
     anum = 1
  else
     anum = ox%sort%number(ox%sort%nsort)+1
  endif
end subroutine fox_next
!
subroutine fox_add (anum, entry)
  use gbl_message
  use classic_api
  use classcore_interfaces, except_this=>fox_add
  use class_parameter
  use class_index
  !---------------------------------------------------------------------
  ! @ private
  ! RW  Search for ObsNumber Anum (last version)
  !---------------------------------------------------------------------
  integer(kind=obsnum_length), intent(in) :: anum   ! Obs number being searched for
  integer(kind=entry_length),  intent(in) :: entry  ! Corresponding Entry Number (0 if none)
  ! Local
  integer(kind=entry_length) :: j,jprev,jnext
  !
  if (ox%sort%nsort.eq.0) then
    ox%sort%nsort = 1
    ox%sort%number(1) = anum
    ox%sort%entry(1) = entry
  else
    if (anum.gt.ox%sort%number(ox%sort%nsort)) then
      ox%sort%nsort = ox%sort%nsort+1
      ox%sort%number(ox%sort%nsort) = anum
      ox%sort%entry(ox%sort%nsort) = entry
    else if (anum.lt.ox%sort%number(1)) then
      do j=ox%sort%nsort,1,-1
        ox%sort%number(j+1) = ox%sort%number(j)
        ox%sort%entry(j+1) = ox%sort%entry(j)
      enddo
      ox%sort%number(1) = anum
      ox%sort%entry(1) = entry
      ox%sort%nsort = ox%sort%nsort+1
    else
      call locplus(ox%sort%number,ox%sort%nsort,anum,jprev,jnext)
      if (ox%sort%number(jprev).eq.anum) then
        ox%sort%entry(jprev) = entry
      else if (ox%sort%number(jnext).eq.anum) then
        ox%sort%entry(jnext) = entry
      else
        ! Insert between jprev and jnext
        do j=ox%sort%nsort,jnext,-1
          ox%sort%number(j+1) = ox%sort%number(j)
          ox%sort%entry(j+1) = ox%sort%entry(j)
        enddo
        ox%sort%number(jnext) = anum
        ox%sort%entry(jnext) = entry
        ox%sort%nsort = ox%sort%nsort+1
      endif
    endif
  endif
end subroutine fox_add
!
subroutine locplus (x,np,xlim,nlim,mlim)
  use classic_api
  use class_parameter
  !---------------------------------------------------------------------
  ! @ private
  !  Find NLIM and MLIM such as
  !      X(NLIM) < XLIM < X(MLIM)
  !  for input data ordered increasingly
  !  Use a dichotomic search for that
  !---------------------------------------------------------------------
  integer(kind=entry_length),  intent(in)  :: np     !
  integer(kind=obsnum_length), intent(in)  :: x(np)  !
  integer(kind=obsnum_length), intent(in)  :: xlim   !
  integer(kind=entry_length),  intent(out) :: nlim   !
  integer(kind=entry_length),  intent(out) :: mlim   !
  ! Local
  integer(kind=entry_length) :: ninf,nsup,nmid
  !
  if (x(1).gt.xlim) then
     nlim = 1
     mlim = 1
     return
  elseif (x(np).lt.xlim) then
     nlim = np
     mlim = np
     return
  endif
  ninf = 1
  nsup = np
  !
  do while(nsup.gt.ninf+1)
     nmid = (nsup + ninf)/2
     if (x(nmid).lt.xlim) then
        ninf = nmid
     else
        nsup = nmid
     endif
  enddo
  nlim = ninf
  mlim = nsup
end subroutine locplus
!
subroutine optimize_sort_set_dtt(in,error)
  use gbl_message
  use class_sort_types
  use classcore_dependencies_interfaces
  use classic_api
  use classcore_interfaces, except_this=>optimize_sort_set_dtt
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Compute the date-time-telescope sorting list of the given index
  !---------------------------------------------------------------------
  type(optimize), target, intent(inout) :: in     !
  logical,                intent(inout) :: error  !
  ! Local
  integer(kind=entry_length) :: nelem,ielem
  type(class_sort_dtt_t) :: sortdtt
  !
  nelem = in%next-1
  !
  do ielem=1,nelem
    in%sort%dtt(ielem) = ielem
  enddo
  !
  sortdtt%optx => in
  call sortdtt%sort(in%sort%dtt,nelem,error)
  if (error)  return
end subroutine optimize_sort_set_dtt
!
subroutine optimize_sort_add_dtt(optx,obs,dupl,error)
  use gbl_message
  use class_sort_types
  use classic_api
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>optimize_sort_add_dtt
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Add a new observation to the Date-Time-Telescope sorting list.
  ! Raise an error if this new observation is duplicate of a previous
  ! one.
  !---------------------------------------------------------------------
  type(optimize), target, intent(inout) :: optx   ! Index to search in
  type(observation),      intent(in)    :: obs    ! Observation to be added
  logical,                intent(out)   :: dupl   ! Observation is a duplicate?
  logical,                intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=entry_length) :: nelem,jent,kent
  integer(kind=entry_length), parameter :: first=1
  character(len=message_length) :: mess
  type(class_sort_dtt_t) :: sortdtt
  !
  dupl = .false.
  nelem = optx%next-2  ! Observation is already at last position in the index: skip last one
  sortdtt%optx => optx
  sortdtt%searched_entry = optx%next-1  ! Observation is at last position in the index
  !
  if (nelem.le.0) then
    optx%sort%dtt(1) = 1
    return
  elseif (sortdtt%compare_value(optx%sort%dtt(nelem)).lt.0) then
    optx%sort%dtt(nelem+1) = nelem+1
    return
  elseif (sortdtt%compare_value(optx%sort%dtt(first)).gt.0) then
    jent = 1
  else
    call sortdtt%dicho(optx%sort%dtt,nelem,.true.,jent)
  endif
  ! In return jent is the element lower or equal to the request
  ! in the sorting array (optx%sort%dtt)
  !
  ! Check uniqueness
  kent = optx%sort%dtt(jent)
  if (optx%dobs(kent).eq.obs%head%gen%dobs .and.  &
      optx%ut(kent).eq.obs%head%gen%ut     .and.  &
      optx%ctele(kent).eq.obs%head%gen%teles) then
    dupl = .true.
    write(mess,'(A,I0,A,I0,A,F0.8,A,A)')  &
      'Duplicate observation #',obs%head%gen%num,': DOBS=',  &
      obs%head%gen%dobs,', UT=',obs%head%gen%ut,', TELES=',obs%head%gen%teles
    call class_message(seve%e,'UNIQUENESS',mess)
    error = .true.
    return
  endif
  !
  ! Fine, insert the observation at position jent in the sorting array
  do kent=nelem,jent,-1
    optx%sort%dtt(kent+1) = optx%sort%dtt(kent)
  enddo
  optx%sort%dtt(jent) = optx%next-1
end subroutine optimize_sort_add_dtt
