anchor.diff:                                                !  |  14  |  87  |
                                                 !  |  18  |  85  |
                                                 !  |  42  |  78  |
  -  CALL HASH_SORT(H,ASC)                       !  |  44  |  72  |        
  -  CALL HASH_SORT(H,DESC,.FALSE.)              !  |  60  |  64  |
  +  CALL BTREE_SORT(BT,ASC)                     !  |  44  |  72  |        
  +  CALL BTREE_SORT(BT,DESC,.FALSE.)            !  |  60  |  64  |
     DO I = 1, 10                                !  |  64  |  60  |
       WRITE(6,'(2I8)') ASC(I),DESC(I)           !  |  72  |  44  |
     END DO                                      !  |  78  |  42  |
  
positive.code: !
  END MODULE MODHASHCODE
  ! ---------------------------------------------------------------------------------------------------------------------------------+
                                                       MODULE MODHASH
  ! ---------------------------------------------------------------------------------------------------------------------------------+
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: HASH,HASH_RESIZE,HASH_ADD,HASH_SORT
  TYPE HASH
    INTEGER(KIND=4)             :: CAPACITY
    INTEGER(KIND=4)             :: COUNT
    INTEGER(KIND=4),ALLOCATABLE :: HASH(:,:)
  END TYPE HASH
  INTEGER(KIND=4),PARAMETER     :: DEFAULT_BLOCKSIZE = 64
  INTEGER(KIND=4)               :: BLOCKSIZE
  ! ---------------------------------------------------------------------------------------------------------------------------------+
                                                             CONTAINS
  ! ---------------------------------------------------------------------------------------------------------------------------------+
  SUBROUTINE HASH_RESIZE(H, CAPACITY)
  TYPE(HASH),INTENT(INOUT) :: H
  INTEGER(KIND=4),INTENT(IN)   :: CAPACITY
  INTEGER(KIND=4),ALLOCATABLE  :: TEMP(:,:)
  INTEGER(KIND=4)              :: OLDCAPACITY,I,J,IERR
    IF (ALLOCATED(H%HASH)) THEN
      OLDCAPACITY = SIZE(H%HASH,2)
      ALLOCATE(TEMP(3,OLDCAPACITY),STAT=IERR)
      IF (IERR.NE.0) THEN
        WRITE(0,'(A)') '0*** UNABLE TO ALLOCATE TEMPORARY MEMORY FOR HASH.'
        STOP
      END IF
      TEMP = H%HASH
      CALL HASH_ALLOCATE(H, CAPACITY)
      DO J = 1, MIN(OLDCAPACITY,CAPACITY)
        DO I = 1,3
          H%HASH(I,J) = TEMP(I,J)
        END DO
      END DO
      DEALLOCATE(TEMP,STAT=IERR)
      IF (IERR.NE.0) THEN
        WRITE(0,'(A)') '0*** UNABLE TO DEALLOCATE TEMPORARY MEMORY FOR HASH.'
        STOP
      END IF
    ELSE
      CALL HASH_ALLOCATE(H, CAPACITY)
    END IF
  END SUBROUTINE HASH_RESIZE
  ! ---------------------------------------------------------------------------------------------------------------------------------+
  SUBROUTINE HASH_ALLOCATE(H, CAPACITY)
  TYPE(HASH),INTENT(INOUT) :: H
  INTEGER(KIND=4),INTENT(IN)   :: CAPACITY
  INTEGER(KIND=4)              :: IERR
    IF (ALLOCATED(H%HASH)) THEN
      DEALLOCATE(H%HASH,STAT=IERR)
      IF (IERR.NE.0) THEN
        WRITE(0,'(A)') '0*** UNABLE TO DEALLOCATE MEMORY FOR HASH.'
        STOP
      END IF
    END IF
    ALLOCATE(H%HASH(3,CAPACITY),STAT=IERR)
    IF (IERR.NE.0) THEN
      WRITE(0,'(A)') '0*** UNABLE TO ALLOCATE MEMORY FOR HASH.'
      STOP
    END IF
    H%HASH = 0
    H%CAPACITY = CAPACITY
  END SUBROUTINE HASH_ALLOCATE
  ! ---------------------------------------------------------------------------------------------------------------------------------+
  INTEGER(KIND=4) FUNCTION HASH_ADD(H,HASHCODE)
  TYPE(HASH),INTENT(INOUT) :: H
  INTEGER(KIND=4),INTENT(IN)   :: HASHCODE
  INTEGER(KIND=4)              :: I,J
  
    IF (H%COUNT.EQ.0) THEN                   ! Special case where this is the first value.
      H%COUNT = 1
      H%HASH(1,H%COUNT) = HASHCODE
      H%HASH(2,1) = 0
      H%HASH(3,1) = 0
      HASH_ADD = H%COUNT
      RETURN
    ELSE IF (H%COUNT.EQ.SIZE(H%HASH,2)) THEN
      WRITE(0,'(A)') '0*** HASH IS FULL.'
      FLUSH(0)
      STOP
    ENDIF
  
    J = 1                                      ! Start at top of the table.
    DO WHILE (J.LE.H%COUNT)
      IF (J.EQ.0) RETURN
  
      IF (HASHCODE.LT.H%HASH(1,J)) THEN
        I = 2
      ELSE IF (HASHCODE.GT.H%HASH(1,J)) THEN
        I = 3
      ELSE
        I = 0
      END IF
      HASH_ADD = J
      IF (I.EQ.0) RETURN
      
      IF (H%HASH(I,J).EQ.0) THEN
        H%COUNT = H%COUNT + 1
        H%HASH(1,H%COUNT) = HASHCODE
        H%HASH(I,J) = H%COUNT
        HASH_ADD = H%COUNT
        J = 0
      ELSE
        J = H%HASH(I,J)
      END IF
  
    END DO
  
  END FUNCTION HASH_ADD
  ! ---------------------------------------------------------------------------------------------------------------------------------+
  SUBROUTINE HASH_SORT(H, ARRAY, ASCENDING)
  TYPE(HASH), INTENT(IN)                 :: H
  INTEGER(KIND=4),INTENT(INOUT)          :: ARRAY(:)
  LOGICAL(KIND=4),INTENT(IN),   OPTIONAL :: ASCENDING
  INTEGER(KIND=4)                        :: I,C
  
negative.code:   END IF
    I = 1
    C = 0
    CALL BTREE_SORTED(BT,ARRAY,I,C,ASC)
  END SUBROUTINE BTREE_SORT
  ! ---------------------------------------------------------------------------------------------------------------------------------+
  RECURSIVE SUBROUTINE BTREE_SORTED(BT,ARRAY,I,C,ASCENDING)
  TYPE(BTREE), INTENT(IN)       :: BT
  INTEGER(KIND=4),INTENT(INOUT) :: ARRAY(:)
  INTEGER(KIND=4),INTENT(IN)    :: I
  INTEGER(KIND=4),INTENT(INOUT) :: C
  LOGICAL(KIND=4),INTENT(IN)    :: ASCENDING
  IF (ASCENDING) THEN
    IF (BT%TREE(2,I).NE.0) CALL BTREE_SORTED(BT,ARRAY,BT%TREE(2,I),C,ASCENDING)
    IF (C.GT.SIZE(ARRAY)) RETURN
    C = C + 1
    ARRAY(C) = BT%TREE(1,I)
    IF (BT%TREE(3,I).NE.0) CALL BTREE_SORTED(BT,ARRAY,BT%TREE(3,I),C,ASCENDING)
  ELSE
    IF (BT%TREE(3,I).NE.0) CALL BTREE_SORTED(BT,ARRAY,BT%TREE(3,I),C,ASCENDING)
    IF (C.GT.SIZE(ARRAY)) RETURN
    C = C + 1
    ARRAY(C) = BT%TREE(1,I)
    IF (BT%TREE(2,I).NE.0) CALL BTREE_SORTED(BT,ARRAY,BT%TREE(2,I),C,ASCENDING)
  END IF
  END SUBROUTINE BTREE_SORTED
  ! ---------------------------------------------------------------------------------------------------------------------------------+
  END MODULE MODBTREE
  ! ---------------------------------------------------------------------------------------------------------------------------------+
  PROGRAM HASHTEST
  USE MODHASHCODE
  USE MODBTREE
  IMPLICIT NONE
  INTEGER(KIND=4)           :: RES,I,J
  INTEGER(KIND=1),PARAMETER :: IDIV = 11
  