Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0146/keywrd.for
There are 4 other files named keywrd.for in the archive. Click here to see a list.
C     RENBR(KEYWRD/CONSTRUCTS KEY WORD RECOGNITION TREE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     The KEYWRD program produces a sequence of tests which
C     can  identify  leading word or phrase in line of text
C     without ever  having  to  test  character  which  has
C     already  been  identified.   Such  leading  words and
C     phrases will be referred  to  as  commands.   Command
C     does  not  need to include any characters to right of
C     first of characters which uniquely identify  command.
C     Word or each of words in phrase can be abbreviated by
C     truncation, leaving at least left character  in  each
C     word   of   phrase   if  additional  words  or  their
C     abbreviations appear to right.   Spaces  are  allowed
C     between  words  in  phrase,  but  are  not  required.
C     Single sequence of tests is used to recognize initial
C     portions  of  commands which start with common series
C     of characters, then unique portion of each command is
C     identified  by  separate  sequence  of  tests.  After
C     unique portion of each command has been identified by
C     separate  sequence  of tests, then single sequence of
C     tests is similarly used to recognize  final  portions
C     of   commands   which   end  with  common  series  of
C     characters.
C
C     KEYWRD program reads single input file  and  produces
C     output  listing file and output FORTRAN language file
C     containing DATA statements which  represent  sequence
C     of  tests.  These DATA statements must be merged into
C     FORTRAN program by which these tests are to be  used.
C     KEYWRD  program is written in FORTRAN, and is machine
C     independent except for short  subroutine  which  asks
C     user for file names and then opens these files.
C
C     Each line in input file which does not start with one
C     of  reserved  characters  *,  /,  (  or  ), which are
C     described  later,  contains  single  word  or  phrase
C     preceded  by nonzero value by which word or phrase is
C     to be identified.  Number should not duplicate number
C     to  be associated with any other command unless these
C     commands  are  synonyms  or  unless  some  of   these
C     commands  are  abbreviations which would otherwise be
C     ambiguous.  Number can be preceded  by  one  or  more
C     spaces,  but leading spaces are not required.  Number
C     cannot contain any characters  other  than  digits  0
C     through 9 and leading minus sign if value is negative
C     or optional leading plus sign if value  is  positive.
C     Spaces and/or single comma can appear between leading
C     number and following word  or  phrase,  but  are  not
C     required.   Words  within phrase must be separated by
C     at least 1 space.  Extra spaces are  ignored.   Words
C     and  phrases  can be constructed from any characters,
C     but upper  and  lower  case  alphabetic  letters  are
C     considered  to  be  equivalent.   Sequence  of  tests
C     produced by KEYWRD program is independent of order in
C     which commands are defined in input file.  Input file
C     is terminated by line containing number which is  not
C     followed on same line by any word or phrase.
C
C     If words and phrases are constructed from  characters
C     other  than  spaces and alphabetic letters through Z,
C     then additional DATA  statement  is  generated  which
C     specifies  third array, LTRXTR, containing unexpected
C     characters.  KNTXTR, which is  specified  by  one  of
C     DATA  statements  which are always generated, is size
C     of  LTRXTR  array.   If   words   and   phrases   are
C     constructed  only  from spaces and alphabetic letters
C     through Z,  then  KNTXTR  has  value  zero  and  DATA
C     statement defining LTRXTR array is not generated.
C
C     First location in NOTPNT array describes  first  test
C     which  is  to  be  performed.  Absolute value of each
C     entry in NOTPNT  array  is  sum  of  location  within
C     alphabet  of  letter  to be matched times (KNTPNT+1),
C     plus subscript of  location  in  NOTPNT  array  which
C     describes  next  match  which  is  to be attempted if
C     current  match  is  failure.   Subscript   of   array
C     location   is   its  serial  position  within  array,
C     counting first value in array as being  at  subscript
C     1,  second  value as being at subscript 2, and so on.
C     If entry in NOTPNT array is negative, then  character
C     starts  word  and  any  spaces  in  input line can be
C     skipped.  If location within alphabet is greater than
C     26,  then  this  minus  26  is location within LTRXTR
C     array of character to be matched.  If match  succeeds
C     and  value  to be associated with command is positive
C     or if value is zero indicating that  match  does  not
C     uniquely  identify  particular command, then parallel
C     location in MCHPNT array contains  sum  of  value  of
C     command  times (KNTPNT+1), plus subscript of location
C     in NOTPNT array which describes next test.  If  match
C     succeeds  and  value to be associated with command is
C     negative, then  parallel  location  in  MCHPNT  array
C     instead  contains  value of command times (KNTPNT+1),
C     minus subscript of location  in  NOTPNT  array  which
C     describes  next  test.   If  subscript of location in
C     NOTPNT array which describes next test  is  indicated
C     to  be  zero, either by MCHPNT array if current match
C     is success or by NOTPNT array  if  current  match  is
C     failure,  then  no  additional  test  remains  to  be
C     performed, and command is identified by last  nonzero
C     value  encountered  in  MCHPNT  array for match which
C     succeeded.
C
C     Lines in input file which start with asterisk, slash,
C     left  parenthesis  or  right  parenthesis are treated
C     specially.  These initial characters cause  following
C     actions to be performed.
C
C     /  Initial slash indicates that line specifies  names
C        of   arrays   and   variables   which  are  to  be
C        represented in DATA statements  which  are  to  be
C        written into output FORTRAN statement file.
C
C     *  Initial asterisk indicates that line  specifies  5
C        numbers   which  characterize  sequence  of  tests
C        produced  by  KEYWRD  program.   Such  line  would
C        appear  in  input file only when result is already
C        known and operation of  KEYWRD  program  is  being
C        verified.   Numbers  can  be  separated  by spaces
C        and/or by single commas.  Sixth group of up  to  6
C        characters defines label to be shown to user.
C
C     (  Initial left parenthesis indicates  that  rest  of
C        current  line  is to be copied into output FORTRAN
C        statement file unchanged.  This does not interrupt
C        specification of glossary of keywords.
C
C     )  Initial  right  parenthesis  indicates  that  DATA
C        statements  which  represent sequence of tests are
C        to be written into output FORTRAN statement  file.
C        This  does  not indicate that end of file has been
C        reached.
C
C     If line starts with slash,  then  next  5  groups  of
C     printing  characters  on  line are used as names of 3
C     arrays and 2 variables which are represented in  DATA
C     statements  which  KEYWRD  program writes into output
C     FORTRAN statement file.   These  groups  of  printing
C     characters  can  be  separated  by  spaces  and/or by
C     single commas.  Names of 3 arrays  must  each  differ
C     from others in their first 3 characters.
C
C     1. First group of up to 6 characters is used as  name
C        of  array  which specifies next operation if match
C        fails.  This name is NOTPNT if line starting  with
C        slash does not appear in input file.
C
C     2. Second group of up to 6 characters is used as name
C        of  array  which specifies next operation if match
C        succeeds.  This name is MCHPNT  if  line  starting
C        with slash does not appear in input file.
C
C     3. Third group of up to 6 characters is used as  name
C        of  nondimensioned  variable which contains number
C        of items in each of previous 2 arrays.  This  name
C        is  KNTPNT  if  line  starting with slash does not
C        appear in input file.
C
C     4. Fourth group of up to 6 characters is used as name
C        of  array  which  specifies  all characters, other
C        than spaces and letters through  Z,  appearing  in
C        commands.   This  name  is LTRXTR if line starting
C        with slash does not appear in input file.
C
C     5. Fifth group of up to 6 characters is used as  name
C        of  nondimensioned  variable which contains number
C        of characters in previous  array.   This  name  is
C        KNTXTR if line starting with slash does not appear
C        in input file.
C
C     *******************************************
C     *                                         *
C     *  DIMENSION STATEMENTS FOR NUMERIC DATA  *
C     *                                         *
C     *******************************************
C
C     VARIABLES AND ARRAYS HAVING NAMES BEGINNING WITH THE
C     LETTER SEQUENCES LTR OR LWR CONTAIN CHARACTER DATA.
C     ALL OTHER VARIABLES AND ARRAYS CONTAIN INTEGERS.
C
C     FOLLOWING ARRAYS ARE DIMENSIONED TO VALUE OF LMTPNT
      DIMENSION IBLOCK(3000),INITAL(3000),ISPELL(3000),
     1          KOMAND(3000),MCHPNT(3000),NOTPNT(3000)
C
C     FOLLOWING ARRAY AND LTRBFR ARE DIMENSIONED AT LMTBFR
      DIMENSION NODLST(80)
C
C     ARRAYS USED FOR ACCUMULATING THE 5 CHECKSUMS
      DIMENSION ICHECK(5),ICOMPR(5)
C
C     *********************************************
C     *                                           *
C     *  DIMENSION STATEMENTS FOR CHARACTER DATA  *
C     *                                           *
C     *********************************************
C
C     FOLLOWING IS DIMENSIONED AT LMTBFR, BUT AT LEAST 45
      DIMENSION LTRBFR(80)
C
C     FOLLOWING ARRAY IS DIMENSIONED AT LMTXTR
      DIMENSION LTRXTR(38)
C
C     FOLLOWING ARRAYS ARE OF FIXED LENGTH
      DIMENSION LTRDGT(10),LTRABC(26),LWRABC(26),
     1          LTR1ST(6) ,LTR2ND(6) ,LTR3RD(6) ,
     2          LTR4TH(6) ,LTR5TH(6) ,LTRLBL(6) ,
     3          LTRONE(6) ,LTRTWO(6) ,LTRTHR(6) ,
     4          LTRFOU(6) ,LTRFIV(6)
C
C     *******************************************
C     *                                         *
C     *  DATA STATEMENTS DEFINING NUMERIC DATA  *
C     *                                         *
C     *******************************************
C
C     UNIT NUMBERS FOR INPUT, OUTPUT, LISTING AND MESSAGES
      DATA IIN,IOUT,ILPT,ITTY/1,20,21,5/
C
C     ARRAY DIMENSIONS
      DATA LMTXTR,LMTBFR,LMTPNT/38,80,3000/
C
C     *********************************************
C     *                                           *
C     *  DATA STATEMENTS DEFINING CHARACTER DATA  *
C     *                                           *
C     *********************************************
C
C     NAME OF ARRAY IN OUTPUT WITH POINTERS WHEN FAILURE
      DATA LTRONE/1HN,1HO,1HT,1HP,1HN,1HT/
C
C     NAME OF ARRAY IN OUTPUT WITH POINTERS FOR WHEN MATCH
      DATA LTRTWO/1HM,1HC,1HH,1HP,1HN,1HT/
C
C     NAME OF THE NUMBER OF ITEMS IN ABOVE 2 ARRAYS
      DATA LTRTHR/1HK,1HN,1HT,1HP,1HN,1HT/
C
C     NAME OF ARRAY WITH UNKNOWN CHARACTERS IN OUTPUT
      DATA LTRFOU/1HL,1HT,1HR,1HX,1HT,1HR/
C
C     NAME OF THE NUMBER OF EXTRA CHARACTERS
      DATA LTRFIV/1HK,1HN,1HT,1HX,1HT,1HR/
C
C     UPPER CASE LETTERS A THROUGH Z
      DATA LTRABC/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     11HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     21HX,1HY,1HZ/
C
C     LOWER CASE LETTERS A THROUGH Z
      DATA LWRABC/1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     11Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     21Hx,1Hy,1Hz/
C
C     DIGITS 0 THROUGH 9
      DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C     VARIOUS PUNCTUATION MARKS
      DATA LTRCMA,LTRLFT,LTRMNS,LTRPLS,LTRRIT,LTRSLA,
     1LTRSPC,LTRSTR/1H,,1H(,1H-,1H+,1H),1H/,1H ,1H*/
C
C     ASK USER FOR FILE NAMES AND OPEN THESE FILES
      CALL KEYOPN(ITTY,IIN,IOUT,ILPT)
C
C     RESET VARIOUS ITEMS WHICH ARE GLOBAL AND CHANGE
    1 KNTPNT=0
      MAXKIL=0
      MAXSPL=0
      KNTXTR=0
      IEOF=0
      LNGLBL=0
      DO 2 I=1,5
    2 ICOMPR(I)=0
      DO 3 I=1,6
      LTR1ST(I)=LTRONE(I)
      LTR2ND(I)=LTRTWO(I)
      LTR3RD(I)=LTRTHR(I)
      LTR4TH(I)=LTRFOU(I)
    3 LTR5TH(I)=LTRFIV(I)
C
C     *************************************
C     *                                   *
C     *  READ IN NEXT LINE OF INPUT FILE  *
C     *                                   *
C     *************************************
C
C     READ NEXT LINE FROM INPUT FILE
    4 READ(IIN,5,END=74)LTRBFR
    5 FORMAT(80A1)
C
C     CHECK IF FIRST PRINTING CHARACTER IS SPECIAL
      INDEX=0
    6 INDEX=INDEX+1
      IF(INDEX.GT.LMTBFR)GO TO 4
      LTRNOW=LTRBFR(INDEX)
      IF(LTRNOW.EQ.LTRSPC)GO TO 6
      IF(LTRNOW.EQ.LTRLFT)GO TO 8
      IF(LTRNOW.EQ.LTRRIT)GO TO 7
      IF(LTRNOW.EQ.LTRSLA)GO TO 12
      IF(LTRNOW.EQ.LTRSTR)GO TO 13
      GO TO 39
C
C     DUMP GLOSSARY, THEN CONTINUE IF LINE STARTS WITH )
    7 IEOF=1
      GO TO 74
C
C     WRITE OUT REST OF LINE STARTING WITH (
    8 KOPIED=INDEX
      MAXPRT=KOPIED
      INDEX=INDEX+1
    9 KOPIED=KOPIED+1
      IF(KOPIED.GT.LMTBFR)GO TO 10
      IF(LTRBFR(KOPIED).NE.LTRSPC)MAXPRT=KOPIED
      GO TO 9
   10 IF(MAXPRT.GE.INDEX)WRITE(IOUT,11)(LTRBFR(I),I=INDEX,MAXPRT)
   11 FORMAT(80A1)
      GO TO 4
C
C     ************************************************
C     *                                              *
C     *  GET NAMES OF ARRAYS OR VALUES OF CHECKSUMS  *
C     *                                              *
C     ************************************************
C
   12 KNDDEF=0
      GO TO 14
   13 KNDDEF=1
   14 IFSPAC=0
      KNTDEF=0
C
C     GET NEXT GROUP OF PRINTING CHARACTERS
   15 INDEX=INDEX+1
      IF(INDEX.GT.LMTBFR)GO TO 16
      IF(IFSPAC.GT.0)GO TO 19
      IF(LTRBFR(INDEX).EQ.LTRSPC)GO TO 15
      IF(LTRBFR(INDEX).NE.LTRCMA)GO TO 18
      IF(IFSPAC.EQ.0)GO TO 17
      KNTDEF=KNTDEF+1
      GO TO 15
   16 IF(IFSPAC.GT.0)GO TO 21
      GO TO 4
   17 IFSPAC=-1
      GO TO 15
   18 MINPRT=INDEX
      MAXPRT=INDEX
      KNTDEF=KNTDEF+1
      IFSPAC=1
      GO TO 15
   19 IF(LTRBFR(INDEX).EQ.LTRPLS)GO TO 20
      IF(LTRBFR(INDEX).EQ.LTRMNS)GO TO 20
      IF(LTRBFR(INDEX).EQ.LTRSPC)GO TO 21
      IF(LTRBFR(INDEX).EQ.LTRCMA)GO TO 22
      MAXPRT=INDEX
      GO TO 15
   20 INDEX=INDEX-1
   21 IFSPAC=0
      GO TO 23
   22 IFSPAC=-1
   23 IF(KNDDEF.NE.0)GO TO 34
C
C     STORE THE NAME OF THE ARRAY OR VARIABLE
      IF(KNTDEF.GT.5)GO TO 4
      GO TO(24,26,28,30,32),KNTDEF
   24 DO 25 I=1,6
      LTR1ST(I)=LTRSPC
      IF(MINPRT.LE.MAXPRT)LTR1ST(I)=LTRBFR(MINPRT)
   25 MINPRT=MINPRT+1
      GO TO 15
   26 DO 27 I=1,6
      LTR2ND(I)=LTRSPC
      IF(MINPRT.LE.MAXPRT)LTR2ND(I)=LTRBFR(MINPRT)
   27 MINPRT=MINPRT+1
      GO TO 15
   28 DO 29 I=1,6
      LTR3RD(I)=LTRSPC
      IF(MINPRT.LE.MAXPRT)LTR3RD(I)=LTRBFR(MINPRT)
   29 MINPRT=MINPRT+1
      GO TO 15
   30 DO 31 I=1,6
      LTR4TH(I)=LTRSPC
      IF(MINPRT.LE.MAXPRT)LTR4TH(I)=LTRBFR(MINPRT)
   31 MINPRT=MINPRT+1
      GO TO 15
   32 DO 33 I=1,6
      LTR5TH(I)=LTRSPC
      IF(MINPRT.LE.MAXPRT)LTR5TH(I)=LTRBFR(MINPRT)
   33 MINPRT=MINPRT+1
      GO TO 15
C
C     GET VALUE OF PREDICTED CHECKSUM
   34 IF(KNTDEF.GT.6)GO TO 4
      IF(KNTDEF.EQ.6)GO TO 37
      NUMBER=0
      IMINUS=0
      DO 36 I=MINPRT,MAXPRT
      LTRNOW=LTRBFR(I)
      DO 35 J=1,10
      IF(LTRNOW.NE.LTRDGT(J))GO TO 35
      NUMBER=(10*NUMBER)+J-1
      GO TO 36
   35 CONTINUE
      IF(LTRNOW.EQ.LTRMNS)IMINUS=1
   36 CONTINUE
      IF(IMINUS.NE.0)NUMBER=-NUMBER
      ICOMPR(KNTDEF)=NUMBER
      GO TO 15
C
C     STORE THE NAME OF THE CURRENT TEST GLOSSARY
   37 LNGLBL=0
   38 IF(MINPRT.GT.MAXPRT)GO TO 15
      IF(LNGLBL.GE.6)GO TO 15
      LNGLBL=LNGLBL+1
      LTRLBL(LNGLBL)=LTRBFR(MINPRT)
      MINPRT=MINPRT+1
      GO TO 38
C
C     *********************************
C     *                               *
C     *  GET VALUE OF LEADING NUMBER  *
C     *                               *
C     *********************************
C
C     EVALUATE LEADING NUMBER
   39 INDEX=INDEX-1
      IMINUS=0
      NUMBER=0
   40 INDEX=INDEX+1
      IF(INDEX.GT.LMTBFR)GO TO 74
      LTRNOW=LTRBFR(INDEX)
      IF(LTRNOW.EQ.LTRSPC)GO TO 42
      DO 41 I=1,10
      IF(LTRNOW.NE.LTRDGT(I))GO TO 41
      IF(IMINUS.EQ.0)IMINUS=1
      NUMBER=(10*NUMBER)+I-1
      GO TO 40
   41 CONTINUE
      IF(IMINUS.NE.0)GO TO 43
      IF(LTRNOW.EQ.LTRMNS)IMINUS=-1
      IF(LTRNOW.EQ.LTRPLS)IMINUS=1
      IF(IMINUS.NE.0)GO TO 40
      GO TO 45
   42 IF(IMINUS.EQ.0)GO TO 40
   43 IF(IMINUS.LT.0)NUMBER=-NUMBER
      GO TO 45
C
C     SKIP OVER COMMA, IF ANY, BETWEEN NUMBER AND WORD
   44 INDEX=INDEX+1
      IF(INDEX.GT.LMTBFR)GO TO 74
   45 IF(LTRBFR(INDEX).EQ.LTRSPC)GO TO 44
      IF(LTRBFR(INDEX).EQ.LTRCMA)INDEX=INDEX+1
C
C     ****************************************************
C     *                                                  *
C     *  CONVERT LETTERS INTO NUMBERS, EXCLUDING SPACES  *
C     *                                                  *
C     ****************************************************
C
      MAXPRT=0
      INDEX=INDEX-1
      KOPIED=0
      KLMRIT=INDEX
C
C     GET NEXT CHARACTER TO BE CONVERTED TO NUMBER
   46 INDEX=INDEX+1
      IF(INDEX.GT.LMTBFR)GO TO 53
      LTRNOW=LTRBFR(INDEX)
      IF(LTRNOW.EQ.LTRSPC)GO TO 50
      KLMRIT=INDEX
C
C     TEST IF CHARACTER IS ALPHABETIC LETTER A THROUGH Z
      KOMPAR=0
   47 KOMPAR=KOMPAR+1
      IF(LTRNOW.EQ.LTRABC(KOMPAR))GO TO 52
      IF(LTRNOW.EQ.LWRABC(KOMPAR))GO TO 52
      IF(KOMPAR.LT.26)GO TO 47
C
C     TEST IF CHARACTER NOT A THRU Z IS ALREADY IN LTRXTR
      IEXTRA=0
   48 KOMPAR=KOMPAR+1
      IEXTRA=IEXTRA+1
      IF(IEXTRA.GT.KNTXTR)GO TO 49
      IF(LTRNOW.NE.LTRXTR(IEXTRA))GO TO 48
      GO TO 52
C
C     IF COMPLETELY UNKNOWN CHARACTER, STORE IT IN LTRXTR
   49 IF(IEXTRA.LE.LMTXTR)GO TO 51
   50 IF(KOPIED.LE.0)GO TO 46
      IF(NODLST(KOPIED).EQ.0)GO TO 46
      KOPIED=KOPIED+1
      NODLST(KOPIED)=0
      GO TO 46
C
C     ADD NUMBER TO LIST ALREADY GOTTEN FOR THIS COMMAND
   51 KNTXTR=KNTXTR+1
      LTRXTR(KNTXTR)=LTRNOW
   52 KOPIED=KOPIED+1
      MAXPRT=KOPIED
      NODLST(KOPIED)=KOMPAR
      GO TO 46
C
C     COPY INPUT LINE TO OUTPUT FORTRAN COMMENT LINE
   53 IF(MAXPRT.LE.0)GO TO 74
      WRITE(IOUT,54)(LTRBFR(I),I=1,KLMRIT)
   54 FORMAT(6HC     ,80A1)
C
C     **********************************************
C     *                                            *
C     *  CONVERT COMMAND INTO BACK POINTING NODES  *
C     *                                            *
C     **********************************************
C
      INDEX=0
      KNTPRT=0
      LSTPRT=1
C
C     GET NEXT CHARACTER OF COMMAND
   55 INDEX=INDEX+1
      IF(INDEX.GT.MAXPRT)GO TO 60
      IF(NODLST(INDEX).EQ.0)GO TO 57
C
C     1ST WORD OR ALL BUT 1ST CHARACTER IN SUBSEQUENT WORD
      KNTPRT=KNTPRT+1
      DO 56 LOOP=1,LSTPRT
      IF(KNTPNT.GE.LMTPNT)GO TO 72
      KNTPNT=KNTPNT+1
      INITAL(KNTPNT)=0
      IBLOCK(KNTPNT)=0
      IF(INDEX.EQ.MAXPRT)IBLOCK(KNTPNT)=1
      KOMAND(KNTPNT)=NUMBER
      ISPELL(KNTPNT)=NODLST(INDEX)
      MCHPNT(KNTPNT)=0
      IF(INDEX.GT.1)MCHPNT(KNTPNT)=KNTPNT-LSTPRT
      NOTPNT(KNTPNT)=0
   56 CONTINUE
      GO TO 55
C
C     1ST CHARACTER OF 2ND OR SUBSEQUENT WORD
   57 INDEX=INDEX+1
      KNTPRT=KNTPRT*LSTPRT
      DO 59 LOOP=1,KNTPRT
      IF(KNTPNT.GE.LMTPNT)GO TO 72
      KNTPNT=KNTPNT+1
      ISPELL(KNTPNT)=NODLST(INDEX)
      KOMAND(KNTPNT)=NUMBER
      INITAL(KNTPNT)=1
      IBLOCK(KNTPNT)=0
      IF(INDEX.EQ.MAXPRT)IBLOCK(KNTPNT)=1
      IF(LOOP.GT.LSTPRT)GO TO 58
C
C     1ST CHARACTER IN WORD FROM SUCCESS OF LAST IN FORMER
      MCHPNT(KNTPNT)=KNTPNT-LSTPRT
      NOTPNT(KNTPNT)=0
      GO TO 59
C
C     1ST IN WORD FROM FAILURES OF ALL BUT 1ST OF FORMER
   58 MCHPNT(KNTPNT)=0
      NOTPNT(KNTPNT)=KNTPNT-KNTPRT
   59 CONTINUE
      LSTPRT=KNTPRT
      KNTPRT=1
      GO TO 55
C
C     ****************************************************
C     *                                                  *
C     *  PRUNE IDENTICAL ROOTS FROM THE TREE STRUCTURES  *
C     *                                                  *
C     ****************************************************
C
   60 IF(MAXSPL.LT.KNTPNT)MAXSPL=KNTPNT
   61 KILL=MAXKIL
      LSTSPL=KNTPNT
C
C     GET NEXT NODE IN NEW TREE
   62 KILL=KILL+1
      IF(KILL.GT.KNTPNT)GO TO 71
C
C     TEST IF NEXT NODE IN NEW TREE MATCHES ANY IN OLD
      KEEP=0
   63 KEEP=KEEP+1
      IF(KEEP.GT.MAXKIL)GO TO 62
      IF(ISPELL(KEEP).NE.ISPELL(KILL))GO TO 63
      IF(MCHPNT(KEEP).NE.MCHPNT(KILL))GO TO 63
      IF(NOTPNT(KEEP).NE.NOTPNT(KILL))GO TO 63
      IF(INITAL(KEEP).NE.INITAL(KILL))GO TO 63
      KNTPNT=KNTPNT-1
C
C     DETERMINE IF NODE IS VITAL TO EITHER COMMAND.
C     IBLOCK = 0 MEANS LETTER IS NOT LAST IN COMMAND.
C     IBLOCK = 1 MEANS LETTER IS LAST IN COMMAND.
C     IBLOCK = -1 MEANS LETTER WAS LAST IN A COMMAND  WHICH
C              WAS  COMPLETELY ABSORBED BY ANOTHER COMMAND,
C              BUT THE VALUE OF THE  ABSORBED  COMMAND  HAS
C              BEEN RETAINED.
C     THE LOGIC HERE IS
C     A. IF IBLOCK  FOR  BOTH  NODES  IS  NONZERO  AND  THE
C        COMMAND  VALUES ARE EQUAL, THEN THE INPUT FILE MAY
C        HAVE CONTAINED THE SAME LINE TWICE AND IBLOCK  FOR
C        THE KEPT NODE IS SET TO -1 IF IT WAS -1 FOR EITHER
C        NODE OR IS LEFT AT 1 IF BOTH WERE 1.
C     B. IF IBLOCK  FOR  BOTH  NODES  IS  NONZERO  AND  THE
C        COMMAND   VALUES   DIFFER,  THEN  THE  INPUT  FILE
C        SPECIFIES THE SAME COMMAND AS HAVING  2  DIFFERENT
C        VALUES  SO IBLOCK IS ZEROED, AND THE COMMAND VALUE
C        IS ZEROED.
C     C. IF IBLOCK FOR THE KEPT NODE  IS  NONZERO,  BUT  IS
C        ZERO  FOR THE KILLED NODE, THEN THE OLD COMMAND IS
C        BEING ABSORBED BY THE NEW, AND IBLOCK IS SET TO -1
C        FOR  THE  KEPT  NODE  AND THE COMMAND VALUE OF THE
C        KEPT NODE IS RETAINED.
C     D. IF IBLOCK FOR  THE  KEPT  NODE  IS  ZERO,  BUT  IS
C        NONZERO  FOR THE KILLED NODE, THEN THE NEW COMMAND
C        IS BEING ABSORBED BY THE OLD, AND IBLOCK IS SET TO
C        -1  FOR THE KEPT NODE AND THE COMMAND VALUE OF THE
C        KEPT NODE IS CHANGED TO THAT OF THE KILLED NODE.
C     E. IF IBLOCK IS ZERO FOR  BOTH  NODES,  THEN  NEITHER
C        LETTER IS AT THE END OF A COMMAND AND THE VALUE OF
C        THE  RETAINED  COMMAND IS  ZEROED IF  THESE VALUES
C        DIFFER OR IS UNCHANGED IF THESE ARE THE SAME.
      IF(KOMAND(KEEP).NE.KOMAND(KILL))GO TO 64
      IF(IBLOCK(KEEP).LT.0)GO TO 69
      IF(IBLOCK(KILL).EQ.0)GO TO 69
      IBLOCK(KEEP)=IBLOCK(KILL)
      GO TO 69
   64 IF(IBLOCK(KEEP).NE.0)GO TO 65
      IF(IBLOCK(KILL).EQ.0)GO TO 66
      GO TO 67
   65 IF(IBLOCK(KILL).EQ.0)GO TO 68
      IBLOCK(KEEP)=0
   66 KOMAND(KEEP)=0
      GO TO 69
   67 KOMAND(KEEP)=KOMAND(KILL)
   68 IBLOCK(KEEP)=-1
C
C     SHIFT REST OF NEW TREE DOWN INTO NEWLY VACANT SPACE
   69 IF(KILL.GT.KNTPNT)GO TO 71
      DO 70 I=KILL,KNTPNT
      IBLOCK(I)=IBLOCK(I+1)
      INITAL(I)=INITAL(I+1)
      KOMAND(I)=KOMAND(I+1)
      ISPELL(I)=ISPELL(I+1)
      MCHPNT(I)=MCHPNT(I+1)
      NOTPNT(I)=NOTPNT(I+1)
      IF(MCHPNT(I).EQ.KILL)MCHPNT(I)=KEEP
      IF(MCHPNT(I).GT.KILL)MCHPNT(I)=MCHPNT(I)-1
      IF(NOTPNT(I).EQ.KILL)NOTPNT(I)=KEEP
      IF(NOTPNT(I).GT.KILL)NOTPNT(I)=NOTPNT(I)-1
   70 CONTINUE
      GO TO 63
C
C     GO BACK FOR ANOTHER PASS IF ANY REMOVED THIS TIME
   71 IF(LSTSPL.NE.KNTPNT)GO TO 61
      MAXKIL=KNTPNT
      GO TO 4
C
C     RETURN TO SIZE OF OLD TREE IF NEW TREE OVERFLOWS
   72 KNTPNT=MAXKIL
      WRITE(ITTY,73)LMTPNT
   73 FORMAT(42H GLOSSARY TOO LARGE FOR ARRAYS DIMENSIONED,
     11I6)
C
C     ************************************************
C     *                                              *
C     *  JOIN TREES WITH DIFFERENT LETTERS AT ROOTS  *
C     *                                              *
C     ************************************************
C
   74 IF(KNTPNT.LE.0)GO TO 209
      INDEX=1
   75 INDEX=INDEX+1
      IF(INDEX.GT.KNTPNT)GO TO 76
      IF(MCHPNT(INDEX).NE.0)GO TO 75
      IF(NOTPNT(INDEX).NE.0)GO TO 75
      NOTPNT(INDEX)=1
      GO TO 75
C
C     ****************************************************
C     *                                                  *
C     *  CONVERT FROM BACK TO FORWARD POINTING NOTATION  *
C     *                                                  *
C     ****************************************************
C
   76 IBEGIN=1
      INDEX=0
   77 INDEX=INDEX+1
      IF(INDEX.GT.KNTPNT)GO TO 95
      NOTVAL=NOTPNT(INDEX)
      MCHVAL=MCHPNT(INDEX)
      NOTPNT(INDEX)=0
      MCHPNT(INDEX)=0
C
C     CHECK IF THERE IS A FAILURE LINK TO BE REVERSED
      IF(NOTVAL.EQ.0)GO TO 87
      IF(NOTVAL.GE.INDEX)GO TO 87
C
C     IS FAILURE TRANSFER FROM LETTER HIGHER IN ALPHABET
      IF(INITAL(INDEX).EQ.INITAL(NOTVAL))GO TO 78
      IF(INITAL(INDEX).NE.0)GO TO 83
      GO TO 79
   78 IF(ISPELL(INDEX).GE.ISPELL(NOTVAL))GO TO 83
C
C     IF FROM HIGHER, PLACE NEW EARLIER IN FAILURE CHAIN
   79 NOTPNT(INDEX)=NOTVAL
      I=0
   80 I=I+1
      IF(I.GE.INDEX)GO TO 81
      IF(MCHPNT(I).EQ.NOTVAL)MCHPNT(I)=INDEX
      GO TO 80
   81 IF(NOTVAL.NE.IBEGIN)GO TO 87
      IBEGIN=INDEX
      I=INDEX
   82 I=I+1
      IF(I.GT.KNTPNT)GO TO 87
      IF(NOTPNT(I).EQ.NOTVAL)NOTPNT(I)=INDEX
      GO TO 82
C
C     IF FROM LOWER, FIND PROPER PLACE IN FAILURE CAHIN
   83 IFORMR=NOTVAL
      NOTVAL=NOTPNT(NOTVAL)
      IF(NOTVAL.GE.INDEX)GO TO 87
      IF(NOTVAL.NE.0)GO TO 84
      NOTPNT(IFORMR)=INDEX
      GO TO 87
   84 IF(INITAL(INDEX).EQ.INITAL(NOTVAL))GO TO 85
      IF(INITAL(INDEX).NE.0)GO TO 83
      GO TO 86
   85 IF(ISPELL(INDEX).GE.ISPELL(NOTVAL))GO TO 83
   86 NOTPNT(IFORMR)=INDEX
      NOTPNT(INDEX)=NOTVAL
C
C     CHECK IF THERE IS A SUCCESS TRANSFER TO BE REVERSED
   87 IF(MCHVAL.EQ.0)GO TO 77
      IF(MCHVAL.GE.INDEX)GO TO 77
      IF(MCHPNT(MCHVAL).GE.INDEX)GO TO 77
C
C     IF NONE YET FROM FORMER, JUST PATCH IN NEW NODE
      IF(MCHPNT(MCHVAL).NE.0)GO TO 88
      MCHPNT(MCHVAL)=INDEX
      GO TO 77
C
C     IF ALREADY A SUCCESS TRANSFER FROM FORMER, THEN MUST
C     FIND THE POSITION IN FAILURE CHAIN FROM THE EXISTING
C     SUCCESS TRANSFER FOR THE NEW NODE
   88 IFORMR=MCHVAL
      MCHVAL=MCHPNT(MCHVAL)
      IF(MCHVAL.GE.INDEX)GO TO 77
C
C     TEST IF NEW NODE IS LOWER THAN NODE AT START OF THE
C     FAILURE CHAIN.  IF SO, MAKE NEW NODE BE THE START
C     OF THE FAILURE CHAIN
      IF(INITAL(INDEX).EQ.INITAL(MCHVAL))GO TO 89
      IF(INITAL(INDEX).NE.0)GO TO 91
      GO TO 90
   89 IF(ISPELL(INDEX).GE.ISPELL(MCHVAL))GO TO 91
   90 MCHPNT(IFORMR)=INDEX
      NOTPNT(INDEX)=MCHVAL
      GO TO 77
C
C     NEW IS HIGHER THAN FIRST IN CHAIN, SO SEARCH FOR
C     POSITION OF NEW NEW IN CHAIN AND MAKE PATCH TO CHAIN
   91 IFORMR=MCHVAL
      MCHVAL=NOTPNT(MCHVAL)
      IF(MCHVAL.GE.INDEX)GO TO 77
      IF(MCHVAL.NE.0)GO TO 92
      NOTPNT(IFORMR)=INDEX
      GO TO 77
   92 IF(INITAL(INDEX).EQ.INITAL(MCHVAL))GO TO 93
      IF(INITAL(INDEX).NE.0)GO TO 91
      GO TO 94
   93 IF(ISPELL(INDEX).GE.ISPELL(MCHVAL))GO TO 91
   94 NOTPNT(IFORMR)=INDEX
      NOTPNT(INDEX)=MCHVAL
      GO TO 77
C
C     ***********************************************
C     *                                             *
C     *  REMOVE DUPLICATE LETTERS IN FAILURE LISTS  *
C     *                                             *
C     ***********************************************
C
   95 KEEP=0
      LSTSPL=KNTPNT
   96 KEEP=KEEP+1
   97 IF(KEEP.GT.KNTPNT)GO TO 115
C
C     CHECK IF ANY DUPLICATE APPEARS IN FAILURE CHAIN
      INNER=KEEP
   98 IFORMR=INNER
      INNER=NOTPNT(INNER)
      IF(INNER.EQ.0)GO TO 96
      IF(ISPELL(KEEP).NE.ISPELL(INNER))GO TO 98
      IF(INITAL(KEEP).NE.INITAL(INNER))GO TO 98
      IF(KOMAND(KEEP).EQ.KOMAND(INNER))GO TO 99
C
C     FIND WHICH DUPLICATE NODE IS MOST IMPORTANT
      IF(IBLOCK(KEEP).LT.0)GO TO 99
      KOMAND(KEEP)=0
      IF(IBLOCK(INNER).GE.0)GO TO 99
      KOMAND(KEEP)=KOMAND(INNER)
      IBLOCK(KEEP)=-1
   99 KILL=INNER
C
C     PATCH FAILURE CHAIN AROUND DUPLICATE
      NOTPNT(IFORMR)=NOTPNT(INNER)
C
C     CAN SUCCESS CHAIN FROM KILLED NODE GRAFT TO KEPT NODE
      IF(MCHPNT(KEEP).NE.0)GO TO 100
      MCHPNT(KEEP)=MCHPNT(KILL)
      GO TO 108
C
C     IF KEPT NODE HAS SUCCESS CHAIN, MUST MERGE BOTH
  100 IGRAFT=MCHPNT(KILL)
      IF(IGRAFT.EQ.0)GO TO 108
      INNER=MCHPNT(KEEP)
C
C     INTERCHANGE FAILURE LISTS STARTING AT THE SUCCESS
C     TRANSFERS IF ONE EXTENDING FROM KILLED NODE STARTS
C     LOWER IN ALPHABET
      IF(INITAL(IGRAFT).EQ.INITAL(INNER))GO TO 101
      IF(INITAL(IGRAFT).NE.0)GO TO 103
      GO TO 102
  101 IF(ISPELL(IGRAFT).GE.ISPELL(INNER))GO TO 103
  102 MCHPNT(KEEP)=IGRAFT
      I=INNER
      INNER=IGRAFT
      IGRAFT=I
C
C     WEAVE FAILURE LISTS EXTENDING FROM SUCCESS TRANSFERS
  103 IFORMR=INNER
      INNER=NOTPNT(INNER)
      IF(INNER.EQ.0)GO TO 107
  104 IF(INITAL(IGRAFT).EQ.INITAL(INNER))GO TO 105
      IF(INITAL(IGRAFT).NE.0)GO TO 103
      GO TO 106
  105 IF(ISPELL(IGRAFT).GE.ISPELL(INNER))GO TO 103
  106 NOTPNT(IFORMR)=IGRAFT
      IFORMR=IGRAFT
      IGRAFT=NOTPNT(IGRAFT)
      NOTPNT(IFORMR)=INNER
      IF(IGRAFT.NE.0)GO TO 104
      GO TO 108
  107 NOTPNT(IFORMR)=IGRAFT
C
C     MOVE NODE AT END OF ARRAYS DOWN TO POSITION WHICH
C     WAS OCCUPIED BY NODE BEING KILLED
  108 IBLOCK(KILL)=IBLOCK(KNTPNT)
      INITAL(KILL)=INITAL(KNTPNT)
      ISPELL(KILL)=ISPELL(KNTPNT)
      KOMAND(KILL)=KOMAND(KNTPNT)
      MCHPNT(KILL)=MCHPNT(KNTPNT)
      NOTPNT(KILL)=NOTPNT(KNTPNT)
C
C     CHANGE ALL POINTERS TO EITHER NODE BEING KILLED OR TO
C     THE NODE WHICH WAS AT TOP OF ARRAYS BUT IS NOW IN THE
C     FORMER POISTION OF THE NODE BEING KILLED
      DO 112 I=1,KNTPNT
      J=MCHPNT(I)
      IF(J.NE.KILL)GO TO 109
      MCHPNT(I)=KEEP
      GO TO 110
  109 IF(J.EQ.KNTPNT)MCHPNT(I)=KILL
  110 J=NOTPNT(I)
      IF(J.NE.KILL)GO TO 111
      NOTPNT(I)=KEEP
      GO TO 112
  111 IF(J.EQ.KNTPNT)NOTPNT(I)=KILL
  112 CONTINUE
C
C     CHECK IF NODE AT ROOT OF TREE WAS SHIFTED
      IF(IBEGIN.NE.KILL)GO TO 113
      IBEGIN=KEEP
      GO TO 114
  113 IF(IBEGIN.EQ.KNTPNT)IBEGIN=KILL
C
C     REDUCE SIZE OF TREE BY ONE NODE, THEN CONTINUE SEARCH
  114 KNTPNT=KNTPNT-1
      GO TO 97
  115 IF(LSTSPL.NE.KNTPNT)GO TO 95
C
C     ****************************************************
C     *                                                  *
C     *  MARK THE LOWEST UNIQUE LETTERS IN EACH COMMAND  *
C     *                                                  *
C     ****************************************************
C
C     PRESERVE BLOCKS AT ENDS OF COMPLETELY ABSORBED WORDS
      DO 116 I=1,KNTPNT
      IF(IBLOCK(I).GT.0)IBLOCK(I)=0
  116 CONTINUE
C
C     LOOK FOR LETTERS BEYOND NODES IN MERGED ROOTS
      INDEX=0
  117 INDEX=INDEX+1
      IF(INDEX.GT.KNTPNT)GO TO 121
      IF(IBLOCK(INDEX).LT.0)GO TO 118
      IF(KOMAND(INDEX).NE.0)GO TO 117
  118 I=MCHPNT(INDEX)
      IF(I.LE.0)GO TO 117
  119 IF(IBLOCK(I).NE.0)GO TO 120
      IF(KOMAND(I).NE.0)IBLOCK(I)=1
  120 I=NOTPNT(I)
      IF(I.NE.0)GO TO 119
      GO TO 117
C
C     **************************************************
C     *                                                *
C     *  PRUNE IDENTICAL BRANCHES FROM TREE STRUCTURE  *
C     *                                                *
C     **************************************************
C
C
C     DO NOT PRUNE DIFFERENT BLOCKAGES OF SAME COMMAND
  121 IPASS=0
C
C     GET REFERENCE NODE
  122 KEEP=KNTPNT
      LSTSPL=KNTPNT
  123 KEEP=KEEP-1
      IF(KEEP.LE.1)GO TO 136
C
C     CHECK IF ANY NODE IS SAME AS REFERENCE NODE
      KILL=KEEP
  124 KILL=KILL+1
  125 IF(KILL.GT.KNTPNT)GO TO 123
      IF(ISPELL(KILL).NE.ISPELL(KEEP))GO TO 124
      IF(MCHPNT(KILL).NE.MCHPNT(KEEP))GO TO 124
      IF(NOTPNT(KILL).NE.NOTPNT(KEEP))GO TO 124
      IF(INITAL(KILL).NE.INITAL(KEEP))GO TO 124
      IF(KOMAND(KILL).NE.KOMAND(KEEP))GO TO 128
      IF(IPASS.NE.0)GO TO 127
      IF(IBLOCK(KEEP).NE.0)GO TO 126
      IF(IBLOCK(KILL).NE.0)GO TO 124
      GO TO 129
  126 IF(IBLOCK(KILL).EQ.0)GO TO 124
      GO TO 129
  127 IF(IBLOCK(KILL).NE.0)IBLOCK(KEEP)=1
      GO TO 129
  128 IF(IBLOCK(KEEP).NE.0)GO TO 124
      IF(IBLOCK(KILL).NE.0)GO TO 124
      KOMAND(KEEP)=0
C
C     MOVE NODE AT END OF TREE TO POSITION OF KILLED NODE
  129 IBLOCK(KILL)=IBLOCK(KNTPNT)
      INITAL(KILL)=INITAL(KNTPNT)
      ISPELL(KILL)=ISPELL(KNTPNT)
      KOMAND(KILL)=KOMAND(KNTPNT)
      MCHPNT(KILL)=MCHPNT(KNTPNT)
      NOTPNT(KILL)=NOTPNT(KNTPNT)
C
C     PATCH POINTERS TO KILLED NODE OR NODE AT TOP OF TREE
      DO 133 I=1,KNTPNT
      J=MCHPNT(I)
      IF(J.NE.KILL)GO TO 130
      MCHPNT(I)=KEEP
      GO TO 131
  130 IF(J.EQ.KNTPNT)MCHPNT(I)=KILL
  131 J=NOTPNT(I)
      IF(J.NE.KILL)GO TO 132
      NOTPNT(I)=KEEP
      GO TO 133
  132 IF(J.EQ.KNTPNT)NOTPNT(I)=KILL
  133 CONTINUE
C
C     CHECK IF NODE AT ROOT OF TREE WAS SHIFTED
      IF(IBEGIN.NE.KILL)GO TO 134
      IBEGIN=KEEP
      GO TO 135
  134 IF(IBEGIN.EQ.KNTPNT)IBEGIN=KILL
C
C     REDUCE SIZE OF TREE BY ONE NODE, THEN CONTINUE SEARCH
  135 KNTPNT=KNTPNT-1
      GO TO 125
C
C     CHECK IF ANY NODE WAS REMOVED IN THIS SEARCH
  136 IF(LSTSPL.NE.KNTPNT)GO TO 121
C
C     ALLOW PRUNING DIFFERENT BLOCKAGES OF SAME COMMAND
      IPASS=1-IPASS
      IF(IPASS.NE.0)GO TO 122
C
C     MARK FIRST CHARACTERS IN COMMANDS AS FIRST IN WORDS
      INDEX=IBEGIN
  137 INITAL(INDEX)=1
      INDEX=NOTPNT(INDEX)
      IF(INDEX.GT.0)GO TO 137
C
C     ****************************************************
C     *                                                  *
C     *  DETERMINE ORDER IN WHICH NODES ARE ENCOUNTERED  *
C     *                                                  *
C     ****************************************************
C
C     MARK THAT NO NODES ARE IN KNOWN POSITIONS
      DO 138 I=1,KNTPNT
  138 IBLOCK(I)=0
      KNTSRT=0
      MCHNOW=IBEGIN
      NODKNT=0
C
C     STORE NEXT NODE ON LIST OF NODES IN CURRENT COMMAND
  139 NODKNT=NODKNT+1
      NODLST(NODKNT)=MCHNOW
C
C     MARK THAT NODE JUST FOUND IS TO BE HIGHEST SO FAR
      KOMPAR=IBLOCK(MCHNOW)
      IF(KOMPAR.NE.0)GO TO 140
      KNTSRT=KNTSRT+1
      GO TO 142
  140 IF(KOMPAR.EQ.KNTSRT)GO TO 143
      DO 141 I=1,KNTPNT
      IF(IBLOCK(I).GT.KOMPAR)IBLOCK(I)=IBLOCK(I)-1
  141 CONTINUE
  142 IBLOCK(MCHNOW)=KNTSRT
C
C     GET NEXT NODE IN CURRENT COMMAND
  143 MCHNOW=MCHPNT(MCHNOW)
      IF(MCHNOW.GT.0)GO TO 139
C
C     GET NEXT NODE IN NEXT COMMAND
  144 MCHNOW=NODLST(NODKNT)
      NODKNT=NODKNT-1
      MCHNOW=NOTPNT(MCHNOW)
      IF(MCHNOW.GT.0)GO TO 139
      IF(NODKNT.GT.0)GO TO 144
C
C     *****************************************************
C     *                                                   *
C     *  REARRANGE NODES INTO ORDER IN WHICH ENCOUNTERED  *
C     *                                                   *
C     *****************************************************
C
      DO 150 INDEX=1,KNTPNT
      IF(IBLOCK(INDEX).EQ.INDEX)GO TO 150
C
C     FIND NODE TO BE MOVED TO CURRENT POSITION IN TREE
      IFINAL=INDEX
  145 IFINAL=IFINAL+1
      IF(IFINAL.GT.KNTPNT)GO TO 150
      IF(IBLOCK(IFINAL).NE.INDEX)GO TO 145
C
C     INTERCHANGE NODE THAT GOES HERE AND ONE ALREADY HERE
      J=IBLOCK(INDEX)
      IBLOCK(INDEX)=IBLOCK(IFINAL)
      IBLOCK(IFINAL)=J
      J=INITAL(INDEX)
      INITAL(INDEX)=INITAL(IFINAL)
      INITAL(IFINAL)=J
      J=ISPELL(INDEX)
      ISPELL(INDEX)=ISPELL(IFINAL)
      ISPELL(IFINAL)=J
      J=KOMAND(INDEX)
      KOMAND(INDEX)=KOMAND(IFINAL)
      KOMAND(IFINAL)=J
      J=MCHPNT(INDEX)
      MCHPNT(INDEX)=MCHPNT(IFINAL)
      MCHPNT(IFINAL)=J
      J=NOTPNT(INDEX)
      NOTPNT(INDEX)=NOTPNT(IFINAL)
      NOTPNT(IFINAL)=J
C
C     PATCH ALL POINTERS TO THE NODES BEING INTERCHANGED
      DO 149 I=1,KNTPNT
      J=MCHPNT(I)
      IF(J.NE.INDEX)GO TO 146
      MCHPNT(I)=IFINAL
      GO TO 147
  146 IF(J.EQ.IFINAL)MCHPNT(I)=INDEX
  147 J=NOTPNT(I)
      IF(J.NE.INDEX)GO TO 148
      NOTPNT(I)=IFINAL
      GO TO 149
  148 IF(J.EQ.IFINAL)NOTPNT(I)=INDEX
  149 CONTINUE
  150 CONTINUE
      KNTPNT=KNTSRT
C
C     ************************************************
C     *                                              *
C     *  GENERATE LIST OF ALL RECOGNIZABLE COMMANDS  *
C     *                                              *
C     ************************************************
C
      IF(LNGLBL.EQ.0)WRITE(ILPT,151)
  151 FORMAT(1X/17H        KEY WORDS)
      IF(LNGLBL.GT.0)WRITE(ILPT,152)(LTRLBL(I),I=1,LNGLBL)
  152 FORMAT(1X/36H        KEY WORDS FOR TEST GLOSSARY ,
     16A1)
      WRITE(ILPT,153)
  153 FORMAT(1X)
C
C     FIND MINIMUM AND MAXIMUM VALUES FOR ANY COMMAND
      NXTVAL=KOMAND(1)
      MAXMUM=NXTVAL
      DO 154 I=1,KNTPNT
      IF(NXTVAL.GT.KOMAND(I))NXTVAL=KOMAND(I)
      IF(MAXMUM.LT.KOMAND(I))MAXMUM=KOMAND(I)
  154 CONTINUE
      IF(NXTVAL.GT.0)NXTVAL=0
C
C     PREPARE TO FIND FIRST COMMAND
  155 MINMUM=NXTVAL
      NXTVAL=MAXMUM
      MCHNOW=1
      NODKNT=0
      KNTSHO=0
C
C     FIND NEXT COMMAND
  156 KMDNOW=0
  157 IF(KMDNOW.EQ.0)GO TO 158
      IF(KOMAND(MCHNOW).EQ.0)GO TO 159
      IF(KMDNOW.NE.KOMAND(MCHNOW))GO TO 160
  158 KMDNOW=KOMAND(MCHNOW)
  159 NODKNT=NODKNT+1
      NODLST(NODKNT)=MCHNOW
      MCHNOW=MCHPNT(MCHNOW)
      IF(MCHNOW.GT.0)GO TO 157
C
C     DETERMINE IF COMMAND IS TO BE DISPLAYED NOW
  160 DO 161 I=1,NODKNT
      J=NODLST(I)
      IF(KOMAND(J).NE.0)KMDNOW=KOMAND(J)
  161 CONTINUE
      IF(KMDNOW.LT.MINMUM)GO TO 172
      IF(KMDNOW.EQ.MINMUM)GO TO 162
      IF(NXTVAL.GT.KMDNOW)NXTVAL=KMDNOW
      GO TO 172
C
C     CONSTRUCT THE LINE OF TEXT DESCRIBING THE COMMAND
  162 MAXPRT=0
      KMDLST=0
      DO 168 I=1,NODKNT
      J=NODLST(I)
      KMDNEW=KOMAND(J)
      IF(KMDNEW.EQ.KMDLST)GO TO 166
      IF(KMDNEW.EQ.0)GO TO 163
      IF(KMDNEW.NE.KMDNOW)GO TO 166
  163 KMDLST=KMDNEW
      IF(KMDLST.EQ.0)GO TO 165
      IF(INITAL(J).EQ.0)GO TO 164
      MAXPRT=MAXPRT+1
      LTRBFR(MAXPRT)=LTRSPC
  164 MAXPRT=MAXPRT+1
      LTRBFR(MAXPRT)=LTRLFT
      GO TO 167
  165 MAXPRT=MAXPRT+1
      LTRBFR(MAXPRT)=LTRRIT
  166 IF(INITAL(J).EQ.0)GO TO 167
      MAXPRT=MAXPRT+1
      LTRBFR(MAXPRT)=LTRSPC
  167 MAXPRT=MAXPRT+1
      J=ISPELL(J)
      IF(J.LE.26)LTRBFR(MAXPRT)=LTRABC(J)
      IF(J.GT.26)LTRBFR(MAXPRT)=LTRXTR(J-26)
  168 CONTINUE
      IF(KMDLST.EQ.0)GO TO 169
      MAXPRT=MAXPRT+1
      LTRBFR(MAXPRT)=LTRRIT
C
C     WRITE LINE TO LISTING FILE DESCRIBING THE COMMAND
  169 IF(KNTSHO.EQ.0)WRITE(ILPT,170)KMDNOW,
     1(LTRBFR(I),I=1,MAXPRT)
  170 FORMAT(1X,1I6,80A1)
      IF(KNTSHO.GT.0)WRITE(ILPT,171)(LTRBFR(I),I=1,MAXPRT)
  171 FORMAT(7X,80A1)
      KNTSHO=KNTSHO+1
C
C     CHECK IF THERE ARE ANY MORE COMMANDS TO DISPLAY
  172 IF(MCHNOW.NE.0)GO TO 156
  173 MCHNOW=NODLST(NODKNT)
      NODKNT=NODKNT-1
      MCHNOW=NOTPNT(MCHNOW)
      IF(MCHNOW.GT.0)GO TO 156
      IF(NODKNT.GT.0)GO TO 173
      IF(MINMUM.LT.MAXMUM)GO TO 155
C
C     ************************************************
C     *                                              *
C     *  GENERATE CHECKSUMS CHARACTERIZING GLOSSARY  *
C     *                                              *
C     ************************************************
C
C     GENERATE CHECKSUMS FOR CURRENT GLOSSARY
      DO 174 I=1,5
  174 ICHECK(I)=0
      DO 185 I=1,KNTPNT
      ICHECK(1)=ICHECK(1)+(I*KOMAND(I))
  175 IF(ICHECK(1).LT.10000)GO TO 176
      ICHECK(1)=ICHECK(1)-10000
      GO TO 175
  176 IF(ICHECK(1).GT.-10000)GO TO 177
      ICHECK(1)=ICHECK(1)+10000
      GO TO 176
  177 ICHECK(2)=ICHECK(2)+(I*INITAL(I))
  178 IF(ICHECK(2).LT.10000)GO TO 179
      ICHECK(2)=ICHECK(2)-10000
      GO TO 178
  179 ICHECK(3)=ICHECK(3)+(I*ISPELL(I))
  180 IF(ICHECK(3).LT.10000)GO TO 181
      ICHECK(3)=ICHECK(3)-10000
      GO TO 180
  181 ICHECK(4)=ICHECK(4)+(I*MCHPNT(I))
  182 IF(ICHECK(4).LT.10000)GO TO 183
      ICHECK(4)=ICHECK(4)-10000
      GO TO 182
  183 ICHECK(5)=ICHECK(5)+(I*NOTPNT(I))
  184 IF(ICHECK(5).LT.10000)GO TO 185
      ICHECK(5)=ICHECK(5)-10000
      GO TO 184
  185 CONTINUE
C
C     COMPARE CALCULATED AND COMPUTED CHECKSUMS
      DO 186 I=1,5
      IF(ICOMPR(I).NE.0)GO TO 187
  186 CONTINUE
      GO TO 194
  187 DO 188 I=1,5
      IF(ICHECK(I).NE.ICOMPR(I))GO TO 191
  188 CONTINUE
      IF(LNGLBL.EQ.0)WRITE(ITTY,189)
  189 FORMAT(1X,5HVALID)
      IF(LNGLBL.GT.0)WRITE(ITTY,190)(LTRLBL(I),I=1,LNGLBL)
  190 FORMAT(1X,6A1)
      GO TO 194
  191 IF(LNGLBL.EQ.0)WRITE(ITTY,192)
  192 FORMAT(1X,27HERROR IN UNLABELED GLOSSARY)
      IF(LNGLBL.GT.0)WRITE(ITTY,193)(LTRLBL(I),I=1,LNGLBL)
  193 FORMAT(1X,18HERROR IN GLOSSARY ,6A1)
C
C     *****************************************************
C     *                                                   *
C     *  GENERATE COMMENT LINES DESCRIBING TREE OF TESTS  *
C     *                                                   *
C     *****************************************************
C
C     WRITE LABEL IF ANY, STORAGE SUMMARY AND CHECKSUMS
  194 IF(LNGLBL.GT.0)WRITE(IOUT,195)(LTRLBL(I),I=1,LNGLBL)
  195 FORMAT(1HC/20HC     TEST GLOSSARY ,6A1)
      WRITE(IOUT,196)KNTPNT,MAXSPL,LMTPNT
  196 FORMAT(1HC/25HC     FINAL STORAGE USED=,1I4,
     112H, MOST USED=,1I5,8H, LIMIT=,1I5)
      WRITE(IOUT,197)(ICHECK(I),I=1,5)
  197 FORMAT(1HC/15HC     CHECKSUMS,1I5,1H,,1I4,1H,,
     11I4,1H,,1I4,1H,,1I4)
      WRITE(IOUT,206)
C
C     WRITE CONTENTS OF EACH NODE
      LIMIT=0
  198 INDEX=LIMIT+1
      LIMIT=LIMIT+15
      IF(LIMIT.GT.KNTPNT)LIMIT=KNTPNT
      J=0
      DO 199 I=INDEX,LIMIT
      J=J+1
  199 NODLST(J)=I
      WRITE(IOUT,201)(NODLST(I),I=1,J)
      WRITE(IOUT,202)(KOMAND(I),I=INDEX,LIMIT)
      J=0
      DO 200 I=INDEX,LIMIT
      K=ISPELL(I)
      J=J+3
      LTRBFR(J-2)=LTRSPC
      IF(INITAL(I).EQ.0)LTRBFR(J-1)=LTRSPC
      IF(INITAL(I).NE.0)LTRBFR(J-1)=LTRMNS
      IF(K.LE.26)LTRBFR(J)=LTRABC(K)
      IF(K.GT.26)LTRBFR(J)=LTRXTR(K-26)
  200 CONTINUE
      WRITE(IOUT,203)(LTRBFR(I),I=1,J)
      WRITE(IOUT,204)(MCHPNT(I),I=INDEX,LIMIT)
      WRITE(IOUT,205)(NOTPNT(I),I=INDEX,LIMIT)
      WRITE(IOUT,206)
      IF(LIMIT.LT.KNTPNT)GO TO 198
  201 FORMAT(14HC     COUNT   ,15I3)
  202 FORMAT(14HC     COMMAND ,15I3)
  203 FORMAT(14HC     LETTER  ,45A1)
  204 FORMAT(14HC     SUCCESS ,15I3)
  205 FORMAT(14HC     FAILURE ,15I3)
  206 FORMAT(1HC)
C
C     ****************************************************
C     *                                                  *
C     *  GENERATE DATA STATEMENTS REPRESENTING GLOSSARY  *
C     *                                                  *
C     ****************************************************
C
C     PACK ISPELL AND INITAL IN NOTPNT, KOMAND IN MCHPNT
      DO 207 I=1,KNTPNT
      NUMBER=KOMAND(I)
      IF(NUMBER.GT.0)MCHPNT(I)=MCHPNT(I)+
     1((KNTPNT+1)*NUMBER)
      IF(NUMBER.LT.0)MCHPNT(I)=-MCHPNT(I)+
     1((KNTPNT+1)*NUMBER)
      NOTPNT(I)=NOTPNT(I)+((KNTPNT+1)*ISPELL(I))
      IF(INITAL(I).NE.0)NOTPNT(I)=-NOTPNT(I)
  207 CONTINUE
C
C     GENERATE DIMENSION AND EQUIVALENCE STATEMENTS
      IF(KNTXTR.GT.0)CALL DASAVE(-4,-1,53,10,MCHPNT,
     1KNTPNT,LTRXTR,KNTXTR,LTR4TH,6,IOUT,IERR)
      CALL DASAVE(-4,0,53,10,MCHPNT,
     1KNTPNT,ISPELL,KNTPNT,LTR2ND,6,IOUT,IERR)
      CALL DASAVE(-4,0,53,10,NOTPNT,
     1KNTPNT,ISPELL,KNTPNT,LTR1ST,6,IOUT,IERR)
C
C     GENERATE DATA STATEMENTS
      WRITE(IOUT,208)LTR3RD,LTR5TH,KNTPNT,KNTXTR
  208 FORMAT(6X,5HDATA ,6A1,1H,,6A1,1H/,1I5,1H,,1I5,1H/)
      IF(KNTXTR.GT.0)CALL DASAVE(3,-1,53,10,MCHPNT,
     1KNTPNT,LTRXTR,KNTXTR,LTR4TH,6,IOUT,IERR)
      CALL DASAVE(3,0,53,10,MCHPNT,
     1KNTPNT,ISPELL,KNTPNT,LTR2ND,6,IOUT,IERR)
      CALL DASAVE(3,0,53,10,NOTPNT,
     1KNTPNT,ISPELL,KNTPNT,LTR1ST,6,IOUT,IERR)
  209 IF(IEOF.NE.0)GO TO 1
      STOP
C
C     *****************************************************
C     *                                                   *
C     *   GGGG L      OOO   SSSS  SSSS   A   RRRR  Y   Y  *
C     *  G     L     O   O S     S      A A  R   R  Y Y   *
C     *  G     L     O   O S     S     A   A R   R   Y    *
C     *  G     L     O   O  SSS   SSS  A   A RRRR    Y    *
C     *  G GGG L     O   O     S     S AAAAA R  R    Y    *
C     *  G   G L     O   O     S     S A   A R   R   Y    *
C     *   GGGG LLLLL  OOO  SSSS  SSSS  A   A R   R   Y    *
C     *                                                   *
C     *****************************************************
C
C     All variables and arrays  which  are  global  to  the
C     KEYWRD  program are described below.  Those variables
C     and arrays which are local to particular portions  of
C     the program are not described.  All character data is
C     stored in variables  or  arrays  having  names  which
C     begin with either of the letter seqeunces LTR or LWR.
C
C     IBEGIN = Location within the IBLOCK, INITAL,  ISPELL,
C              KOMAND, MCHPNT and NOTPNT arrays of the node
C              which is at the base of the  decision  tree.
C              IBEGIN will be 1 unless the first command in
C              the input  file  does  not  start  with  the
C              lowest  letter of the alphabet of any of the
C              commands in the input file.  The  nodes  are
C              rearranged  before  the  DATA statements are
C              generated to force the first node to  be  in
C              the first location in these arrays.
C     IBLOCK = Array describing the nodes in the  tree  and
C              which  is  held  parallel to the contents of
C              the  INITAL,  ISPELL,  KOMAND,  MCHPNT   and
C              NOTPNT  arrays.   IBLOCK is used to mark the
C              unique characters in the tree which must  be
C              preserved.   When  the tree of back pointers
C              is first created, IBLOCK is set to zero  for
C              nodes  which  are  not  at the right ends of
C              words and to 1 for nodes which  are  at  the
C              right ends of words.  If the initial pruning
C              of branches removes a node for which  IBLOCK
C              is  1,  IBLOCK is set to -1 and the value of
C              the associated  command,  which  will  be  a
C              prefix   of  some  other  command,  is  left
C              unchanged.   Before  the  pruning   of   the
C              branches,  all  remaining  values  of  1  in
C              IBLOCK are set back to zero, and  IBLOCK  is
C              set to 1 for the nodes which are attached to
C              the merged roots.  Merging of  branches  for
C              different commands is allowed only if IBLOCK
C              is zero for both branches.  Since IBLOCK  is
C              not  needed  for  preserving nodes after the
C              pruning of  the  branches,  IBLOCK  is  used
C              during the rearrangement of the tree to hold
C              the location to which each  node  is  to  be
C              shifted.  IBLOCK is dimensioned at LMTPNT.
C     ICHECK = array in which the checksums  characterizing
C              the   decision   tree   are  stored.   These
C              checksums are compared with  the  values  in
C              the  ICOMPR  array  if there are any nonzero
C              values in the ICOMPR array.
C     ICOMPR = Array in which the checksums predicted by  a
C              line  in  the  input  file  starting with an
C              asterisk are  stored.   After  the  decision
C              tree  is completed, the values in the ICOMPR
C              array  are  compared  with  the   calculated
C              values  in the ICHECK array if there are any
C              nonzero values in the ICOMPR array.
C     IEOF   = Indicates whether the  DATA  statements  are
C              dumped  due  to  the end of file having been
C              read  or  a  line  starting  with  a   right
C              parenthesis having been recognized.  IEOF is
C              zero if a physical end of  file  or  a  line
C              containing  only  a  number  has  been read.
C              IEOF is 1 if a line starting  with  a  right
C              parenthesis  has  been  found, in which case
C              additional lines are to  be  read  from  the
C              input  file  after  the DATA statements have
C              been generated.
C     IIN    = Unit number from which  the  input  file  is
C              read.
C     ILPT   = Unit number to which  the  listing  file  is
C              written.
C     INITAL = Array describing the nodes in the  tree  and
C              which  is  held  parallel to the contents of
C              the  IBLOCK,  ISPELL,  KOMAND,  MCHPNT   and
C              NOTPNT  arrays.   INITAL is used to mark the
C              characters in the tree which are located  at
C              the starts of words in the commands.  INITAL
C              is zero if the character does  not  start  a
C              word,  and  1  if the character does start a
C              word.  INITAL is dimensioned at LMTPNT.
C     IOUT   = Unit number to which the  FORTRAN  statement
C              file is written.
C     ISPELL = Array describing the nodes in the  tree  and
C              which  is  held  parallel to the contents of
C              the  IBLOCK,  INITAL,  KOMAND,  MCHPNT   and
C              NOTPNT arrays.  ISPELL contains the location
C              in the LTRABC array  or  else  26  plus  the
C              location  in the LTRXTR array which contains
C              the character which is to be matched by  the
C              node.  ISPELL is dimensioned at LMTPNT.
C     ITTY   = Unit number on which messages to be seen  by
C              the user are written and from which the user
C              responses to requests  for  file  names  are
C              read.
C     KNTPNT = The number of nodes in the current  decision
C              tree.  This changes as new commands are read
C              and as identical portions of  the  tree  are
C              merged.    KNTPNT  cannot  be  greater  than
C              LMTPNT which is the dimension of the  arrays
C              in which the nodes are stored.
C     KNTXTR = The number  of  characters  other  than  the
C              letters  of  the  alphabet  which  have been
C              encountered in the input file and which  are
C              stored in the LTRXTR array.
C     KOMAND = Array describing the nodes in the  tree  and
C              which  is  held  parallel to the contents of
C              the  IBLOCK,  INITAL,  ISPELL,  MCHPNT   and
C              NOTPNT  arrays.  If KOMAND is nonzero then a
C              successful  match  of  the   node   uniquely
C              identifies  a command having that value.  If
C              KOMAND is zero, then the node is  shared  by
C              several   commands  and  is  not  needed  to
C              identify any particular command.  KOMAND  is
C              dimensioned at LMTPNT.
C     LMTBFR = The dimension of the LTRBFR  array  and  the
C              maximum  number  of  characters which can be
C              read from a single line of the  input  file.
C              LMTBFR  should  equal  at  least 45 since 45
C              locations in the LTRBFR array are needed for
C              storing  the  letters  to  appear in comment
C              lines in the FORTRAN statement  file  before
C              these letters are written out.
C     LMTPNT = The  dimensions  of  the   IBLOCK,   INITAL,
C              ISPELL,  KOMAND,  MCHPNT  and NOTPNT arrays.
C              LMTPNT is the maximum number of nodes  which
C              can  appear  in  the decision tree after the
C              identical roots of all but the final command
C              have  been  merged  and before the identical
C              branches are merged.
C     LMTXTR = The dimension of the LTRXTR  array.   LMTXTR
C              is  the  maximum  number of characters other
C              than the letters of the alphabet  which  can
C              appear in the commands.
C     LNGLBL = The number of characters in  a  label  which
C              appeared  as  the sixth item to the right of
C              an initial asterisk in a line in  the  input
C              file.   The  characters  of  this  label are
C              stored in the LTRLBL array.  This  label  is
C              used  in an error message which is displayed
C              to the user if the  predicted  checksums  do
C              not agree with those actually calculated for
C              the current glossary.  LNGLBL is zero  if  a
C              label   has  not  been  defined  by  a  line
C              starting with an asterisk.
C     LTRABC = The upper case letters of  the  alphabet  in
C              the  order  in which these letters are to be
C              sorted in failure chains and in the order in
C              which  these letters are to be identified by
C              the program which uses the output  from  the
C              KEYWRD  program.   The lower case letters in
C              the LWRABC array must  appear  in  the  same
C              order  as is used for the upper case letters
C              in the LTRABC array.  If the  computer  upon
C              which  the  KEYWRD  program is used does not
C              support lower case, then the contents of the
C              LWRABC  array  should be the same upper case
C              letters as in  the  LTRABC  array.   If  the
C              computer  upon  which  the KEYWRD program is
C              used does not support upper case,  then  the
C              contents  of  the LTRABC array should be the
C              same lower case letters  as  in  the  LWRABC
C              array.   The  program  which uses the output
C              from  the  KEYWRD  program   would   execute
C              slightly faster if the LTRABC and the LWRABC
C              arrays are sorted in the order of  frequency
C              of use of the letters in English text.  If E
C              is the most frequently used letter and J the
C              least  frequently  used letter, for example,
C              then LTRABC(1) would contain the upper  case
C              letter E, LWRABC(1) the lower case letter e,
C              LTRABC(26)  the  upper  case  letter  J  and
C              LWRABC(26)  the lower case letter j, but the
C              program which used the output  generated  by
C              the  KEYWRD program would then have to treat
C              a request for a match of the letter  located
C              at  position 1 in the alphabet as a match of
C              the letter E not of  the  letter  A,  and  a
C              request for a match of the letter located at
C              position 26 in the alphabet as  a  match  of
C              the letter J not of the letter Z.
C     LTRBFR = Array into which each line in the input file
C              is  read, and in which each command which is
C              written into  the  listing  file  is  stored
C              before it is written.  The first 45 loctions
C              in  LTRBFR  are  also  used  to  store   the
C              characters  corresponding to the nodes which
C              are described in the comment  lines  in  the
C              output  FORTRAN  statement  file.  LTRBFR is
C              dimensioned at LMTBFR or  45,  whichever  is
C              larger.
C     LTRCMA = The  comma  character.   This  is  used  for
C              identifying  any  commas which appear in the
C              input file.
C     LTRDGT = The digits 0 through 9.  These are used  for
C              evaluating numbers in the input file.
C     LTRFIV = The characters of the name  KNTXTR.   LTRFIV
C              is used to reset LTR5TH at the start of each
C              glossary.  LTR5TH is used  to  generate  the
C              name  of  the KNTXTR variable in the FORTRAN
C              DATA statements.
C     LTRFOU = The characters of the name  LTRXTR.   LTRFOU
C              is used to reset LTR4TH at the start of each
C              glossary.  LTR4TH is used  to  generate  the
C              name of the LTRXTR array in the FORTRAN DATA
C              statements.
C     LTRLBL = The characters of a label which appeared  as
C              the  sixth  item  to the right of an initial
C              asterisk in a line in the input file.   This
C              label  is  used in an error message which is
C              displayed  to  the  user  if  the  predicted
C              checksums  do  not agree with those actually
C              calculated for the current glossary.  LNGLBL
C              is  the  number  of characters stored in the
C              LTRLBL array.
C     LTRLFT = The left  parenthesis.   This  is  used  for
C              identifying  a left parenthesis in the input
C              file at the start of  a  line  the  rest  of
C              which is to be copied directly to the output
C              file,  and  also  for   inserting   a   left
C              parenthesis  at  the  start  of  the  unique
C              portion of each abbreviation in the  listing
C              file.
C     LTRMNS = The  minus   sign.    This   is   used   for
C              determining the sign of numbers in the input
C              file, and also for inserting  a  minus  sign
C              before  each character which is at the start
C              of a  word  in  the  comment  lines  in  the
C              FORTRAN statement file.
C     LTRONE = The characters of the name  NOTPNT.   LTRONE
C              is used to reset LTR1ST at the start of each
C              glossary.  LTR1ST is used  to  generate  the
C              name of the NOTPNT array in the FORTRAN DATA
C              statements.
C     LTRPLS = The plus sign.  This is used for identifying
C              the  plus  sign  which  is  allowed, but not
C              required, before positive and  zero  numbers
C              in the input file.
C     LTRRIT = The right parenthesis.   This  is  used  for
C              identifying a right parenthesis in the input
C              file at the start of a line which  indicates
C              that   the   DATA   statements   are  to  be
C              generated, and also for  inserting  a  right
C              parenthesis at the end of the unique portion
C              of each abbreviation in the listing file.
C     LTRSLA = The  slash  character.   This  is  used  for
C              identifying a slash in the input file at the
C              start of a line which changes the  names  to
C              appear in the DATA statements.
C     LTRSPC = the space or blank character.  This is  used
C              for  identifying  spaces  in the input file,
C              for inserting spaces between  the  words  in
C              the  listing  file, and for inserting spaces
C              between the  letters  which  appear  in  the
C              comment lines in the FORTRAN output file.
C     LTRSTR = The asterisk character.  This  is  used  for
C              identifying the asterisk which can appear in
C              the input file at the start of a line  which
C              predicts the values of the checksums for the
C              current glossary.
C     LTRTHR = The characters of the name  KNTPNT.   LTRTHR
C              is used to reset LTR3RD at the start of each
C              glossary.  LTR3RD is used  to  generate  the
C              name  of  the KNTPNT variable in the FORTRAN
C              DATA statements.
C     LTRTWO = The characters of the name  MCHPNT.   LTRTWO
C              is used to reset LTR2ND at the start of each
C              glossary.  LTR2ND is used  to  generate  the
C              name of the MCHPNT array in the FORTRAN DATA
C              statements.
C     LTRXTR = Array  in  which  the  characters   in   the
C              commands  which  are  not  included  in  the
C              alphabet are stored.  KNTXTR is  the  number
C              of  such  unexpected  characters  which have
C              been  found.   LTRXTR  is   dimensioned   at
C              LMTXTR.
C     LTR1ST = The characters which are  used  to  generate
C              the  name  by  which  the  NOTPNT  array  is
C              represented in the FORTRAN DATA  statements.
C              LTR1ST  is  reset to contain the name NOTPNT
C              in the LTRONE array at  the  start  of  each
C              glossary,  but,  if  a  line starting with a
C              slash is  found  in  the  input  file,  then
C              LTR1st  is  set  to the first name following
C              the slash.
C     LTR2ND = The characters which are  used  to  generate
C              the  name  by  which  the  MCHPNT  array  is
C              represented in the FORTRAN DATA  statements.
C              LTR2ND  is  reset to contain the name MCHPNT
C              in the LTRTWO array at  the  start  of  each
C              glossary,  but,  if  a  line starting with a
C              slash is  found  in  the  input  file,  then
C              LTR2ND  is  set to the second name following
C              the slash.
C     LTR3RD = The characters which are  used  to  generate
C              the  name  by  which  the KNTPNT variable is
C              represented in the FORTRAN DATA  statements.
C              LTR3RD  is  reset to contain the name KNTPNT
C              in the LTRTHR array at  the  start  of  each
C              glossary,  but,  if  a  line starting with a
C              slash is  found  in  the  input  file,  then
C              LTR3RD  is  set  to the third name following
C              the slash.
C     LTR4TH = The characters which are  used  to  generate
C              the  name  by  which  the  LTRXTR  array  is
C              represented in the FORTRAN DATA  statements.
C              LTR4TH  is  reset to contain the name LTRXTR
C              in the LTRFOU array at  the  start  of  each
C              glossary,  but,  if  a  line starting with a
C              slash is  found  in  the  input  file,  then
C              LTR4TH  is  set to the fourth name following
C              the slash.
C     LTR5TH = The characters which are  used  to  generate
C              the  name  by  which  the KNTXTR variable is
C              represented in the FORTRAN DATA  statements.
C              LTR5TH  is  reset to contain the name KNTXTR
C              in the LTRFIV array at  the  start  of  each
C              glossary,  but,  if  a  line starting with a
C              slash is  found  in  the  input  file,  then
C              LTR5TH  is  set  to the fifth name following
C              the slash.
C     LWRABC = The lower case letters of  the  alphabet  in
C              the  same order as the upper case letters in
C              the LTRABC array.  LWRABC is used  only  for
C              identifying the upper case letters which are
C              equivalent to any lower case letters in  the
C              input  file.  If the computer upon which the
C              KEYWRD program  is  used  does  not  support
C              lower  case  letters,  then the LWRABC array
C              should contain the upper case letters in the
C              same  order  as  these  appear in the LTRABC
C              array.
C     MAXKIL = During the reading of the input file, MAXKIL
C              is the number of nodes in the tree after the
C              previously read command was appended to  the
C              tree  and after the root of the new tree has
C              been merged with those of the  older  trees.
C              If  the  current  command  causes the arrays
C              which  store  the  tree  to  overflow,  then
C              KNTPNT is reset to MAXKIL.
C     MAXSPL = The  maximum  number  of  locations  in  the
C              IBLOCK,  INITAL,  ISPELL, KOMAND, MCHPNT and
C              NOTPNT arrays which have been used to  store
C              the  decision  tree.  MAXSPL will be similar
C              to, but not necessarily the same as, MAXKIl,
C              since MAXSPL is the maximum size of the tree
C              before the merging of the root of  the  tree
C              representing  the newest command, and MAXKIL
C              is the size of the tree after the merging of
C              the root of the tree for the newest command.
C     MCHPNT = Array describing the nodes in the  tree  and
C              which  is  held  parallel to the contents of
C              the  IBLOCK,  INITAL,  ISPELL,  KOMAND   and
C              NOTPNT arrays.  MCHPNT contains the location
C              within the tree  of  the  next  node  to  be
C              applied  if  the current match is a success.
C              If MCHPNT is zero, then no more nodes remain
C              to be tested along the current path.  MCHPNT
C              is dimensioned at LMTPNT.
C     NODLST = While the input file is being  read,  NODLST
C              accumulates  for  each line the locations in
C              the  LTRABC  array  or  26  more  than   the
C              locations   in   the  LTRXTR  array  of  the
C              characters in the command and zeros for  the
C              spacings  between  words in phrases.  Later,
C              when the  tree  is  walked,  either  in  the
C              determination  of  the  best  order  for the
C              nodes in the final tree or the  construction
C              of  the  listing  file,  NODLST contains the
C              node numbers corresponding to each character
C              in the current command.
C     NOTPNT = Array describing the nodes in the  tree  and
C              which  is  held  parallel to the contents of
C              the  IBLOCK,  INITAL,  ISPELL,  KOMAND   and
C              MCHPNT arrays.  NOTPNT contains the location
C              within the tree  of  the  next  node  to  be
C              applied  if  the  current  match  fails.  If
C              NOTPNT is zero, then no more nodes remain to
C              be tested along the current path.  NOTPNT is
C              dimensioned at LMTPNT.
C643514904453
      END
      SUBROUTINE KEYOPN(ITTY,IIN,IOUT,ILPT)
C     RENBR(/OPEN FILES FOR KEYWRD PROGRAM ON PDP10)
C
C     ITTY   = UNIT FOR DIALOG WITH USER
C     IIN    = UNIT FOR INPUT FILE SPECIFYING COMMANDS
C     IOUT   = UNIT FOR FORTRAN SOURCE OUTPUT FILE
C     ILPT   = UNIT FOR LISTING OUTPUT FILE
C
      DOUBLE PRECISION FILNAM
      WRITE(ITTY,1)
    1 FORMAT(7H KEYWRD/
     145H BUILDS DECISION TREE FOR COMMAND RECOGNITION)
    2 WRITE(ITTY,3)
    3 FORMAT(' INPUT GLOSSARY FILE: ',$)
      READ(ITTY,4)FILNAM
    4 FORMAT(1A10)
      OPEN(UNIT=IIN,FILE=FILNAM,ACCESS='SEQIN',ERR=2)
    5 WRITE(ITTY,6)
    6 FORMAT(' OUTPUT FORTRAN FILE: ',$)
      READ(ITTY,4)FILNAM
      OPEN(UNIT=IOUT,FILE=FILNAM,ACCESS='SEQOUT',ERR=5)
    7 WRITE(ITTY,8)
    8 FORMAT(' OUTPUT SUMMARY FILE: ',$)
      READ(ITTY,4)FILNAM
      OPEN(UNIT=ILPT,FILE=FILNAM,ACCESS='SEQOUT',ERR=7)
      RETURN
C223322096456':$
      END
      SUBROUTINE DASAVE(IPART ,IFORMT,MAXCLM,MAXLIN,IDATA ,
     1    KNTDAT,LETTER,KNTLTR,NAME  ,KNTNAM,IOUT  ,IERR  )
C     RENBR(/INTEGER AND 1H DATA STATEMENT GENERATOR)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JUL 14, 1970
C
C     IPART  = -1,  CONSTRUCT  DIMENSION  AND   EQUIVALENCE
C              STATEMENTS BUT NOT DATA STATEMENTS
C            = 0, CONSTRUCT DIMENSION, EQUIVALENCE AND DATA
C              STATEMENTS
C            = 1, CONSTRUCT DIMENSION STATEMENTS ONLY
C            = 2, CONSTRUCT EQUIVALENCE STATEMENTS ONLY
C            = 3, CONSTRUCT DATA STATEMENTS ONLY
C            = -4, -3 OR -2, IDENTICAL TO IPART=-1, 0 OR  1
C              RESPECTIVELY,    EXCEPT    THAT    DIMENSION
C              STATEMENTS SPECIFY COMPONENT ARRAYS NECESARY
C              TO   CONSTRUCT  ORGINAL  ARRAY  BUT  DO  NOT
C              INCLUDE  NAME  AND  DIMENSION  OF   ORIGINAL
C              ARRAY.
C     IFORMT = -1, REPRESENT  CHARACTERS  IN  LETTER  ARRAY
C              WHICH WERE DEFINED BY 1H FIELDS OR READ WITH
C              A1 FORMATS
C            = 0, REPRESENT  INTEGERS  IN  IDATA  ARRAY  IN
C              COMPACT FORM
C            = 1 OR GREATER, REPRESENT  INTEGERS  IN  IDATA
C              ARRAY  IN  COLUMNS WHICH ARE AT LEAST IFORMT
C              CHARACTERS WIDE (IFORMT=10 IS EQUIVALENT  TO
C              I10 FORMAT)
C     MAXCLM = NUMBER OF  CHARACTERS  TO  BE  IN  STATEMENT
C              FIELD  (66  IF  MAXIMUM,  IE 72 MINUS LEFT 6
C              COLUMNS)
C     MAXLIN = MAXIMUM NUMBER OF LINES FOR SINGLE STATEMENT
C     IDATA  = ARRAY OF INTEGERS TO BE REPRESENTED IN  DATA
C              STATEMENTS IF IFORMT IS ZERO OR GREATER
C     KNTDAT = NUMBER OF LOCATIONS IN  IDATA  ARRAY  TO  BE
C              REPRESENTED IN DATA STATEMENTS
C     LETTER = ARRAY OF CHARACTERS READ WITH A1  FORMAT  OR
C              DEFINED USING 1H FIELDS TO BE REPRESENTED IN
C              DATA STATEMENTS IF IFORMT HAS VALUE -1
C     KNTLTR = NUMBER OF LOCATIONS IN LETTER  ARRAY  TO  BE
C              REPRESENTED IN DATA STATEMENTS
C     NAME   = ALPHAMERIC ARRAY CONTAINING  NAME  OF  ARRAY
C              (READ BY MULTIPLE OF A1 FORMAT)
C     KNTNAM = NUMBER OF LETTERS IN NAME OF ARRAY
C     IOUT   = OUTPUT UNIT ON WHICH STATEMENT IS WRITTEN
C     IERR   = 0 RETURNED IF COULD GENERATE DATA STATEMENT
C            = 1 RETURNED IF MAXCLM TOO SMALL
C            = 2 RETURNED IF ISTORE ARRAY TOO SMALL
C
      DIMENSION IDATA(KNTDAT),LETTER(KNTLTR),NAME(KNTNAM),
     1IBUFFR(66),ISTORE(200)
      DATA IBLANK,ISLASH,KOMMA,ILPR,IRPR,IONE,IHOLLR/
     11H ,1H/,1H,,1H(,1H),1H1,1HH/
C
C     JSTORE = DIMENSION OF ISTORE ARRAY.  THIS IS THE
C              MAXIMUM NUMBER OF SMALL ARRAYS WHICH CAN
C              BE USED TO REPRESENT THE IDATA ARRAY.
C
      DATA JSTORE/200/
C
      JPART=IPART
      IF(JPART.LT.-1)JPART=JPART+3
      IERR=0
      IF(IFORMT)1,2,2
    1 NEEDED=KNTLTR
      GO TO 3
    2 NEEDED=KNTDAT
    3 IF(NEEDED)113,113,4
    4 LOCK=1
      MOST=0
      MAX1=MAXCLM-1
      MAX2=MAXCLM-2
      LEFT=0
      CALL DANUMB(0,NEEDED,10,IBUFFR,LEFT,0,MAXCLM)
      LENGTH=KNTNAM+LEFT
      IF(LENGTH-6)6,6,5
    5 LENGTH=6
    6 IF(IFORMT)12,81,7
C
C     PREPARE FOR EXPANDED FORMAT
    7 MOST=IDATA(1)
      LEAST=MOST
      DO 8 INDEX=1,NEEDED
      IF(LEAST.GT.IDATA(INDEX))LEAST=IDATA(INDEX)
      IF(MOST.LT.IDATA(INDEX))MOST=IDATA(INDEX)
    8 CONTINUE
      KOUNT=0
      CALL DANUMB(0,MOST,10,IBUFFR,KOUNT,0,MAXCLM)
      MOST=KOUNT
      KOUNT=0
      CALL DANUMB(0,LEAST,10,IBUFFR,KOUNT,0,MAXCLM)
      IF(MOST-KOUNT)9,10,10
    9 MOST=KOUNT
   10 IF(MOST-IFORMT)11,13,13
   11 MOST=IFORMT
      GO TO 13
   12 MOST=3
   13 LIMIT=MAXLIN*((MAXCLM-LENGTH-6)/(MOST+1))
      IF(LIMIT)112,112,14
   14 KNTPRT=1+((NEEDED-1)/LIMIT)
      IF(KNTPRT-JSTORE)15,15,111
   15 LEAST=1
      DO 16 INDEX=1,KNTPRT
      ISTORE(INDEX)=LEAST
   16 LEAST=LEAST+LIMIT
C
C     TEST IF LABELS ARE OF MINIMUM LENGTH
   17 ITEST=0
      CALL DANUMB(0,ISTORE(KNTPRT),10,IBUFFR,ITEST,0,
     1MAXCLM)
      IF(KNTNAM+ITEST-LENGTH)18,19,19
   18 LENGTH=KNTNAM+ITEST
      IF(IFORMT)13,81,13
   19 LOCK=0
      IF(IFORMT)21,20,21
   20 LEFT=0
      ITEST=0
C
C     CONSTRUCT SINGLE LINE OF DIMENSION STATEMENT
   21 IF(JPART-2)22,59,81
   22 INDEX=0
      DO 23 LEAST=1,10
   23 IBUFFR(LEAST)=IBLANK
   24 LINE=1
      LAST=INDEX
   25 KOUNT=10
   26 IF(INDEX)27,27,39
C
C     INSERT NAME OF MAIN ARRAY
   27 IF(IFORMT)28,29,28
   28 LIMIT=-LENGTH
      GO TO 30
   29 LIMIT=0
   30 LEAST=KOUNT
      CALL DABOTH(LIMIT,LEFT,NAME,KNTNAM,0,NEEDED,IBUFFR,
     1KOUNT,MAX1)
C
C     OUTPUT COMMENT LINE DESCRIBING DIMENSION
      IF(IPART+1)31,38,38
   31 IF(LINE-1)32,32,35
   32 IF(KOUNT-10)33,33,34
   33 WRITE(IOUT,120)
      GO TO 52
   34 WRITE(IOUT,120)(IBUFFR(LEAST),LEAST=11,KOUNT)
      GO TO 37
   35 IF(KOUNT-LEAST)112,112,36
   36 WRITE(IOUT,121)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
   37 INDEX=1
      GO TO 24
C
C     INSERT NAME OF SMALL ARRAY
   38 IF(KOUNT-LEAST)46,46,43
   39 IF(INDEX-KNTPRT)41,40,40
   40 LIMIT=NEEDED-ISTORE(INDEX)+1
      GO TO 42
   41 LIMIT=ISTORE(INDEX+1)-ISTORE(INDEX)
   42 LEAST=KOUNT
      CALL DABOTH(LENGTH,LEFT,NAME,KNTNAM,ISTORE(INDEX),
     1LIMIT,IBUFFR,KOUNT,MAX1)
      IF(KOUNT-LEAST)44,44,43
   43 INDEX=INDEX+1
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      IF(INDEX-KNTPRT)26,26,45
C
C     OUTPUT SINGLE LINE OF DIMENSION STATEMENT
   44 IF(LINE-MAXLIN)46,45,45
   45 KOUNT=KOUNT-1
   46 IF(LINE-1)47,47,50
   47 IF(KOUNT-10)48,48,49
   48 WRITE(IOUT,116)
      GO TO 52
   49 WRITE(IOUT,116)(IBUFFR(LEAST),LEAST=11,KOUNT)
      GO TO 52
   50 IF(KOUNT)112,112,51
   51 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)53,53,52
   52 MANY=1
   53 IF(INDEX-KNTPRT)54,54,58
   54 IF(LINE-MAXLIN)56,55,55
   55 IF(INDEX-LAST)112,112,24
   56 LINE=LINE+1
      IF(IFORMT)25,57,25
   57 KOUNT=0
      GO TO 26
C
C     CONSTRUCT SINGLE LINE OF EQUIVALENCE STATEMENT
   58 IF(JPART)59,59,113
   59 INDEX=1
      DO 60 LEAST=1,12
   60 IBUFFR(LEAST)=IBLANK
   61 LINE=1
      LAST=INDEX
   62 KOUNT=12
C
C     INSERT NAME OF SMALL ARRAY
   63 KOUNT=KOUNT+1
      LEAST=KOUNT
      CALL DABOTH(LENGTH,0,NAME,KNTNAM,ISTORE(INDEX),1,
     1IBUFFR,KOUNT,MAX2)
      IF(KOUNT-LEAST)66,66,64
C
C     INSERT NAME OF MAIN ARRAY
   64 KOUNT=KOUNT+1
      LIMIT=KOUNT
      CALL DABOTH(0,ITEST,NAME,KNTNAM,0,ISTORE(INDEX),
     1IBUFFR,KOUNT,MAX2)
      IF(KOUNT-LIMIT)66,66,65
   65 IBUFFR(LEAST)=ILPR
      IBUFFR(LIMIT)=KOMMA
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=IRPR
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      INDEX=INDEX+1
      IF(INDEX-KNTPRT)63,63,67
C
C     OUTPUT SINGLE LINE OF EQUIVALENCE STATEMENT
   66 KOUNT=LEAST-1
      IF(LINE-MAXLIN)68,67,67
   67 KOUNT=KOUNT-1
   68 IF(LINE-1)69,69,72
   69 IF(KOUNT-12)70,70,71
   70 WRITE(IOUT,117)
      GO TO 74
   71 WRITE(IOUT,117)(IBUFFR(LEAST),LEAST=13,KOUNT)
      GO TO 74
   72 IF(KOUNT)112,112,73
   73 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)75,75,74
   74 MANY=1
   75 IF(INDEX-KNTPRT)76,76,80
   76 IF(LINE-MAXLIN)78,77,77
   77 IF(INDEX-LAST)112,112,61
   78 LINE=LINE+1
      IF(IFORMT)62,79,62
   79 KOUNT=0
      GO TO 63
C
C     CONSTRUCT SINGLE LINE OF DATA STATEMENT
   80 IF(JPART)113,81,113
   81 INDEX=1
      KNTPRT=0
   82 LINE=1
      LAST=INDEX+1
      KOUNT=5
   83 LIMIT=KOUNT+MOST
   84 LEAST=KOUNT
      IF(LAST-INDEX)88,88,85
C
C     INSERT NAME OF SMALL ARRAY
   85 CALL DABOTH(LENGTH,-1,NAME,KNTNAM,INDEX,0,IBUFFR,
     1KOUNT,MAX1)
      IF(KOUNT-LEAST)97,97,86
   86 LAST=INDEX
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=ISLASH
      IF(KNTPRT-JSTORE)87,111,111
   87 KNTPRT=KNTPRT+1
      ISTORE(KNTPRT)=INDEX
      GO TO 83
C
C     INSERT INTEGER ENTRY
   88 IF(IFORMT)90,89,89
   89 CALL DANUMB(IFORMT,IDATA(INDEX),10,IBUFFR,KOUNT,
     1LIMIT,MAX1)
      IF(KOUNT-LEAST)95,95,94
      GO TO 94
   90 IF(LIMIT-MAX1)91,91,95
   91 IF(KOUNT-(LIMIT-3))92,93,93
   92 KOUNT=KOUNT+1
      IBUFFR(KOUNT)=IBLANK
      GO TO 91
   93 KOUNT=KOUNT+3
      IBUFFR(KOUNT-2)=IONE
      IBUFFR(KOUNT-1)=IHOLLR
      IBUFFR(KOUNT)=LETTER(INDEX)
   94 KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      INDEX=INDEX+1
      IF(INDEX-NEEDED)83,83,96
C
C     OUTPUT SINGLE LINE OF DATA STATEMENT
   95 IF(LINE-MAXLIN)97,96,96
   96 IBUFFR(KOUNT)=ISLASH
   97 IF(LOCK)98,98,105
   98 IF(LINE-1)99,99,102
   99 IF(KOUNT-5)100,100,101
  100 WRITE(IOUT,118)
      GO TO 104
  101 WRITE(IOUT,118)(IBUFFR(LEAST),LEAST=6,KOUNT)
      GO TO 104
  102 IF(KOUNT)112,112,103
  103 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)105,105,104
  104 MANY=1
  105 IF(INDEX-NEEDED)106,106,110
  106 IF(LINE-MAXLIN)108,107,107
  107 IF(INDEX-LAST)112,112,82
  108 LINE=LINE+1
      KOUNT=0
      IF(IFORMT)109,83,109
  109 LIMIT=6+LENGTH+MOST
      GO TO 84
  110 IF(LOCK)113,113,17
C
C     RETURN TO CALLING PROGRAM
  111 WRITE(IOUT,114)JSTORE
      IERR=2
      GO TO 113
  112 WRITE(IOUT,115)MAXCLM
      IERR=1
  113 RETURN
  114 FORMAT(19H DASAVE - MORE THAN,1I4,11H STATEMENTS)
  115 FORMAT(21H DASAVE - FIELD WIDTH,1I3,10H TOO SHORT)
  116 FORMAT(6X,10HDIMENSION ,66A1)
  117 FORMAT(6X,12HEQUIVALENCE ,66A1)
  118 FORMAT(6X,5HDATA ,61A1)
  119 FORMAT(5X,1I1,66A1)
  120 FORMAT(1HC,5X,10HDIMENSION ,66A1)
  121 FORMAT(1HC,4X,1I1,66A1)
C985104445547
      END
      SUBROUTINE DANUMB(KONTRL,NUMBER,IRADIX,LETTER,
     1KOUNT,LFTCOL,MAX)
C     RENBR(/REPRESENT INTEGER VALUE)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JAN 2, 1970
C
C     KONTRL = 0 LEFT JUSTIFIES AT LFTCOL OR AT KOUNT+1
C              IF KOUNT IS GREATER THAN LFTCOL.
C     KONTRL = 1 RIGHT JUSTIFIES AT LFTCOL.
C     NUMBER = NUMBER TO BE INSERTED.
C     IRADIX = BASE TO WHICH NUMBER WILL BE EXPRESSED.
C     LETTER = ALPHAMERIC BUFFER ARRAY TO BE CODED.
C     KOUNT  = NUMBER OF LOCATIONS IN LETTER IN USE.
C     LFTCOL = LOCATION OF NEW NUMBER.
C     LFTCOL = CHARACTERS LEFT OF NUMBER IF KONTRL = 0.
C     LFTCOL = POSITION OF RIGHT DIGIT IF KONTRL = 1.
C     MAX    = DIMENSION OF LETTER ARRAY.
C
C     THE ONLY ARGUMENTS RETURNED CHANGED ARE THE
C     LETTER ARRAY WHICH IS RETURNED WITH THE NEW NUMBER
C     REPRESENTED AT ITS RIGHT END, AND KOUNT WHICH IS
C     RETURNED CONTAINING THE NUMBER OF CHARACTERS IN THE
C     LETTER ARRAY.
C
      DIMENSION LETTER(MAX),IDGT(10)
      DATA IDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA IBLANK,IMINUS/1H ,1H-/
C
C     EVEN UP RIGHT MARGIN IF NEEDED
      KSAVE=KOUNT
      KOLLFT=LFTCOL
      IF(KOLLFT-MAX)1,1,26
    1 IF(KOUNT-MAX)2,26,26
    2 IF(KONTRL)26,4,3
    3 IF(KOUNT-KOLLFT)6,26,26
    4 IF(KOUNT-KOLLFT)5,6,5
    5 KOUNT=KOUNT+1
      LETTER(KOUNT)=IBLANK
      IF(KOUNT-KOLLFT)5,6,6
C
C     SET INITIAL POINTERS
    6 KNT=0
      KEEP=KOUNT+1
      IF(NUMBER)8,7,7
C
C     POSITIVE NUMBER
    7 NUMB=NUMBER
      IF(KOUNT-MAX)12,25,25
C
C     NEGATIVE NUMBER
    8 IF(KEEP-MAX)9,25,25
    9 KOUNT=KOUNT+1
      LETTER(KOUNT)=IMINUS
C     ABSOLUTE VALUE OF A NEGATIVE NUMBER IS DECREMENTED
C     BY ONE SINCE, ON A TWO'S COMPLEMENT COMPUTER, THE
C     ABSOLUTE VALUE OF THE LARGEST NEGATIVE NUMBER (SIGN
C     BIT ON AND ALL OTHER BITS OFF) CANNOT BE REPRESENTED.
C     THIS NUMBER CAN BE EASILY OBTAINED IF SIGN BIT IS
C     USED FOR STORING INFORMATION IN SETS.
      INDEX=NUMBER+1
      NUMB=-INDEX
      GO TO 12
C
C     INSERT DIGITS OF NUMBER
   10 INDEX=KOUNT+KNT
   11 LETTER(INDEX+1)=LETTER(INDEX)
      INDEX=INDEX-1
      IF(INDEX-KOUNT)26,12,11
   12 KNT=KNT+1
      INDEX=NUMB
      NUMB=NUMB/IRADIX
      INDEX=INDEX-IRADIX*NUMB
      IF(NUMBER)13,16,16
   13 IF(KNT-1)26,14,16
   14 INDEX=INDEX+1
      IF(INDEX-IRADIX)16,15,26
   15 INDEX=0
      NUMB=NUMB+1
   16 LETTER(KOUNT+1)=IDGT(INDEX+1)
      IF(NUMB)26,18,17
   17 IF(KNT+KOUNT-MAX)10,25,25
   18 KOUNT=KOUNT+KNT
C
C     EVEN UP LEFT MARGIN IF NEEDED
      IF(KONTRL)26,26,19
   19 IF(KOUNT-KOLLFT)20,26,23
C
C     ADD BLANKS TO LEFT MARGIN
   20 DO 21 KNT=KEEP,KOUNT
      INDEX=KOLLFT-KNT+KEEP
      NUMB=KOUNT-KNT+KEEP
   21 LETTER(INDEX)=LETTER(NUMB)
      INDEX=KOLLFT-KOUNT+KEEP-1
      DO 22 KNT=KEEP,INDEX
   22 LETTER(KNT)=IBLANK
      KOUNT=KOLLFT
      GO TO 26
C
C     REMOVE EXCESS DIGITS FROM LEFT MARGIN
   23 DO 24 KNT=KEEP,KOLLFT
      INDEX=KNT+KOUNT-KOLLFT
   24 LETTER(KNT)=LETTER(INDEX)
      KOUNT=KOLLFT
      GO TO 26
   25 KOUNT=KSAVE
   26 RETURN
C     KEEP   = SUBSCRIPT AT WHICH INSERT 1ST CHARACTER.
C     KNT    = NUMBER OF DIGITS ADDED TO ARRAY.
C     KSAVE  = NUMBER OF CHARACTERS IN ORIGINAL ARRAY.
C     NUMB   = ABSOLUTE VALUE OF UNUSED PART OF NUMBER.
C423899686864
      END
      SUBROUTINE DABOTH(INDEX,IFORMT,NAME,KNTLTR,NUMBER,
     1IVALUE,LETTER,KOUNT,MAX)
C
C     ROUTINE TO CREATE ARRAY NAMES WITH DIMENSION NUMBERS
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C
C     INDEX  = NEGATIVE OR 0, A SYMBOL CONTAINING AT LEAST
C              -INDEX CHARACTERS IS PRODUCED IN LETTER
C              ARRAY BY COPYING LOCATIONS 1 THRU KNTLTR OF
C              NAME ARRAY AND INSERTING RIGHT BLANKS IF
C              NECESSARY.
C            = 1 OR GREATER, IS LENGTH OF SYMBOL TO BE
C              OUTPUT IN LETTER ARRAY BY RIGHT JUSTIFYING
C              DIGITS OF NUMBER AND MAKING LEFT CHARACTERS
C              BE THOSE IN NAME ARRAY OR THE LETTER ZERO.
C     IFORMT = -1, NO NUMBER IS GIVEN ENCLOSED IN
C              PARENTHESES.
C            = 0, IVALUE IS REPRESENTED ENCLOSED IN
C              PARENTHESES TO RIGHT OF SYMBOL.
C            = 1 OR GREATER, IVALUE IS REPRESENTED RIGHT
C              JUSTIFIED IN A FIELD OF IFORMT LOCATIONS AND
C              ENCLOSED IN PARENTHESES TO RIGHT OF SYMBOL.
C     NAME   = ALPHAMERIC ARRAY READ BY MULTIPLE OF A1
C              FORMAT AND CONTAINING LETTERS OF SYMBOL.
C     KNTLTR = NUMBER OF SYMBOL CHARACTERS IN NAME ARRAY.
C     NUMBER = NUMBER TO BECOME PART OF SYMBOL IF INDEX=1
C              OR GREATER.
C     IVALUE = NUMBER TO FOLLOW SYMBOL IF IFORMT=1 OR
C              GREATER.
C     LETTER = ARRAY TO RECEIVE SYMBOL.
C     KOUNT  = NUMBER OF LOCATIONS OF LETTER ARRAY IN USE.
C     MAX    = MAXIMUM NUMBER OF LOCATIONS IN LETTER WHICH
C              CAN BE FILLED.
C
      DIMENSION LETTER(MAX),NAME(KNTLTR)
      DATA IBLANK,IZERO,ILPR,IRPR/1H ,1H0,1H(,1H)/
C
C     COPY SYMBOL WITHOUT RIGHT JUSTIFIED NUMBER
      INIT=KOUNT
      IF(INDEX)1,1,8
    1 IF(KOUNT+KNTLTR-MAX)2,2,17
    2 KOLUMN=0
    3 IF(KOLUMN-KNTLTR)4,5,5
    4 KOUNT=KOUNT+1
      KOLUMN=KOLUMN+1
      LETTER(KOUNT)=NAME(KOLUMN)
      GO TO 3
    5 IF(KOUNT-INDEX-KNTLTR-MAX)7,7,15
    6 KOUNT=KOUNT+1
      KOLUMN=KOLUMN+1
      LETTER(KOUNT)=IBLANK
    7 IF(KOLUMN+INDEX)6,13,13
C
C     COPY SYMBOL WITH RIGHT JUSTIFIED NUMBER
    8 KOLUMN=KOUNT+INDEX
      IF(KOLUMN-MAX)9,9,17
    9 LONG=KOUNT
      CALL DANUMB(1,NUMBER,10,LETTER,KOUNT,KOLUMN,MAX)
      KOLUMN=0
   10 LONG=LONG+1
      IF(LETTER(LONG).NE.IBLANK)GO TO 13
      IF(KOLUMN-KNTLTR)12,11,11
   11 LETTER(LONG)=IZERO
      GO TO 10
   12 KOLUMN=KOLUMN+1
      LETTER(LONG)=NAME(KOLUMN)
      GO TO 10
C
C     INSERT NUMBER ENCLOSED IN PARENTHESES
   13 IF(IFORMT)17,14,14
   14 KOLUMN=KOUNT+IFORMT+1
      CALL DANUMB(IFORMT,IVALUE,10,LETTER,KOUNT,KOLUMN,
     1MAX-1)
      IF(KOUNT-KOLUMN)15,16,16
   15 KOUNT=INIT
      GO TO 17
   16 KOLUMN=KOLUMN-IFORMT
      LETTER(KOLUMN)=ILPR
      KOUNT=KOUNT+1
      LETTER(KOUNT)=IRPR
C
C     RETURN TO CALLING PROGRAM
   17 RETURN
C353052349589
      END