module sic_hashing_types
  use gmath_quicksort_types
  use sic_types
  !---------------------------------------------------------------------
  !
  !---------------------------------------------------------------------
  !
  ! Type for sorting type(sic_variable_t) dictionaries
  type, extends(gi4_quicksort_t) :: sic_hassort_t
    type(sic_variable_t), pointer :: dict(:)
  contains
    procedure, public :: compare => sic_hassort_compare
  end type sic_hassort_t
  !
  ! Type for sorting character string dictionaries
  type, extends(gi4_quicksort_t) :: gag_hassort_t
    character(len=:), pointer :: dict(:)
  contains
    procedure, public :: compare => gag_hassort_compare
  end type gag_hassort_t
  !
contains
  !
  function sic_hassort_compare(self,m,l)
    !-------------------------------------------------------------------
    ! Variable comparison function: just compare the variable names
    !-------------------------------------------------------------------
    integer(kind=4) :: sic_hassort_compare
    class(sic_hassort_t), intent(in) :: self
    integer(kind=4),      intent(in) :: m,l
    if (self%dict(m)%id%name.eq.self%dict(l)%id%name) then
      sic_hassort_compare = 0
    elseif (lgt(self%dict(m)%id%name,self%dict(l)%id%name)) then
      sic_hassort_compare = 1
    else
      sic_hassort_compare = -1
    endif
  end function sic_hassort_compare
  !
  function gag_hassort_compare(self,m,l)
    !-------------------------------------------------------------------
    ! Variable comparison function: just compare the variable names
    !-------------------------------------------------------------------
    integer(kind=4) :: gag_hassort_compare
    class(gag_hassort_t), intent(in) :: self
    integer(kind=4),      intent(in) :: m,l
    if (self%dict(m).eq.self%dict(l)) then
      gag_hassort_compare = 0
    elseif (lgt(self%dict(m),self%dict(l))) then
      gag_hassort_compare = 1
    else
      gag_hassort_compare = -1
    endif
  end function gag_hassort_compare
end module sic_hashing_types
!
function sic_hasins(rname,mdim,pf,pn,dict,var,in)
  use gbl_message
  use sic_interfaces, except_this=>sic_hasins
  use sic_dependencies_interfaces
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  *** This version for dictionaries as type(sic_variable_t) arrays ***
  !       Insert a new name or replace an existing name
  !       in a dictionnary using a hashing structure
  !       and a list of pointers.
  !
  !       SIC_HASINS      0       E  Invalid name
  !                       1       S  Successfully inserted
  !                       2       E  Too many names
  !                       3       S  Successfully replaced
  !
  !       PF      I(0:27) PF(J) Address of first name beginning
  !                       with CHAR(J-ICHAR('A')) in dictionnary.
  !                       PF(26) is the address of the first
  !                       available place.                        Input/Output
  !                       PF(27) is the number of symbols
  !       PN      I(MDIM) Address of next name with same first
  !                       letter. If PN(J)=0, no more such name.  Input/Output
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_hasins  ! Function value on return
  character(len=*),       intent(in)    :: rname       ! Calling routine name
  integer(kind=4),        intent(in)    :: mdim        ! Size of dictionnary
  integer(kind=4),        intent(inout) :: pf(0:27)    !
  integer(kind=4),        intent(inout) :: pn(mdim)    !
  type(sic_variable_t),   intent(inout) :: dict(mdim)  ! Dictionnary array of size MDIM
  type(sic_identifier_t), intent(inout) :: var         ! Variable to be inserted
  integer(kind=4),        intent(out)   :: in          ! Address of this variable
  ! Local
  integer(kind=4) :: j,k
  character(len=message_length) :: mess
  !
  in = 0
  sic_hasins = 0
  !
  ! Find the place in PF
  call sic_upper(var%name)
  j = ichar(var%name(1:1))-ichar('A')
  if (j.lt.0 .or. j.gt.25) then
    call sic_message(seve%e,rname,'Invalid variable name '//var%name)
    return
  endif
  !
  ! Find if it exits already
  k = pf(j)
  do while (k.gt.0)
    if (var%level.eq.dict(k)%id%level .and. var%lname.eq.dict(k)%id%lname) then
      if (var%name(1:var%lname).eq.dict(k)%id%name(1:var%lname)) then
        in = k
        sic_hasins = 3
        return
      endif
    endif
    k = pn(k)
  enddo
  !
  ! Find if place left
  if (pf(26).eq.0) then
    write(mess,'(A,I0,A)')  'Too many variables, set SIC_MAXVAR to more than ',  &
      mdim,' in your $HOME/.gag.dico'
    call sic_message(seve%e,rname,mess)
    sic_hasins = 2
    return
  endif
  !
  ! Insert NAME in place and set pointers
  k = pf(26)
  pf(26) = pn(k)
  pn(k) = pf(j)
  pf(j) = k
  dict(k)%id = var
  in = k
  pf(27) = pf(27)+1
  sic_hasins = 1
  !
end function sic_hasins
!
function sic_hasdel(mdim,pf,pn,dict,var)
  use sic_dependencies_interfaces
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  *** This version for dictionaries as type(sic_variable_t) arrays ***
  !       Delete a name in a dictionnary using a hashing structure
  !       and a list of pointers.
  !
  !       SIC_HASDEL      1       Name deleted
  !                       3       Name does not exist
  !
  !       PF      I(0:27) PF(J) Address of first name beginning
  !                       with CHAR(J-ICHAR('A')) in dictionnary.
  !                       PF(26) is the address of the first
  !                       available place.                        Input/Output
  !                       PF(27) is the number of symbols
  !       PN      I(MDIM) Address of next name with same first
  !                       letter. If PN(J)=0, no more such name.  Input/Output
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_hasdel  ! Function value on return
  integer(kind=4),        intent(in)    :: mdim        ! Size of dictionnary
  integer(kind=4),        intent(inout) :: pf(0:27)    !
  integer(kind=4),        intent(inout) :: pn(mdim)    !
  type(sic_variable_t),   intent(in)    :: dict(mdim)  ! Dictionnary array of size MDIM
  type(sic_identifier_t), intent(inout) :: var         ! Variable to be deleted
  ! Local
  integer(kind=4) :: j,kl,k
  !
  sic_hasdel = 3
  ! Find the place in PF
  call sic_upper(var%name)
  j = ichar(var%name(1:1))-ichar('A')
  if (j.lt.0 .or. j.gt.25) return
  !
  ! Now examine if it is a known symbol
  kl = 0
  k = pf(j)
  do while (k.ne.0)
    if (var%level.eq.dict(k)%id%level .and. var%lname.eq.dict(k)%id%lname) then
      if (var%name(1:var%lname).eq.dict(k)%id%name(1:var%lname)) then
        exit
      endif
    endif
    kl = k
    k = pn(k)
  enddo
  if (k.eq.0)  return  ! Nothing found (reached end of dictionary with no matching
                       ! variable)
  !
  ! Now delete it
  sic_hasdel = 1
  if (kl.ne.0) then
    pn(kl) = pn(k)
  else
    pf(j) = pn(k)
  endif
  pn(k) = pf(26)
  pf(26) = k
  pf(27) = pf(27)-1
end function sic_hasdel
!
function sic_hasfin(mdim,pf,pn,dict,var,in)
  use sic_dependencies_interfaces
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  *** This version for dictionaries as type(sic_variable_t) arrays ***
  !       Find a name in a dictionnary using a hashing structure
  !       and a list of pointers.
  !
  !       SIC_HASFIN      0       No such name
  !                       1       Name found
  !       PF      I(0:27) PF(J) Address of first name beginning
  !                       with CHAR(J-ICHAR('A')) in dictionnary.
  !                       PF(26) is the address of the first
  !                       available place.                        Input
  !       PN      I(MDIM) Address of next name with same first
  !                       letter. If PN(J)=0, no more such name.  Input
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_hasfin                          ! Function value on return
  integer(kind=4),        intent(in)    :: mdim        ! Size of dictionnary
  integer(kind=4),        intent(in)    :: pf(0:27)    !
  integer(kind=4),        intent(in)    :: pn(mdim)    !
  type(sic_variable_t),   intent(in)    :: dict(mdim)  ! Dictionnary array of size MDIM
  type(sic_identifier_t), intent(inout) :: var         ! Variable to be found
  integer(kind=4),        intent(out)   :: in          ! Address of this variable
  ! Local
  integer(kind=4) :: j
  !
  ! If no symbol return
  in = 0
  sic_hasfin = 0
  if (pf(27).eq.0) return
  !
  ! Find the place in PF
  call sic_upper(var%name)
  j = ichar(var%name(1:1))-ichar('A')
  if (j.lt.0 .or. j.gt.25) return
  !
  ! Now examine the chained structure from this point
  j = pf(j)
  do while (j.ne.0)
    if (var%level.eq.dict(j)%id%level .and. var%lname.eq.dict(j)%id%lname) then
      if (var%name(1:var%lname).eq.dict(j)%id%name(1:var%lname)) then
        in = j
        sic_hasfin = 1
        return
      endif
    endif
    j = pn(j)
  enddo
  !
end function sic_hasfin
!
function sic_hasambigs(mdim,pf,pn,dict,name,if,il)
  use sic_dependencies_interfaces
  use sic_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  *** This version for dictionaries as type(sic_variable_t) arrays ***
  !       Find all names beginning with the letters of NAME
  !       in  a dictionnary using a hashing structure
  !       and a list of pointers.
  !
  !       SIC_HASAMBIGS   0       No such name
  !                       n       N Names found
  !       PF      I(0:27) PF(J) Address of first name beginning
  !                       with CHAR(J-ICHAR('A')) in dictionnary.
  !                       PF(26) is the address of the first
  !                       available place.                        Input
  !       PN      I(MDIM) Address of next name with same first
  !                       letter. If PN(J)=0, no more such name.  Input
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_hasambigs                     ! Value on return
  integer(kind=4),      intent(in)  :: mdim        ! Size of dictionary
  integer(kind=4),      intent(in)  :: pf(0:27)    !
  integer(kind=4),      intent(in)  :: pn(mdim)    !
  type(sic_variable_t), intent(in)  :: dict(mdim)  ! Dictionary array
  character(len=*),     intent(in)  :: name        ! Name against whom search
  integer(kind=4),      intent(out) :: if          ! Adress of first Match
  integer(kind=4),      intent(out) :: il          ! Adress of  last Match
  ! Local
  integer(kind=4) :: j,l
  character(len=varname_length) :: uname
  !
  ! If no symbol return
  if = 0
  il = 0
  sic_hasambigs = 0
  !
  ! Find the place in PF
  l = len_trim(name)
  uname = name
  call sic_upper(uname)
  j = ichar(uname(1:1))-ichar('A')
  if (j.lt.0 .or. j.gt.25) return
  if (pf(27).eq.0) return
  !
  ! Now examine the chained structure from this point
  j = pf(j)
  do while (j.ne.0)
    if (uname(1:l).eq.dict(j)%id%name(1:l)) then
      if (if.eq.0) if = j
      il = j
      sic_hasambigs = sic_hasambigs+1
    endif
    j = pn(j)
  enddo
  if (if.eq.0) return
  !
  if (if.eq.il .and. uname.eq.dict(if)%id%name) return
  !
  call sic_message(seve%w,'SIC','Ambiguous Name, Could be:')
  j = ichar(uname(1:1))-ichar('A')
  j = pf(j)
  !
  do while (j.ne.0)
    if (uname(1:l).eq.dict(j)%id%name(1:l)) then
      write (*,'(A)') trim(dict(j)%id%name)
    endif
    j = pn(j)
  enddo
  !
end function sic_hasambigs
!
subroutine sic_hassort(mdim,pf,pn,dict,list,leng)
  use sic_dependencies_interfaces
  use sic_hashing_types
  use sic_interfaces, except_this=>sic_hassort
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  *** This version for dictionaries as type(sic_variable_t) arrays ***
  !
  !  List alphabetically a dictionnary using a hashing structure and a
  ! list of pointers. This routine just builds the list of pointers to
  ! current entries.
  !
  !   PF(0:27)   PF(0:25) Address of first name beginning with
  !                       CHAR(J-ICHAR('A')) in dictionnary.
  !              PF(26)   is the address of the first available place.
  !              PF(27)   the number of symbols
  !   PN(MDIM)            Address of next name with same first letter.
  !                       If PN(J)=0, no more such name.
  !---------------------------------------------------------------------
  integer(kind=4),              intent(in)  :: mdim        ! Size of dictionnary
  integer(kind=4),              intent(in)  :: pf(0:27)    !
  integer(kind=4),              intent(in)  :: pn(mdim)    !
  type(sic_variable_t), target, intent(in)  :: dict(mdim)  ! Dictionary array
  integer(kind=4),              intent(out) :: list(mdim)  ! List of entries in dictionnary
  integer(kind=4),              intent(out) :: leng        ! Current number of entries
  ! Local
  integer(kind=4) :: i,j,first,last
  type(sic_hassort_t) :: hassort
  logical :: error
  !
  leng = 0
  if (pf(27).eq.0)  return  ! Empty dictionnary
  !
  error = .false.
  hassort%dict => dict
  !
  do i=0,25
    if (pf(i).le.0)  cycle  ! Next letter
    !
    j = pf(i)
    leng = leng+1
    list(leng) = j
    first = leng  ! First index for the current letter
    do while (pn(j).gt.0)
      j = pn(j)
      leng = leng+1
      list(leng) = j
    enddo
    last = leng  ! Last index for the current letter
    !
    ! Now sort the list for this letter
    call hassort%sort(list(first:last),last-first+1,error)
    if (error)  return
    !
  enddo
  !
end subroutine sic_hassort
!
subroutine gag_hassort(mdim,pf,pn,dict,list,leng)
  use sic_dependencies_interfaces
  use sic_hashing_types
  use sic_interfaces, except_this=>gag_hassort
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  *** This version for dictionaries as character string arrays ***
  !  (This subroutine should go in kernel/lib/gsys/hashing.f90 but
  !   the module gmath_quicksort_types is needed.)
  !
  !  List alphabetically a dictionnary using a hashing structure and a
  ! list of pointers. This routine just builds the list of pointers to
  ! current entries.
  !
  !   PF(0:27)   PF(0:25) Address of first name beginning with
  !                       CHAR(J-ICHAR('A')) in dictionnary.
  !              PF(26)   is the address of the first available place.
  !              PF(27)   the number of symbols
  !   PN(MDIM)            Address of next name with same first letter.
  !                       If PN(J)=0, no more such name.
  !---------------------------------------------------------------------
  integer(kind=4),          intent(in)  :: mdim        ! Size of dictionnary
  integer(kind=4),          intent(in)  :: pf(0:27)    !
  integer(kind=4),          intent(in)  :: pn(mdim)    !
  character(len=*), target, intent(in)  :: dict(mdim)  ! Dictionary array
  integer(kind=4),          intent(out) :: list(mdim)  ! List of entries in dictionnary
  integer(kind=4),          intent(out) :: leng        ! Current number of entries
  ! Local
  integer(kind=4) :: i,j,first,last
  type(gag_hassort_t) :: hassort
  logical :: error
  !
  leng = 0
  if (pf(27).eq.0)  return  ! Empty dictionary
  !
  error = .false.
  hassort%dict => dict
  !
  do i=0,25
    if (pf(i).le.0)  cycle  ! Next letter
    !
    j = pf(i)
    leng = leng+1
    list(leng) = j
    first = leng  ! First index for the current letter
    do while (pn(j).gt.0)
      j = pn(j)
      leng = leng+1
      list(leng) = j
    enddo
    last = leng  ! Last index for the current letter
    !
    ! Now sort the list for this letter
    call hassort%sort(list(first:last),last-first+1,error)
    if (error)  return
    !
  enddo
  !
end subroutine gag_hassort
