MODULE hash_tables
!  mlevels and step define the hash function; set to  prime numbers as required
   integer, parameter                         :: step = 123      
   integer, parameter                         :: mlevels = 99139
!     examples of  prime numbers 
!        small(ish) : 50021, 99139 
!        medium     :  333667, 524827
!        large      : 1299877, 2000003, 
!        huge       : 4000079, 6026179, 8034709  
   integer, save                              :: mlists
   integer, dimension(:,:), allocatable, save :: hlist, running, position
   integer, dimension(:), allocatable, save   :: nlevels

  contains

! ======================
  subroutine hash_setup
! ======================

  implicit none
  integer :: ii

  allocate( hlist(0:mlevels,mlists),running(0:mlevels,mlists), &
&           position(0:mlevels,mlists), nlevels(mlists), stat = ii)
  if( ii /=0 ) stop 'alloc hashtabs'

  hlist = 0; position = 0; running = 0;  nlevels = 0

  return
  end subroutine hash_setup

! ======================
  subroutine hash_deall
! ======================

  implicit none
  integer :: ii

  deallocate( hlist , running, position, nlevels, stat = ii)
  if( ii /= 0) stop 'deall hashtabs'

  return
  end subroutine hash_deall

! =====================================================
  subroutine hash_it (idorig, ivar, idnew, ipos, noadd)
! =====================================================

  implicit none
  integer, intent(in)  :: idorig, ivar
  integer, intent(out) :: idnew, ipos
  logical, intent(in)  :: noadd
  integer              :: ii
  
  if(ivar < 1 .or. ivar > mlists) stop 'HASH : list no.'
  
  idnew = 0; ipos = 0;  if (idorig == 0) return
  ii = mod(idorig,mlevels)+1

  do 
      if (hlist(ii,ivar) == idorig) exit          ! ID found
      if (hlist(ii,ivar) == 0 ) then              ! empty cell in hash table
         if( noadd ) return
         nlevels(ivar) = nlevels(ivar) + 1
         if(nlevels(ivar) >= mlevels) stop 'HASH: increase size'
         hlist(ii,ivar) = idorig
         running(ii,ivar) = nlevels(ivar)
         position(nlevels(ivar),ivar) = ii
         exit
      else
         ii = ii + step
         if (ii > mlevels) ii = ii - mlevels
      end if
  end do
  idnew = running(ii, ivar); ipos = position(ii, ivar)

  return
  end subroutine hash_it

! ==========================================
  integer function hash_idorig (idnew, ivar)
! ==========================================

  implicit none
  integer, intent(in) :: idnew, ivar
  integer             :: ii

  ii = position(idnew,ivar)
  hash_idorig = hlist(ii,ivar)

  return
  end function hash_idorig

end module hash_tables
!                                      karin meyer