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