Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50506/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,LTRBGN,LTREND/
21H,,1H(,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
MAXXTR=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=72)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 72
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 72
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 72
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 MAXXTR=MAXXTR+1
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 72
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
KNTPNT=KNTPNT+1
IF(KNTPNT.GT.LMTPNT)GO TO 56
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
KNTPNT=KNTPNT+1
IF(KNTPNT.GT.LMTPNT)GO TO 59
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
IF(KNTPNT.GT.LMTPNT)GO TO 4
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 ************************************************
C * *
C * JOIN TREES WITH DIFFERENT LETTERS AT ROOTS *
C * *
C ************************************************
C
72 IF(KNTPNT.LE.0)GO TO 216
IF(MAXXTR.GT.LMTXTR)WRITE(ITTY,73)LMTXTR,MAXXTR
73 FORMAT(42H LTRXTR ARRAY CANNOT HOLD ALL NONALPHABETI,
118HC CHARACTERS FOUND/27H EXCESS CHARACTERS HAVE BEE,
217HN TAKEN AS SPACES/28H RAISE LTRXTR ARRAY SIZE AND,
312H LMTXTR FROM,1I6,3H TO,1I6)
IF(KNTPNT.GT.LMTPNT)GO TO 217
INDEX=1
74 INDEX=INDEX+1
IF(INDEX.GT.KNTPNT)GO TO 75
IF(MCHPNT(INDEX).NE.0)GO TO 74
IF(NOTPNT(INDEX).NE.0)GO TO 74
NOTPNT(INDEX)=1
GO TO 74
C
C ****************************************************
C * *
C * CONVERT FROM BACK TO FORWARD POINTING NOTATION *
C * *
C ****************************************************
C
75 IBEGIN=1
INDEX=0
76 INDEX=INDEX+1
IF(INDEX.GT.KNTPNT)GO TO 94
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 86
IF(NOTVAL.GE.INDEX)GO TO 86
C
C IS FAILURE TRANSFER FROM LETTER HIGHER IN ALPHABET
IF(INITAL(INDEX).EQ.INITAL(NOTVAL))GO TO 77
IF(INITAL(INDEX).NE.0)GO TO 82
GO TO 78
77 IF(ISPELL(INDEX).GE.ISPELL(NOTVAL))GO TO 82
C
C IF FROM HIGHER, PLACE NEW EARLIER IN FAILURE CHAIN
78 NOTPNT(INDEX)=NOTVAL
I=0
79 I=I+1
IF(I.GE.INDEX)GO TO 80
IF(MCHPNT(I).EQ.NOTVAL)MCHPNT(I)=INDEX
GO TO 79
80 IF(NOTVAL.NE.IBEGIN)GO TO 86
IBEGIN=INDEX
I=INDEX
81 I=I+1
IF(I.GT.KNTPNT)GO TO 86
IF(NOTPNT(I).EQ.NOTVAL)NOTPNT(I)=INDEX
GO TO 81
C
C IF FROM LOWER, FIND PROPER PLACE IN FAILURE CAHIN
82 IFORMR=NOTVAL
NOTVAL=NOTPNT(NOTVAL)
IF(NOTVAL.GE.INDEX)GO TO 86
IF(NOTVAL.NE.0)GO TO 83
NOTPNT(IFORMR)=INDEX
GO TO 86
83 IF(INITAL(INDEX).EQ.INITAL(NOTVAL))GO TO 84
IF(INITAL(INDEX).NE.0)GO TO 82
GO TO 85
84 IF(ISPELL(INDEX).GE.ISPELL(NOTVAL))GO TO 82
85 NOTPNT(IFORMR)=INDEX
NOTPNT(INDEX)=NOTVAL
C
C CHECK IF THERE IS A SUCCESS TRANSFER TO BE REVERSED
86 IF(MCHVAL.EQ.0)GO TO 76
IF(MCHVAL.GE.INDEX)GO TO 76
IF(MCHPNT(MCHVAL).GE.INDEX)GO TO 76
C
C IF NONE YET FROM FORMER, JUST PATCH IN NEW NODE
IF(MCHPNT(MCHVAL).NE.0)GO TO 87
MCHPNT(MCHVAL)=INDEX
GO TO 76
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
87 IFORMR=MCHVAL
MCHVAL=MCHPNT(MCHVAL)
IF(MCHVAL.GE.INDEX)GO TO 76
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 88
IF(INITAL(INDEX).NE.0)GO TO 90
GO TO 89
88 IF(ISPELL(INDEX).GE.ISPELL(MCHVAL))GO TO 90
89 MCHPNT(IFORMR)=INDEX
NOTPNT(INDEX)=MCHVAL
GO TO 76
C
C NEW IS HIGHER THAN FIRST IN CHAIN, SO SEARCH FOR
C POSITION OF NEW NEW IN CHAIN AND MAKE PATCH TO CHAIN
90 IFORMR=MCHVAL
MCHVAL=NOTPNT(MCHVAL)
IF(MCHVAL.GE.INDEX)GO TO 76
IF(MCHVAL.NE.0)GO TO 91
NOTPNT(IFORMR)=INDEX
GO TO 76
91 IF(INITAL(INDEX).EQ.INITAL(MCHVAL))GO TO 92
IF(INITAL(INDEX).NE.0)GO TO 90
GO TO 93
92 IF(ISPELL(INDEX).GE.ISPELL(MCHVAL))GO TO 90
93 NOTPNT(IFORMR)=INDEX
NOTPNT(INDEX)=MCHVAL
GO TO 76
C
C ***********************************************
C * *
C * REMOVE DUPLICATE LETTERS IN FAILURE LISTS *
C * *
C ***********************************************
C
94 KEEP=0
LSTSPL=KNTPNT
95 KEEP=KEEP+1
96 IF(KEEP.GT.KNTPNT)GO TO 114
C
C CHECK IF ANY DUPLICATE APPEARS IN FAILURE CHAIN
INNER=KEEP
97 IFORMR=INNER
INNER=NOTPNT(INNER)
IF(INNER.EQ.0)GO TO 95
IF(ISPELL(KEEP).NE.ISPELL(INNER))GO TO 97
IF(INITAL(KEEP).NE.INITAL(INNER))GO TO 97
IF(KOMAND(KEEP).EQ.KOMAND(INNER))GO TO 98
C
C FIND WHICH DUPLICATE NODE IS MOST IMPORTANT
IF(IBLOCK(KEEP).LT.0)GO TO 98
KOMAND(KEEP)=0
IF(IBLOCK(INNER).GE.0)GO TO 98
KOMAND(KEEP)=KOMAND(INNER)
IBLOCK(KEEP)=-1
98 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 99
MCHPNT(KEEP)=MCHPNT(KILL)
GO TO 107
C
C IF KEPT NODE HAS SUCCESS CHAIN, MUST MERGE BOTH
99 IGRAFT=MCHPNT(KILL)
IF(IGRAFT.EQ.0)GO TO 107
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 100
IF(INITAL(IGRAFT).NE.0)GO TO 102
GO TO 101
100 IF(ISPELL(IGRAFT).GE.ISPELL(INNER))GO TO 102
101 MCHPNT(KEEP)=IGRAFT
I=INNER
INNER=IGRAFT
IGRAFT=I
C
C WEAVE FAILURE LISTS EXTENDING FROM SUCCESS TRANSFERS
102 IFORMR=INNER
INNER=NOTPNT(INNER)
IF(INNER.EQ.0)GO TO 106
103 IF(INITAL(IGRAFT).EQ.INITAL(INNER))GO TO 104
IF(INITAL(IGRAFT).NE.0)GO TO 102
GO TO 105
104 IF(ISPELL(IGRAFT).GE.ISPELL(INNER))GO TO 102
105 NOTPNT(IFORMR)=IGRAFT
IFORMR=IGRAFT
IGRAFT=NOTPNT(IGRAFT)
NOTPNT(IFORMR)=INNER
IF(IGRAFT.NE.0)GO TO 103
GO TO 107
106 NOTPNT(IFORMR)=IGRAFT
C
C MOVE NODE AT END OF ARRAYS DOWN TO POSITION WHICH
C WAS OCCUPIED BY NODE BEING KILLED
107 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 111 I=1,KNTPNT
J=MCHPNT(I)
IF(J.NE.KILL)GO TO 108
MCHPNT(I)=KEEP
GO TO 109
108 IF(J.EQ.KNTPNT)MCHPNT(I)=KILL
109 J=NOTPNT(I)
IF(J.NE.KILL)GO TO 110
NOTPNT(I)=KEEP
GO TO 111
110 IF(J.EQ.KNTPNT)NOTPNT(I)=KILL
111 CONTINUE
C
C CHECK IF NODE AT ROOT OF TREE WAS SHIFTED
IF(IBEGIN.NE.KILL)GO TO 112
IBEGIN=KEEP
GO TO 113
112 IF(IBEGIN.EQ.KNTPNT)IBEGIN=KILL
C
C REDUCE SIZE OF TREE BY ONE NODE, THEN CONTINUE SEARCH
113 KNTPNT=KNTPNT-1
GO TO 96
114 IF(LSTSPL.NE.KNTPNT)GO TO 94
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 115 I=1,KNTPNT
IF(IBLOCK(I).GT.0)IBLOCK(I)=0
115 CONTINUE
C
C LOOK FOR LETTERS BEYOND NODES IN MERGED ROOTS
INDEX=0
116 INDEX=INDEX+1
IF(INDEX.GT.KNTPNT)GO TO 120
IF(IBLOCK(INDEX).LT.0)GO TO 117
IF(KOMAND(INDEX).NE.0)GO TO 116
117 I=MCHPNT(INDEX)
IF(I.LE.0)GO TO 116
118 IF(IBLOCK(I).NE.0)GO TO 119
IF(KOMAND(I).NE.0)IBLOCK(I)=1
119 I=NOTPNT(I)
IF(I.NE.0)GO TO 118
GO TO 116
C
C **************************************************
C * *
C * PRUNE IDENTICAL BRANCHES FROM TREE STRUCTURE *
C * *
C **************************************************
C
C
C DO NOT PRUNE DIFFERENT BLOCKAGES OF SAME COMMAND
120 IPASS=0
C
C GET REFERENCE NODE
121 KEEP=KNTPNT
LSTSPL=KNTPNT
122 KEEP=KEEP-1
IF(KEEP.LE.1)GO TO 135
C
C CHECK IF ANY NODE IS SAME AS REFERENCE NODE
KILL=KEEP
123 KILL=KILL+1
124 IF(KILL.GT.KNTPNT)GO TO 122
IF(ISPELL(KILL).NE.ISPELL(KEEP))GO TO 123
IF(MCHPNT(KILL).NE.MCHPNT(KEEP))GO TO 123
IF(NOTPNT(KILL).NE.NOTPNT(KEEP))GO TO 123
IF(INITAL(KILL).NE.INITAL(KEEP))GO TO 123
IF(KOMAND(KILL).NE.KOMAND(KEEP))GO TO 127
IF(IPASS.NE.0)GO TO 126
IF(IBLOCK(KEEP).NE.0)GO TO 125
IF(IBLOCK(KILL).NE.0)GO TO 123
GO TO 128
125 IF(IBLOCK(KILL).EQ.0)GO TO 123
GO TO 128
126 IF(IBLOCK(KILL).NE.0)IBLOCK(KEEP)=1
GO TO 128
127 IF(IBLOCK(KEEP).NE.0)GO TO 123
IF(IBLOCK(KILL).NE.0)GO TO 123
KOMAND(KEEP)=0
C
C MOVE NODE AT END OF TREE TO POSITION OF KILLED NODE
128 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 132 I=1,KNTPNT
J=MCHPNT(I)
IF(J.NE.KILL)GO TO 129
MCHPNT(I)=KEEP
GO TO 130
129 IF(J.EQ.KNTPNT)MCHPNT(I)=KILL
130 J=NOTPNT(I)
IF(J.NE.KILL)GO TO 131
NOTPNT(I)=KEEP
GO TO 132
131 IF(J.EQ.KNTPNT)NOTPNT(I)=KILL
132 CONTINUE
C
C CHECK IF NODE AT ROOT OF TREE WAS SHIFTED
IF(IBEGIN.NE.KILL)GO TO 133
IBEGIN=KEEP
GO TO 134
133 IF(IBEGIN.EQ.KNTPNT)IBEGIN=KILL
C
C REDUCE SIZE OF TREE BY ONE NODE, THEN CONTINUE SEARCH
134 KNTPNT=KNTPNT-1
GO TO 124
C
C CHECK IF ANY NODE WAS REMOVED IN THIS SEARCH
135 IF(LSTSPL.NE.KNTPNT)GO TO 120
C
C ALLOW PRUNING DIFFERENT BLOCKAGES OF SAME COMMAND
IPASS=1-IPASS
IF(IPASS.NE.0)GO TO 121
C
C MARK FIRST CHARACTERS IN COMMANDS AS FIRST IN WORDS
INDEX=IBEGIN
136 INITAL(INDEX)=1
INDEX=NOTPNT(INDEX)
IF(INDEX.GT.0)GO TO 136
C
C ****************************************************
C * *
C * DETERMINE ORDER IN WHICH NODES ARE ENCOUNTERED *
C * *
C ****************************************************
C
C MARK THAT NO NODES ARE IN KNOWN POSITIONS
DO 137 I=1,KNTPNT
137 IBLOCK(I)=0
KNTSRT=0
MCHNOW=IBEGIN
NODKNT=0
C
C STORE NEXT NODE ON LIST OF NODES IN CURRENT COMMAND
138 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 139
KNTSRT=KNTSRT+1
GO TO 141
139 IF(KOMPAR.EQ.KNTSRT)GO TO 142
DO 140 I=1,KNTPNT
IF(IBLOCK(I).GT.KOMPAR)IBLOCK(I)=IBLOCK(I)-1
140 CONTINUE
141 IBLOCK(MCHNOW)=KNTSRT
C
C GET NEXT NODE IN CURRENT COMMAND
142 MCHNOW=MCHPNT(MCHNOW)
IF(MCHNOW.GT.0)GO TO 138
C
C GET NEXT NODE IN NEXT COMMAND
143 MCHNOW=NODLST(NODKNT)
NODKNT=NODKNT-1
MCHNOW=NOTPNT(MCHNOW)
IF(MCHNOW.GT.0)GO TO 138
IF(NODKNT.GT.0)GO TO 143
C
C *****************************************************
C * *
C * REARRANGE NODES INTO ORDER IN WHICH ENCOUNTERED *
C * *
C *****************************************************
C
DO 149 INDEX=1,KNTPNT
IF(IBLOCK(INDEX).EQ.INDEX)GO TO 149
C
C FIND NODE TO BE MOVED TO CURRENT POSITION IN TREE
IFINAL=INDEX
144 IFINAL=IFINAL+1
IF(IFINAL.GT.KNTPNT)GO TO 149
IF(IBLOCK(IFINAL).NE.INDEX)GO TO 144
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 148 I=1,KNTPNT
J=MCHPNT(I)
IF(J.NE.INDEX)GO TO 145
MCHPNT(I)=IFINAL
GO TO 146
145 IF(J.EQ.IFINAL)MCHPNT(I)=INDEX
146 J=NOTPNT(I)
IF(J.NE.INDEX)GO TO 147
NOTPNT(I)=IFINAL
GO TO 148
147 IF(J.EQ.IFINAL)NOTPNT(I)=INDEX
148 CONTINUE
149 CONTINUE
KNTPNT=KNTSRT
C
C ************************************************
C * *
C * GENERATE LIST OF ALL RECOGNIZABLE COMMANDS *
C * *
C ************************************************
C
C WRITE HEADING INTO LISTING FILE
IF(LNGLBL.EQ.0)WRITE(ILPT,150)
150 FORMAT(1X/17H KEY WORDS)
IF(LNGLBL.GT.0)WRITE(ILPT,151)(LTRLBL(I),I=1,LNGLBL)
151 FORMAT(1X/36H KEY WORDS FOR TEST GLOSSARY ,
16A1)
WRITE(ILPT,152)
152 FORMAT(1X)
C
C FIND MINIMUM AND MAXIMUM VALUES FOR ANY COMMAND
NXTVAL=KOMAND(1)
MAXMUM=NXTVAL
DO 153 I=1,KNTPNT
IF(NXTVAL.GT.KOMAND(I))NXTVAL=KOMAND(I)
IF(MAXMUM.LT.KOMAND(I))MAXMUM=KOMAND(I)
153 CONTINUE
IF(NXTVAL.GT.0)NXTVAL=0
JEXTND=0
C
C PREPARE TO FIND FIRST COMMAND
154 MINMUM=NXTVAL
NXTVAL=MAXMUM
MCHNOW=1
NODKNT=0
KNTSHO=0
C
C FIND NEXT COMMAND
155 KMDNOW=0
156 IF(KMDNOW.EQ.0)GO TO 157
IF(KOMAND(MCHNOW).EQ.0)GO TO 158
IF(KMDNOW.NE.KOMAND(MCHNOW))GO TO 159
157 KMDNOW=KOMAND(MCHNOW)
158 NODKNT=NODKNT+1
NODLST(NODKNT)=MCHNOW
MCHNOW=MCHPNT(MCHNOW)
IF(MCHNOW.GT.0)GO TO 156
IEXTND=0
GO TO 160
159 IEXTND=1
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 178
IF(KMDNOW.EQ.MINMUM)GO TO 162
IF(NXTVAL.GT.KMDNOW)NXTVAL=KMDNOW
GO TO 178
C
C CONSTRUCT THE LINE OF TEXT DESCRIBING THE COMMAND
162 MAXPRT=0
KMDLST=0
DO 170 I=1,NODKNT
J=NODLST(I)
KMDNEW=KOMAND(J)
IF(KMDNEW.EQ.KMDLST)GO TO 165
IF(KMDLST.EQ.KMDNOW)GO TO 164
IF(KMDLST.EQ.0)GO TO 165
IF(KMDNEW.EQ.0)GO TO 163
IF(KMDNEW.NE.KMDNOW)GO TO 165
163 MAXPRT=MAXPRT+1
LTRBFR(MAXPRT)=LTREND
GO TO 165
164 MAXPRT=MAXPRT+1
LTRBFR(MAXPRT)=LTRRIT
165 IF(INITAL(J).EQ.0)GO TO 166
MAXPRT=MAXPRT+1
LTRBFR(MAXPRT)=LTRSPC
166 IF(KMDNEW.EQ.KMDLST)GO TO 169
IF(KMDNEW.EQ.KMDNOW)GO TO 168
IF(KMDNEW.EQ.0)GO TO 169
IF(KMDLST.EQ.0)GO TO 167
IF(KMDLST.NE.KMDNOW)GO TO 169
167 MAXPRT=MAXPRT+1
LTRBFR(MAXPRT)=LTRBGN
GO TO 169
168 MAXPRT=MAXPRT+1
LTRBFR(MAXPRT)=LTRLFT
169 MAXPRT=MAXPRT+1
J=ISPELL(J)
IF(J.LE.26)LTRBFR(MAXPRT)=LTRABC(J)
IF(J.GT.26)LTRBFR(MAXPRT)=LTRXTR(J-26)
170 KMDLST=KMDNEW
IF(KMDLST.EQ.0)GO TO 171
MAXPRT=MAXPRT+1
LTRBFR(MAXPRT)=LTRRIT
C
C WRITE LINE TO LISTING FILE DESCRIBING THE COMMAND
171 IF(IEXTND.NE.0)GO TO 174
IF(KNTSHO.EQ.0)WRITE(ILPT,172)KMDNOW,
1(LTRBFR(I),I=1,MAXPRT)
172 FORMAT(1X,1I6,80A1)
IF(KNTSHO.GT.0)WRITE(ILPT,173)(LTRBFR(I),I=1,MAXPRT)
173 FORMAT(7X,80A1)
GO TO 177
174 IF(KNTSHO.EQ.0)WRITE(ILPT,175)KMDNOW,
1(LTRBFR(I),I=1,MAXPRT)
175 FORMAT(1X,1H*1I5,80A1)
IF(KNTSHO.GT.0)WRITE(ILPT,176)(LTRBFR(I),I=1,MAXPRT)
176 FORMAT(1X,1H*,5X,80A1)
JEXTND=1
177 KNTSHO=KNTSHO+1
C
C CHECK IF THERE ARE ANY MORE COMMANDS TO DISPLAY
178 IF(MCHNOW.NE.0)GO TO 155
179 MCHNOW=NODLST(NODKNT)
NODKNT=NODKNT-1
MCHNOW=NOTPNT(MCHNOW)
IF(MCHNOW.GT.0)GO TO 155
IF(NODKNT.GT.0)GO TO 179
IF(MINMUM.LT.MAXMUM)GO TO 154
IF(JEXTND.NE.0)WRITE(ILPT,180)
180 FORMAT(1X/1X,26H* IN LEFT COLUMN INDICATES,
126H SUBSET OF ANOTHER COMMAND)
C
C ************************************************
C * *
C * GENERATE CHECKSUMS CHARACTERIZING GLOSSARY *
C * *
C ************************************************
C
C GENERATE CHECKSUMS FOR CURRENT GLOSSARY
DO 181 I=1,5
181 ICHECK(I)=0
DO 192 I=1,KNTPNT
ICHECK(1)=ICHECK(1)+(I*KOMAND(I))
182 IF(ICHECK(1).LT.10000)GO TO 183
ICHECK(1)=ICHECK(1)-10000
GO TO 182
183 IF(ICHECK(1).GT.-10000)GO TO 184
ICHECK(1)=ICHECK(1)+10000
GO TO 183
184 ICHECK(2)=ICHECK(2)+(I*INITAL(I))
185 IF(ICHECK(2).LT.10000)GO TO 186
ICHECK(2)=ICHECK(2)-10000
GO TO 185
186 ICHECK(3)=ICHECK(3)+(I*ISPELL(I))
187 IF(ICHECK(3).LT.10000)GO TO 188
ICHECK(3)=ICHECK(3)-10000
GO TO 187
188 ICHECK(4)=ICHECK(4)+(I*MCHPNT(I))
189 IF(ICHECK(4).LT.10000)GO TO 190
ICHECK(4)=ICHECK(4)-10000
GO TO 189
190 ICHECK(5)=ICHECK(5)+(I*NOTPNT(I))
191 IF(ICHECK(5).LT.10000)GO TO 192
ICHECK(5)=ICHECK(5)-10000
GO TO 191
192 CONTINUE
C
C COMPARE CALCULATED AND COMPUTED CHECKSUMS
DO 193 I=1,5
IF(ICOMPR(I).NE.0)GO TO 194
193 CONTINUE
GO TO 201
194 DO 195 I=1,5
IF(ICHECK(I).NE.ICOMPR(I))GO TO 198
195 CONTINUE
IF(LNGLBL.EQ.0)WRITE(ITTY,196)
196 FORMAT(1X,5HVALID)
IF(LNGLBL.GT.0)WRITE(ITTY,197)(LTRLBL(I),I=1,LNGLBL)
197 FORMAT(1X,6A1)
GO TO 201
198 IF(LNGLBL.EQ.0)WRITE(ITTY,199)
199 FORMAT(1X,27HERROR IN UNLABELED GLOSSARY)
IF(LNGLBL.GT.0)WRITE(ITTY,200)(LTRLBL(I),I=1,LNGLBL)
200 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
201 IF(LNGLBL.GT.0)WRITE(IOUT,202)(LTRLBL(I),I=1,LNGLBL)
202 FORMAT(1HC/20HC TEST GLOSSARY ,6A1)
WRITE(IOUT,203)KNTPNT,MAXSPL,LMTPNT
203 FORMAT(1HC/25HC FINAL STORAGE USED=,1I4,
112H, MOST USED=,1I5,8H, LIMIT=,1I5)
WRITE(IOUT,204)(ICHECK(I),I=1,5)
204 FORMAT(1HC/15HC CHECKSUMS,1I5,1H,,1I4,1H,,
11I4,1H,,1I4,1H,,1I4)
WRITE(IOUT,213)
C
C WRITE CONTENTS OF EACH NODE
LIMIT=0
205 INDEX=LIMIT+1
LIMIT=LIMIT+15
IF(LIMIT.GT.KNTPNT)LIMIT=KNTPNT
J=0
DO 206 I=INDEX,LIMIT
J=J+1
206 NODLST(J)=I
WRITE(IOUT,208)(NODLST(I),I=1,J)
WRITE(IOUT,209)(KOMAND(I),I=INDEX,LIMIT)
J=0
DO 207 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)
207 CONTINUE
WRITE(IOUT,210)(LTRBFR(I),I=1,J)
WRITE(IOUT,211)(MCHPNT(I),I=INDEX,LIMIT)
WRITE(IOUT,212)(NOTPNT(I),I=INDEX,LIMIT)
WRITE(IOUT,213)
IF(LIMIT.LT.KNTPNT)GO TO 205
208 FORMAT(14HC COUNT ,15I3)
209 FORMAT(14HC COMMAND ,15I3)
210 FORMAT(14HC LETTER ,45A1)
211 FORMAT(14HC SUCCESS ,15I3)
212 FORMAT(14HC FAILURE ,15I3)
213 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 214 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)
214 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,215)LTR3RD,LTR5TH,KNTPNT,KNTXTR
215 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)
216 IF(IEOF.NE.0)GO TO 1
GO TO 219
C
C INFORM USER OF ESTIMATED ARRAY SIZE IF OVERFLOW
217 WRITE(ITTY,218)LMTPNT,KNTPNT
218 FORMAT(25H TREE CANNOT BE GENERATED/13H RAISE ARRAY ,
121HSIZES AND LMTPNT FROM,1I6,3H TO,1I6)
219 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 LTRBGN = The less than sign. This is used in the
C listing file to mark start of sequence of
C characters which are unique to some other
C command.
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 LTREND = The greater than sign. This is used in the
C listing file to mark end of sequence of
C characters which are unique to some other
C command.
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 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.
C022110724155<>
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