C This file: http://ftp.aset.psu.edu/pub/ger/fortran/hdk/hashord.for
C
C===SKIP, THIS IS THE ORDERED HASH PROGRAM I WAS TALKING ABOUT
C   AND PROMISED YOU A WHILE BACK... WELL HERE IT IS, HAVE FUN!!
C   S. W. WHARTON 2/5/83
      INTEGER*4  RAND,RNDSEQ(10000),TSWAP,TPROBE,TFOUND
      NENTRY = 450
      NCELL = 499
      NPTS = 10000
      CALL IRAND(RNDSEQ,10000,-30000,30000)
      TFOUND = 0
      TPROBE = 0
      TSWAP = 0
C     ...ENTER NENTRY POINTS INTO THE ORDERED HASH TABLE
      DO 10 I = 1, NENTRY
         CALL ORHASH(NCELL,RNDSEQ(I),2,NSTAT,NPROBE,NSWAP)
         IF (NSTAT .NE. 3) TFOUND = TFOUND + 1
         TSWAP = TSWAP + NSWAP
         TPROBE = TPROBE + NPROBE
10    CONTINUE
      WRITE(6,600) NENTRY,TFOUND,TPROBE,TSWAP
      TFOUND = 0
      TPROBE = 0
      TSWAP = 0
C     ...NOW LOOK UP NPTS POINTS IN THE HASH TABLE
C     ...THE ORDERED HASH IS MORE EFFICIENT FOR UNSUCCESSFUL SEARCHES
      DO 20 I = 1, NPTS
         CALL ORHASH(NCELL,RNDSEQ(I),1,NSTAT,NPROBE,NSWAP)
         IF (NSTAT .NE. 3) TFOUND = TFOUND + 1
         TSWAP = TSWAP + NSWAP
         TPROBE = TPROBE + NPROBE
20    CONTINUE
      WRITE(6,600) NPTS,TFOUND,TPROBE,TSWAP
      STOP
600   FORMAT(' N=',I10,5X,'NFOUND =',I10,5X,'TPROBES =',I10,
     * 5X,'TSWAPS =',I10)
      END
      SUBROUTINE ORHASH(NCELL,ENTRY,MODE,STATUS,NPROBE,NSWAP)
C=
C=    USE A HASH FUNCTION TO LOOK UP OR INSERT KEYS INTO A TABLE.
C=    ORHASH USES THE ORDERED HASHING ALGORITHM WITH PASS BITS BY
C=    AMBLE AND KNUTH, (1974) ORDERED HASH TABLES, COMPUTER JOURNAL
C=    17(2):135-142.
C=
C=    ORDERED HASHING REDUCES THE NUMBER OF PROBES FOR UNSUCCESSFUL
C=    SEARCHING AND SO REDUCES THE SCANNER CPU TIME.
C=
C=    VARIABLE    DESCRIPTION
C=    --------    -----------
C=    NCELL       I - HASH TABLE LENGTH (PRIME NUMBER)
C=    NDIM        I - LENGTH OF EACH KEY
C=    ENTRY       I - NUMBER TO BE ENTERED OR PROBED FOR IN HASH TABLE
C=       NOTE: BECAUSE ORHASH MAY SWAP KEYS, ENTRY IS COPIED INTO KEY
C=             FOR SEARCHING. NEGATIVE AND ZERO VALUES OF KEY ARE OK.
C=    MODE        I - IS GIVEN AS AN INDICATOR AS FOLLOWS...
C=          (1) - MEANS TO ONLY LOOK UP THE KEY IN TABLE
C=          (2) - MEANS LOOK UP AND ENTER KEY IF IT IS NOT YET IN TABLE
C=    STATUS      I - FINAL STATUS OF THE PROBE SEQUENCE AS FOLLOWS:
C=          (1) - THE KEY WAS ADDED TO THE HASH TABLE AS A NEW ENTRY
C=          (2) - THE KEY MATCHED AN ENTRY IN THE HASH TABLE
C=          (3) - THE KEY WAS NOT ENTERED NOR WAS A MATCH FOUND
C=    NPROBE      I - THE NUMBER OF PROBES NEEDED TO ENTER THE KEY.
C=    NSWAP       I - THE NUMBER OF SWAPS NEEDED TO ENTER KEY
C=
C=    COMMON BLOCKS:    (NONE)
C=    I/O DEVICE #'S:  INPUT - (NONE);  OUTPUT - (NONE)
C=
      LOGICAL*1 PASSBT(005000)
      INTEGER AFP,BINKNT(005000),ENTRY,I,IABS,IKEY,IKNT,INC,KA,KEY,
     * KEYTAB(005000),MODE,NCELL,NEWKNT,NPROBE,NSWAP,STATUS
C     ...FOR ORHASH TO WORK PROPERLY, THE ARRAYS BINKNT AND PASSBT
C     ...MUST BE INITIALIZED TO ALL ZEROE AND FALSE, RESPECITVELY.
      DATA BINKNT/005000*0/,PASSBT/005000*.FALSE./
      KEY = ENTRY
      NEWKNT = 1
      NPROBE = 1
      NSWAP = 0
      STATUS = 3
C     ...COMPUTE ADDRESS OF FIRST PROBE (AFP) AND INCREMENT (INC).
      AFP = IABS(MOD(KEY,NCELL))  + 1
      INC = IABS(MOD(KEY,NCELL-2))  + 1
      KA = AFP
C
C     ...BEGIN THE SEARCH LOOP TO FIND AN ENTRY IN THE ORDERED
C     ...HASH TABLE (KEYTAB) THAT MATCHES THE NEW KEY
C
C     ...EXIT SEARCH LOOP IF EMPTY LOCATION FOUND
10    IF( BINKNT(KA) .EQ. 0 ) GO TO 100
C        ...CHECK IF KEYTAB(KA) MATCHES THE KEY
         IF( KEY .NE. KEYTAB(KA) ) GO TO 20
C           ...A MATCH WAS FOUND, INCREMENT BIN COUNTER AND EXIT LOOP
            BINKNT(KA) = BINKNT(KA) + 1
            STATUS = 2
            GO TO 999
C        ...EXIT SEARCH LOOP IF NO SMALLER ENTRIES FOLLOW KEYTAB(KA)
20       IF ( .NOT. PASSBT(KA) ) GO TO 100
C           ...EXIT SEARCH LOOP IF KEYTAB(KA) IS SMALLER THAN KEY
            IF ( KEY .GT. KEYTAB(KA) ) GO TO 100
C              ...COMPUTE ADDRESS OF NEXT PROBE
               KA = KA - INC
               IF( KA .LT. 1 ) KA = KA + NCELL
               NPROBE = NPROBE + 1
               GO TO 10
C
C     ...BEGIN THE INSERTION LOOP TO ENTER THE NEW KEY IN THE
C     ...ORDERED HASH TABLE IN THE APPROPRIATE POSITION SUCH
C     ...THAT THE KEYS ARE ARRANGED IN DECREASING ORDER
C
C     ...TERMINATE HASHING IF NO ENTRIES ARE TO BE MADE (MODE=1)
100   IF( MODE .EQ. 1 ) GO TO 999
110   IF( BINKNT(KA) .NE. 0 ) GO TO 120
C        ...LOAD KEY INTO EMPTY SPACE AT POSITION KA
         BINKNT(KA) = NEWKNT
         KEYTAB(KA) = KEY
         STATUS = 1
         GO TO 999
120   IF( KEY .LE. KEYTAB(KA) ) GO TO 130
C        ...SWAP KEY WITH KEYTAB(KA) SO THAT THE KEYS ALONG A GIVEN
C        ...SEARCH SEQUENCE ARE ARRANGED IN DECREASING ORDER
         IKEY = KEY
         KEY = KEYTAB(KA)
         KEYTAB(KA) = IKEY
         IKNT = NEWKNT
         NEWKNT = BINKNT(KA)
         BINKNT(KA) = IKNT
         NSWAP = NSWAP + 1
         INC = IABS(MOD(KEY,NCELL-2)) + 1
130   PASSBT(KA) = .TRUE.
C     ...COMPUTE ADDRESS OF NEXT PROBE.
      KA = KA - INC
      IF( KA .LT. 1 ) KA = KA + NCELL
      NPROBE = NPROBE + 1
      GO TO 110
999   RETURN
      END