HOPL

C *** A BINARY TREE SORT PROGRAM IN DYSTAL

     DIMENSION LOT(3000), PLOT(3000) , GLOT(300.0)
     COMMON GLOT

     EQUIVALENCE (LOT(l), FLOT(l), GLOT(l))

     EQUIVALENCE (LOT(20),NCTR), (LOT(21),NMAX), (LOT(22),NMOD)
     EQUIVALENCE (LOT(27),NRD), (LOT(28),NPCH),(LOT(29),NPR)
     DEFINE FILE 4 (1000,80,U,JFI)
     CALL INLOT (10,50,3000)

C *** READ IN MOD (WORD TYPE) AND NWD (NUMBER OF WORDS)
C *** THEN READ IN THE LIST OF WORDS

     READ (NRD,2) MOD, NWD
     2 FORMAT (5 114)

     LWD = IDUMP (LRD (NRD, 1, NWD, MAPL (MOD, NWD)))
C *** CREATE LTREE, THE FIRST LIST OF THE TREE.
     LTREE = IPUT (3, 0, MAPL (1, 3))
     CALL IPUT (ITEM (1, LWD), 3, LTREE)
C *** SET UP A DO LOOP TO PROCESS REMAINING WORDS
     DO 100 1=2, NWD

     LIST = LTREE •
C *** COMPARE ITH WORD WITH WORD ON LIST USING ALPHA COMPARISON

     WD = FITEM (I, LWD)

     5 IF (LCOMP (WD, FITEM (3, LIST))) 20, 30, 30
C *** DETERMINE LEFT OR RIGHT BRANCH. LEFT IS LESS THAN.
     20 ICELL =1

     GO TO 31

     30 ICELL =2

     31 CONTINUE

C *** IF CELL IS EMPTY CREATE A LIST AND STORE LIST NAME IN THE CELL
C *** AND WD IN THE LIST.

     IF (ITEM (ICELL, LIST)) 50, 40, 50
     40 NEW = IPUT (3, 0, MAPL (1, 3))
     CALL IPUT (NEW, ICELL, LIST)
     CALL IPUT (WD, 3, NEW)

     TO TO 100
50 CONTINUE

C *** CELL NOT EMPTY. FIND NEXT LIST AND CONTINUE COMPARISON
     - LIST = ITEM (ICELL, LIST)

     GO TO 5
     100 CONTINUE
     CALL EXIT
     END

DYSTAL 2(ID:4040/dys003)

Array-based list-processing for Fortran