module cubedag_find
  use gkernel_interfaces
  use cubedag_parameters
  use cubedag_flag
  use cubedag_types
  use cubedag_messaging
  use cubedag_index
  use cubedag_dag

  type user_find_t
     ! Type used for parsing FIND options. Get arguments as character strings
     ! (because strg_star is often accepted), interpret them elsewhere
     character(len=12)     :: centr(2) = strg_star  ! Entry range
     character(len=12)     :: ciden    = strg_star  ! Identifier
     character(len=12)     :: cobse    = strg_star  ! Observatory name
     character(len=12)     :: csour    = strg_star  ! Source name
     character(len=12)     :: cline    = strg_star  ! Line name
     character(len=base_l) :: cfami    = strg_star  ! Family name
   ! To be reimplemented to support flag_t, if relevant
   ! character(len=12)     :: ciflag   = strg_star  ! Flag (string for flag name)
     character(len=flag_l) :: ccflag   = strg_star  ! Flag (character string/pattern)
  end type user_find_t

  integer(kind=entr_k), parameter :: minentr=1_entr_k
  integer(kind=entr_k), parameter :: maxentr=huge(1_entr_k)
  type :: cubedag_find_t
    !
    logical               :: lentr = .false.     ! Selection by entry range enabled?
    integer(kind=entr_k)  :: ientr(2) = [minentr,maxentr]  ! Desired entry range
    !
    logical               :: liden = .false.     ! Selection by identifier?
    integer(kind=iden_l)  :: iiden = -1          ! Desired identifier, if relevant
    !
    logical               :: lobse = .false.     ! Selection by cobse enabled?
    character(len=12)     :: cobse = strg_star   ! Desired observatory name, if relevant
    !
    logical               :: lsour = .false.     ! Selection by csour enabled?
    character(len=12)     :: csour = strg_star   ! Desired source name, if relevant
    !
    logical               :: lline = .false.     ! Selection by cline enabled?
    character(len=12)     :: cline = strg_star   ! Desired line name, if relevant
    !
    logical               :: lfami = .false.     ! Selection by cfami enabled?
    character(len=base_l) :: cfami = strg_star   ! Desired family  name, if relevant
    !
    logical               :: liflag  = .false.   ! Selection by iflag (flag_t) enabled?
    type(flag_t), allocatable :: iflags(:)       ! Desired flags, if relevant
    !
    logical               :: lcflag = .false.    ! Selection by ccflag (character string/pattern) enabled?
    character(len=base_l) :: ccflag = strg_star  ! Desired flag(s) name, if relevant
    !
  end type cubedag_find_t

  interface cubedag_find_ix2optx
    module procedure cubedag_find_ix2optx_bycriter
    module procedure cubedag_find_ix2optx_bynodes
  end interface cubedag_find_ix2optx

  public :: cubedag_find_command,cubedag_find_t,user_find_t
  public :: cubedag_find_ix2cx,cubedag_find_cx2optx,cubedag_find_ix2optx
  private

contains
  !
  subroutine cubedag_find_command(fuser,error)
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(user_find_t), intent(in)    :: fuser
    logical,           intent(inout) :: error  ! Logical error flag
    ! Local
    character(len=*), parameter :: rname='FIND'
    type(cubedag_find_t) :: criter
    !
    if (ix%next.le.2)  &  ! Ignore root
      call cubedag_message(seve%w,rname,'Input index is empty')
    !
    ! --- Fill CX from selection criteria --------------------------------
    call cubedag_find_criter(fuser,criter,error)
    if (error)  return
    !
    call cubedag_find_ix2cx(criter,error)
    if (error)  return
  end subroutine cubedag_find_command
  !
  subroutine cubedag_find_criter(user,criter,error)
    use cubetools_disambiguate
    use cubetools_user2prog
    type(user_find_t),    intent(in)    :: user
    type(cubedag_find_t), intent(out)   :: criter
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FIND>CRITER'
    ! character(len=32) :: keyword
    type(flag_t) :: iflag
    integer(kind=entr_k) :: tmp
    integer(kind=4) :: ier
    !
    ! /ENTRY [min|*] [max|*]
    call cubetools_user2prog_resolve_star(user%centr(1),minentr,criter%ientr(1),error)
    if (error)  return
    call cubetools_user2prog_resolve_star(user%centr(2),maxentr,criter%ientr(2),error)
    if (error)  return
    if (criter%ientr(1).gt.criter%ientr(2)) then
      tmp = criter%ientr(1)
      criter%ientr(1) = criter%ientr(2)
      criter%ientr(2) = tmp
    endif
    !
    ! /IDENTIFIER [number|*]
    call cubetools_user2prog_resolve_star(user%ciden,-1,criter%iiden,error)
    if (error)  return
    !
    ! /OBSERVATORY [obsname|*] ! case insensitive
    call cubetools_disambiguate_toupper(user%cobse,criter%cobse,error)
    if (error) return
    !
    ! /SOURCE [sourcename|*] ! case insensitive
    call cubetools_disambiguate_toupper(user%csour,criter%csour,error)
    if (error) return
    !
    ! /LINE [linename|*] ! case insensitive
    call cubetools_disambiguate_toupper(user%cline,criter%cline,error)
    if (error) return
    !
    ! /FAMILY [familyname|*]
    criter%cfami = user%cfami
    !
    ! FLAG [flagkeyword|*]  ! ZZZ No syntax to provide several flag codes
!   if (user%ciflag.eq.strg_star) then
      iflag = flag_any
!   else
!     call cubetools_disambiguate_strict(user%ciflag,dag_flag_keys,iflag,keyword,error)
!     if (error)  return
!   endif
    allocate(criter%iflags(1),stat=ier)
    if (failed_allocate(rname,'iflags',ier,error)) return
    criter%iflags(1) = iflag
    !
    ! /FLAG [flagpattern|*]
    criter%ccflag = user%ccflag
  end subroutine cubedag_find_criter

  subroutine cubedag_find_lcriter(criter,error)
    type(cubedag_find_t), intent(inout) :: criter
    logical,              intent(inout) :: error
    !
    criter%lentr = criter%ientr(1).gt.minentr .or. criter%ientr(2).lt.maxentr
    criter%liden = criter%iiden.ge.0
    criter%lobse = criter%cobse.ne.strg_star
    criter%lsour = criter%csour.ne.strg_star
    criter%lline = criter%cline.ne.strg_star
    criter%lfami = criter%cfami.ne.strg_star
    if (allocated(criter%iflags)) then
      if (size(criter%iflags).eq.1 .and. criter%iflags(1).eq.flag_any) then
        criter%liflag = .false.
      else
        criter%liflag = .true.
      endif
    else
      criter%liflag = .false.
    endif
    criter%lcflag = criter%ccflag.ne.strg_star
  end subroutine cubedag_find_lcriter

  subroutine cubedag_find_ix2cx(criter,error)
    type(cubedag_find_t), intent(inout) :: criter
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FIND'
    character(len=message_length) :: mess
    !
    call cubedag_find_bycriter(criter,ix,cx,error)
    if (error)  return
    write(mess,'(I0,A)')  cx%next-1,' entries in Current indeX'
    call cubedag_message(seve%i,rname,mess)
  end subroutine cubedag_find_ix2cx

  subroutine cubedag_find_ix2optx_bycriter(criter,out,error)
    type(cubedag_find_t),     intent(inout) :: criter
    type(cubedag_optimize_t), intent(inout) :: out
    logical,                  intent(inout) :: error
    !
    call cubedag_find_bycriter(criter,ix,out,error)
    if (error)  return
  end subroutine cubedag_find_ix2optx_bycriter

  subroutine cubedag_find_ix2optx_bynodes(nodes,nnodes,out,error)
    type(cubedag_node_pobject_t), intent(in)    :: nodes(:)  !
    integer(kind=entr_k),         intent(in)    :: nnodes    !
    type(cubedag_optimize_t),     intent(inout) :: out
    logical,                      intent(inout) :: error
    !
    call cubedag_find_bynodes(nodes,nnodes,out,error)
    if (error)  return
  end subroutine cubedag_find_ix2optx_bynodes

  subroutine cubedag_find_cx2optx(criter,out,error)
    type(cubedag_find_t),     intent(inout) :: criter
    type(cubedag_optimize_t), intent(inout) :: out
    logical,                  intent(inout) :: error
    !
    call cubedag_find_bycriter(criter,cx,out,error)
    if (error)  return
  end subroutine cubedag_find_cx2optx
  !
  subroutine cubedag_find_bycriter(criter,in,out,error)
    use cubedag_allflags
    use cubedag_node
    type(cubedag_find_t),     intent(inout) :: criter  !
    type(cubedag_optimize_t), intent(in)    :: in      !
    type(cubedag_optimize_t), intent(inout) :: out     !
    logical,                  intent(inout) :: error   !
    ! Local
    character(len=*), parameter :: rname='FIND'
    integer(kind=entr_k) :: ient,nfound,nfoundall
    logical :: found
    integer(kind=4) :: iflag,iteles
    integer(kind=entr_k) :: list(in%next-1) ! Automatic array (assume in%next>1)
    class(cubedag_node_object_t), pointer :: obj
    character(len=256) :: nodeflag
    type(flag_t), pointer :: flag
    character(len=sour_l) :: mysource
    character(len=line_l) :: myline
    character(len=tele_l) :: myteles
    !
    call cubedag_find_lcriter(criter,error)
    if (error)  return
    !
    nfound = 0
    nfoundall = 0
    do ient=1,in%next-1
      obj => in%object(ient)%p
      !
      ! Do not find pure-node object, which are irrelevant (no data provided)
      if (obj%node%type.eq.code_type_node)  cycle
      !
      if (criter%liden) then
        if (obj%node%id.ne.criter%iiden) cycle
      endif
      !
      if (criter%lsour) then
        mysource = obj%node%head%spatial_source
        call sic_upper(mysource)
        if (.not.match_string(mysource,criter%csour)) cycle
      endif
      !
      if (criter%lline) then
        myline = obj%node%head%spectral_line
        call sic_upper(myline)
        if (.not.match_string(myline,criter%cline)) cycle
      endif
      !
      if (criter%lfami) then
        if (.not.match_string(obj%node%family,criter%cfami)) cycle
      endif
      !
      if (criter%lobse) then
        found = .false.
        do iteles=1,obj%node%head%obs%ntel
          myteles = obj%node%head%obs%tel(iteles)%name
          call sic_upper(myteles)
          if (match_string(myteles,criter%cobse)) then
            found = .true.
            exit
          endif
        enddo
        if (.not.found)  cycle
      endif
      !
      if (criter%liflag) then
        if (size(criter%iflags).ne.obj%node%flag%n)  cycle
        !
        found = .true.
        do iflag=1,obj%node%flag%n
          if (criter%iflags(iflag).eq.flag_any)  cycle
          flag => cubedag_flag_ptr(obj%node%flag%list(iflag)%p,error)
          if (error)  return
          if (criter%iflags(iflag).ne.flag) then
            found = .false.
            exit
          endif
        enddo
        if (.not.found)  cycle
      endif
      !
      if (criter%lcflag) then
        call cubedag_flag_tostr(obj%node,strflag=nodeflag,error=error)
        if (error)  return
        if (.not.match_string(nodeflag,criter%ccflag)) cycle
      endif
      !
      ! Must come last
      if (criter%lentr) then
        nfoundall = nfoundall+1
        if (nfoundall.lt.criter%ientr(1))  cycle
        if (nfoundall.gt.criter%ientr(2))  cycle
      endif
      !
      nfound = nfound+1
      list(nfound) = ient
    enddo
    !
    call cubedag_find_byentries(in,list,nfound,out,error)
    if (error)  return
    !
  end subroutine cubedag_find_bycriter
  !
  subroutine cubedag_find_bynodes(nodes,nnodes,out,error)
    !-------------------------------------------------------------------
    ! FIND by list of nodes in IX
    !-------------------------------------------------------------------
    type(cubedag_node_pobject_t), intent(in)    :: nodes(:)  !
    integer(kind=entr_k),         intent(in)    :: nnodes    !
    type(cubedag_optimize_t),     intent(inout) :: out       !
    logical,                      intent(inout) :: error     !
    ! Local
    character(len=*), parameter :: rname='FIND'
    integer(kind=entr_k) :: inode
    integer(kind=entr_k) :: list(nnodes) ! Automatic array
    !
    ! This resolution is efficient (no search) thanks to backpointer
    ! to IX
    do inode=1,nnodes
      list(inode) = nodes(inode)%p%node%ient  ! Backpointer to IX
    enddo
    !
    ! The counterpart is that the list is meaningful only for IX
    call cubedag_find_byentries(ix,list,nnodes,out,error)
    if (error)  return
    !
  end subroutine cubedag_find_bynodes
  !
  subroutine cubedag_find_byentries(in,entries,nentries,out,error)
    !-------------------------------------------------------------------
    ! FIND by list of entry numbers
    !-------------------------------------------------------------------
    type(cubedag_optimize_t), intent(in)    :: in          !
    integer(kind=entr_k),     intent(in)    :: entries(:)  ! Entry numbers
    integer(kind=entr_k),     intent(in)    :: nentries    !
    type(cubedag_optimize_t), intent(inout) :: out         !
    logical,                  intent(inout) :: error       !
    ! Local
    integer(kind=entr_k) :: ient
    !
    call cubedag_index_reallocate(out,nentries,.false.,error)
    if (error)  return
    !
    out%next = 1
    do ient=1,nentries
      call cubedag_optimize_to_optimize_next(in,entries(ient),out,error)
      if (error)  exit
    enddo
  end subroutine cubedag_find_byentries
  !
end module cubedag_find
