Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50553/fndsub.for
There are no other files named fndsub.for in the archive.
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 DACOPY(INITAL,INTRVL,IBUFFR,IBEGIN,IFINAL,
1JFINAL,JUSED,JBUFFR,NXTINI,NXTBGN,MAXPRT)
C RENBR(/COPY BUFFER EXPANDING TABS TO SPACES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THE TAB CHARACTER IS A NONPRINTING CHARACTER WHICH
C CAUSES THE FOLLOWING CHARACTER TO APPEAR IN THE NEXT
C COLUMN BEYOND THE NEXT MULTIPLE OF THE TAB STOP.
C
C INITAL = LESS THAN ZERO, PROVIDING THAT INTRVL IS
C GREATER THAN ZERO, THE NUMBER OF EXTRA
C SPACES INDICATED BY THE ABSOLUTE VALUE OF
C INITAL ARE TO BE INSERTED AT THE START OF
C THE JBUFFR ARRAY BEFORE THE CONTENTS OF THE
C IBUFFR ARRAY IS COPIED INTO THE JBUFFR
C ARRAY. THE FIRST TAB STOP WILL BE OF THE
C WIDTH INDICATED BY INTRVL. IF INTRVL IS
C LESS THAN OR EQUAL TO ZERO, THEN NO LEADING
C SPACES WILL BE INSERTED INTO THE JBUFFR
C ARRAY WHETHER REQUESTED BY INITAL OR BY
C LEADING SPACES OR TABS IN THE IBUFFR ARRAY.
C = EQUAL TO OR GREATER THAN ZERO, INITAL IS THE
C NUMBER OF SPACES TO THE FIRST TAB STOP. IF
C INITAL IS ZERO, THEN COPYING HAS ALREADY
C PASSED BEYOND THE FIRST TAB STOP AND THE
C DISTANCE TO THE NEXT TAB STOP IS TAKEN AS
C THE ABSOLUTE VALUE OF INTRVL. IF THE FIRST
C CHARACTER IN THE INPUT BUFFER IS A TAB, IT
C WILL BE EXPANDED TO THIS NUMBER OF SPACES.
C INITAL CAN EQUAL EITHER ZERO OR THE VALUE OF
C INTRVL IF THE FIRST TAB STOP IS TO BE OF THE
C SAME WIDTH AS THOSE WHICH FOLLOW IT.
C INTRVL = THE ABSOLUTE VALUE OF INTRVL IS THE TAB STOP
C INTERVAL. A TAB CHARACTER IN THE INPUT
C BUFFER CAUSES THE FOLLOWING CHARACTER TO GO
C INTO THE NEXT POSITION BEYOND THE SUM OF THE
C ABSOLUTE VALUE OF INITAL AND NEXT MULTIPLE
C OF THE ABSOLUTE VALUE OF INTRVL.
C = LESS THAN ZERO, NO LEADING SPACES ARE TO BE
C INSERTED INTO THE JBUFFR ARRAY WHETHER
C REQUESTED BY A NEGATIVE VALUE OF INITAL OR
C BY LEADING SPACES OR TABS IN THE IBUFFR
C ARRAY. ONCE A PRINTING CHARACTER HAS BEEN
C COPIED INTO THE JBUFFR ARRAY, HOWEVER, THEN
C ALL REMAINING SPACES WILL BE COPIED AND ALL
C REMAINING TABS WILL BE EXPANDED TO SPACES.
C = ZERO, NO SPACES ARE TO BE INSERTED INTO THE
C JBUFFR ARRAY. TABS IN THE IBUFFR ARRAY ARE
C IGNORED, AND SPACES ARE NOT COPIED.
C = GREATER THAN ZERO, ALL SPACES WHETHER
C REQUESTED BY A NEGATIVE VALUE OF INITAL OR
C BY SPACES OR TABS IN THE IBUFFR ARRAY ARE
C INSERTED INTO THE JBUFFR ARRAY.
C IBUFFR = THE INPUT BUFFER WHICH IS TO BE COPIED INTO
C THE OUTPUT BUFFER EXPANDING ANY TABS FOUND.
C IBUFFR CONTAINS CHARACTERS READ BY A1
C FORMAT.
C IBEGIN = SUBSCRIPT IN IBUFFR ARRAY AT WHICH IS TO BE
C FOUND THE FIRST CHARACTER TO BE COPIED.
C IFINAL = SUBSCRIPT IN IBUFFR ARRAY AT WHICH IS TO BE
C FOUND THE FINAL CHARACTER TO BE COPIED.
C JFINAL = THE DIMENSION OF JBUFFR ARRAY.
C JUSED = SUBSCRIPT OF THE LOWEST LOCATION IN JBUFFR
C ARRAY WHICH IS CURRENTLY IN USE AND WHICH
C CONTAINS DATA WHICH MUST BE MAINTAINED.
C JUSED IS RETURNED CONTAINING THE SUBSCRIPT
C OF THE HIGHEST LOCATION INTO WHICH DACOPY
C HAS PLACED A CHARACTER.
C JBUFFR = ARRAY INTO WHICH THE CONTENTS OF IBUFFR ARE
C TO BE COPIED EXPANDING TABS TO SPACES.
C NXTINI = RETURNED CONTAINING VALUE NEXT TO BE GIVEN
C TO INITAL IF THE CURRENT CALL COULD NOT
C COMPLETELY REPESENT THE CONTENTS OF THE
C IBUFFR ARRAY DUE TO THE ROOM AVAILABLE IN
C JBUFFR BEING TOO SMALL. IF A TAB WAS
C ENCOUNTERED IN IBUFFR BUT COULD NOT BE
C COMPLETELY REPRESENTED, THEN NXTINI WILL BE
C NEGATIVE. IF THE LAST CHARACTER ENCOUNTERED
C IN THE IBUFFR ARRAY WAS NOT A TAB, THEN
C NXTINI WILL BE RETURNED WITH THE REMAINING
C DISTANCE TO THE NEXT TAB STOP.
C NXTBGN = RETURNED CONTAINING THE SUBSCRIPT WITHIN THE
C IBUFFR ARRAY OF THE FIRST LETTER WHICH COULD
C NOT BE REPRESENTED IN THE OUTPUT BUFFER. IF
C ALL LETTERS COULD BE REPRESENTED, THEN
C NXTBGN WILL BE RETURNED CONTAINING IFINAL+1.
C NOTE THAT IF A TAB IS REPRESENTED EVEN BY
C SINGLE SPACE, THEN NXTBGN IS PASSED BEYOND
C THIS TAB ALTHOUGH THERE MIGHT NOT BE ENOUGH
C ROOM IN THE OUTPUT BUFFER TO FILL COMPLETELY
C TO THE NEXT TAB STOP.
C MAXPRT = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C LOCATION IN JBUFFR ARRAY INTO WHICH DACOPY
C HAS PLACED A PRINTING CHARACTER.
C
DIMENSION IBUFFR(IFINAL),JBUFFR(JFINAL)
C
C ISPACE = THE SPACE CHARACTER
C ITAB = THE TAB CHARACTER
DATA ISPACE,ITAB/1H ,1H /
C
C INITIAL POINTERS
INDEX=IBEGIN-1
IPRINT=JUSED
LIMIT=INITAL
C
C INSERT EXTRA SPACES AT START IF INITAL.LT.0
IF(INTRVL.LE.0)GO TO 2
JNTRVL=INTRVL
NONSPC=1
1 IF(LIMIT.GE.0)GO TO 4
LIMIT=-LIMIT
GO TO 6
2 JNTRVL=-INTRVL
NONSPC=0
GO TO 4
C
C TEST IF ARE AT END OF EITHER INPUT OR OUTPUT BUFFERS
3 LIMIT=0
4 INDEX=INDEX+1
IF(JUSED.GE.JFINAL)GO TO 11
IF(INDEX.GT.IFINAL)GO TO 11
C
C ADJUST NUMBER OF COLUMNS LEFT UNTIL NEXT TAB STOP
IF(LIMIT.LE.0)LIMIT=JNTRVL
LIMIT=LIMIT-1
C
C TEST IF NEW CHARACTER IS A SPACE OR A TAB
IF(IBUFFR(INDEX).EQ.ISPACE)GO TO 7
IF(IBUFFR(INDEX).NE.ITAB)GO TO 8
C
C IF FIND A TAB, COPY IN THE SPACES TO NEXT TAB STOP
IF(NONSPC.EQ.0)GO TO 3
5 JUSED=JUSED+1
JBUFFR(JUSED)=ISPACE
IF(LIMIT.LE.0)GO TO 4
6 IF(JUSED.GE.JFINAL)GO TO 10
LIMIT=LIMIT-1
GO TO 5
C
C IF FIND CHARACTER OTHER THAN A TAB, JUST COPY IT
7 IF(NONSPC.EQ.0)GO TO 4
GO TO 9
8 IPRINT=JUSED+1
NONSPC=JNTRVL
9 JUSED=JUSED+1
JBUFFR(JUSED)=IBUFFR(INDEX)
GO TO 4
C
C NOT ENOUGH ROOM FOR ALL SPACES IN TAB EXPANSION
10 LIMIT=-LIMIT
INDEX=INDEX+1
C
C RETURN TO CALLING PROGRAM
11 NXTINI=LIMIT
NXTBGN=INDEX
MAXPRT=IPRINT
RETURN
C243897269317
END
SUBROUTINE DALOSS(LOWWRD,MAXWRD,IWORD ,LOWKNT,MAXKNT,
1 KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND ,MATCH ,LCNWRD,
2 LCNKNT,LCNBFR,MANY ,LCNERR)
C RENBR(/DELIMITER WRAPPER FOR DAVERB)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DALOSS IDENTIFIES WORDS AND ABBREVIATIONS, ALLOWS
C COMMAS BETWEEN WORDS, IDENTIFIES MISSING ITEMS
C INDICATED BY EXTRA COMMAS, SKIPS OVER ANY TEXT WHICH
C IS TO RIGHT OF EITHER EXCLAMATION POINT OR AMPERSAND,
C AND REPORTS ANY SEMICOLONS FOUND IN TEXT BEING
C EVALUATED. IN ADDITION, DALOSS REPORTS WHETHER
C CHARACTER TO RIGHT OF WORD OR ITS ABBREVIATION IS
C CHARACTER OTHER THAN SPACE, TAB CHARACTER OR ALLOWED
C PUNCTUATION CHARACTER.
C
C ARGUMENT LISTS OF DALOSS AND DAVERB ARE IDENTICAL
C EXCEPT FOR DALOSS ARGUMENTS MANY AND LCNERR WHICH DO
C NOT APPEAR IN DAVERB ARGUMENT LIST, AND EXCEPT THAT
C DALOSS CAN RETURN ARGUMENT NAMED KIND CONTAINING
C ADDITIONAL VALUES 6 THROUGH 11. ARGUMENT NAMED MANY
C MUST BE SET TO ZERO BY CALLING PROGRAM BEFORE CALLING
C EITHER THIS ROUTINE OR ANY OF OTHER ROUTINES IN FASP
C PACKAGE (SUCH AS DAMISS, DANEXT AND DASPAN) WHICH
C DEFINE THIS ARGUMENT IN SIMILAR MANNER. ARGUMENTS
C NAMED KIND AND LCNERR ARE USED ONLY FOR OUTPUT TO
C CALLING PROGRAM AND THEIR INPUT VALUES ARE IGNORED.
C THESE ARGUMENTS ARE DESCRIBED BELOW. DOCUMENTATION
C OF DAVERB SHOULD BE CONSULTED FOR DESCRIPTIONS OF
C REMAINING ARGUMENTS.
C
C KIND = 1, NOTHING, EXCEPT PERHAPS COMMENT INDICATED
C BY LEADING EXCLAMATION POINT, WAS FOUND AT
C OR TO RIGHT OF IBUFFR(LOWBFR). CALLING
C PROGRAM SHOULD READ NEW LINE INTO IBUFFR
C ARRAY BEFORE AGAIN CALLING THIS ROUTINE IF
C ADDITIONAL WORDS ARE REQUIRED. LOWBFR IS
C RETURNED POINTING BEYOND END OF BUFFER.
C MANY IS RETURNED SET TO ZERO. MATCH IS
C RETURNED UNDEFINED.
C = 2, FIRST PRINTING CHARACTER (OTHER THAN
C POSSIBLE COMMA IF MANY WAS INPUT GREATER
C THAN ZERO) IN OR TO RIGHT OF IBUFFR(LOWBFR)
C DID NOT MATCH FIRST CHARACTER OF ANY WORD IN
C DICTIONARY AND WAS NOT COMMA, SEMICOLON,
C AMPERSAND OR EXCLAMATION POINT. LOWBFR IS
C RETURNED POINTING TO THIS PRINTING
C CHARACTER. IT IS EXPECTED THAT CALLING
C PROGRAM WILL OTHERWISE PROCESS THIS PRINTING
C CHARACTER SINCE DALOSS WOULD RETURN SAME
C RESULTS IF CALLED AGAIN WITH SAME VALUE OF
C LOWBFR, WITH SAME DICTIONARY AND WITH SAME
C BUFFER CONTENTS. MANY IS RETURNED
C CONTAINING ONE PLUS ITS INPUT ABSOLUTE
C VALUE. MATCH IS RETURNED UNDEFINED.
C = 3 OR 4 OR 5, SAME AS WHEN DAVERB RETURNS
C THESE VALUES, EXCEPT THAT IF THERE ARE
C ADDITIONAL CHARACTERS TO RIGHT OF WORD OR
C ITS ABBREVIATION, THEN CHARACTER TO
C IMMEDIATE RIGHT OF WORD OR ITS ABBREVIATION
C IS EITHER SPACE, TAB CHARACTER, COMMA,
C SEMICOLON, EXCLAMATION POINT OR AMPERSAND.
C MANY IS RETURNED CONTAINING ONE PLUS ITS
C INPUT ABSOLUTE VALUE. LOWBFR IS RETURNED
C POINTING TO CHARACTER TO RIGHT OF WORD OR
C ITS ABBREVIATION.
C = 3, WORD IN IWORD ARRAY WAS MATCHED EXACTLY.
C MATCH IS RETURNED CONTAINING SEQUENCE NUMBER
C OF WORD MATCHED IN IWORD ARRAY.
C = 4, NONAMBIGUOUS ABBREVIATION OF WORD IN
C IWORD ARRAY WAS FOUND. MATCH IS RETURNED
C CONTAINING SEQUENCE NUMBER OF WORD IN IWORD
C ARRAY.
C = 5, AMBIGUOUS ABBREVIATION OF WORD WAS FOUND.
C MATCH IS RETURNED CONTAINING SEQUENCE NUMBER
C OF FIRST WORD MATCHED IN IWORD ARRAY.
C = 6 OR 7 OR 8, SAME AS KIND RETURNED
C CONTAINING 3 OR 4 OR 5 RESPECTIVELY, EXCEPT
C THAT CHARACTER OTHER THAN SPACE, TAB
C CHARACTER, COMMA, SEMICOLON, EXCLAMATION
C POINT OR AMPERSAND APPEARED TO IMMEDIATE
C RIGHT OF WORD OR ITS ABBREVIATION. LCNBFR
C IS RETURNED POINTING IN BUFFER TO FIRST
C CHARACTER OF WORD OR ITS ABBREVIATION.
C LOWBFR IS RETURNED POINTING IN BUFFER TO
C CHARACTER TO RIGHT OF WORD OR ITS
C ABBREVIATION. LCNERR IS RETURNED POINTING
C IN BUFFER TO NEXT SPACE, TAB CHARACTER,
C COMMA, SEMICOLON, EXCLAMATION POINT OR
C AMPERSAND TO RIGHT OF WORD OR ITS
C ABBREVIATION, OR IS RETURNED POINTING BEYOND
C END OF BUFFER IF NO SPACE, TAB CHARACTER,
C COMMA, SEMICOLON, EXCLAMATION POINT OR
C AMPERSAND IS FOUND TO RIGHT OF WORD OR ITS
C ABBREVIATION. MANY IS RETURNED CONTAINING
C ONE PLUS ITS INPUT ABSOLUTE VALUE.
C = 9, SEMICOLON WAS FOUND AS FIRST PRINTING
C CHARACTER AT OR TO RIGHT OF IBUFFR(LOWBFR).
C LOWBFR IS RETURNED POINTING TO NEXT
C CHARACTER BEYOND SEMICOLON. IT IS ASSUMED
C THAT CALLING PROGRAM WILL TREAT APPEARANCE
C OF SEMICOLON AS MARKING END OF STATEMENT.
C MANY IS RETURNED SET TO ZERO. MATCH IS
C RETURNED UNDEFINED.
C = 10, AMPERSAND WAS FOUND AS FIRST PRINTING
C CHARACTER AT OR TO RIGHT OF LOWBFR. TEXT TO
C RIGHT OF AMPERSAND IS TAKEN AS COMMENT SO
C LOWBFR IS RETURNED POINTING BEYOND RIGHT END
C OF BUFFER. IT IS ASSUMED THAT CALLING
C PROGRAM WILL READ IN CONTENTS OF NEW BUFFER,
C THEN AGAIN REQUEST NEW WORD IDENTIFICATION
C FROM THIS ROUTINE. VALUE OF MANY MUST NOT
C BE CHANGED BY CALLING PROGRAM PRIOR TO THIS
C FOLLOWING CALL. EFFECT IS NOT QUITE SAME AS
C IF USER HAD TYPED ALL OF TEXT ON SINGLE LINE
C SINCE SINGLE WORD CANNOT BE SPLIT ACROSS
C LINE BOUNDARY. MATCH IS RETURNED UNDEFINED.
C = 11, WORD WAS NOT FOUND, BUT EXTRA COMMA WAS
C FOUND INDICATING MISSING WORD. MANY IS
C RETURNED CONTAINING ONE PLUS ITS INPUT
C ABSOLUTE VALUE. MATCH IS RETURNED
C UNDEFINED.
C
C MANY = SHOULD BE INPUT CONTAINING ZERO EACH TIME
C THIS ROUTINE IS CALLED TO BEGIN PROCESSING
C OF NEW LOGICAL SECTION OF TEXT, AS FOR
C EXAMPLE WHEN BEGINNING PROCESSING OF LINE OF
C TEXT NOT TIED TO PREVIOUS LINE BY AMPERSAND
C AT END OF PREVIOUS LINE, OR WHEN PROCESSING
C TEXT TO RIGHT OF SEMICOLON. INITIAL ZEROING
C OF THIS ARGUMENT MUST BE DONE BY CALLING
C PROGRAM, BUT THEREAFTER VALUE RETURNED BY
C PREVIOUS CALL TO THIS ROUTINE CAN USUALLY BE
C USED. MANY IS RETURNED SET TO ZERO EACH
C TIME SEMICOLON (KIND=9) IS FOUND, AND EACH
C TIME END OF LINE NOT TIED TO FOLLOWING LINE
C BY AMPERSAND (KIND=1) IS FOUND. MANY IS
C RETURNED CONTAINING ONE PLUS ITS INPUT
C ABSOLUTE VALUE EACH TIME WORD IS FOUND, EACH
C TIME UNKNOWN CHARACTER IS FOUND, OR EACH
C TIME INDICATION OF MISSING WORD IS FOUND.
C KIND IS RETURNED CONTAINING VALUE 10 AND
C MANY IS RETURNED CONTAINING NEGATIVE OF
C NUMBER OF ITEMS FOUND IF NEXT PRINTING
C CHARACTER FOLLOWING COMMA IS AMPERSAND.
C MANY SHOULD NOT BE CHANGED BY CALLING
C PROGRAM IF AMPERSAND (KIND BEING
C RETURNED=10) IS FOUND INDICATING THAT
C SUBSEQUENT CALL TO THIS ROUTINE IS TO
C PROCESS TEXT WHICH IS TO BE TREATED AS
C THOUGH IT APPEARED IN PLACE OF AMPERSAND AND
C CHARACTERS TO ITS RIGHT. EFFECT IS NOT
C QUITE SAME AS IF USER HAD TYPED ALL OF TEXT
C ON SINGLE LINE SINCE SINGLE WORD CANNOT BE
C SPLIT ACROSS LINE BOUNDARY.
C
C IF MANY IS INPUT CONTAINING ZERO, THEN
C INITIAL COMMA IN INPUT TEXT BUFFER IS TAKEN
C TO INDICATE INITIAL MISSING ITEM, AND MANY
C IS THEN RETURNED CONTAINING 1. IF MANY IS
C INPUT GREATER THAN ZERO, THEN INITIAL COMMA
C IS IGNORED IF FOLLOWED BY WORD. IF MANY IS
C INPUT GREATER THAN ZERO, THEN INITIAL COMMA
C FOLLOWED BY NO OTHER PRINTING CHARACTERS, BY
C SEMICOLON, OR BY EXCLAMATION POINT INDICATES
C MISSING ITEM. IF MANY IS INPUT GREATER THAN
C ZERO, THEN INITIAL COMMA FOLLOWED BY
C AMPERSAND WILL CAUSE REMAINING CHARACTERS IN
C BUFFER TO BE IGNORED, AND MANY WILL BE
C RETURNED CONTAINING NEGATIVE OF ITS INPUT
C VALUE. IF MANY IS INPUT NEGATIVE, THEN IT
C IS ASSUMED THAT CONTENTS OF CURRENT BUFFER
C CONTINUE PREVIOUS LINE WHICH TERMINATED WITH
C COMMA FOLLOWED BY AMPERSAND, AND MANY IS
C RETURNED GREATER THAN ZERO.
C
C LCNERR = IF KIND IS RETURNED SET TO 6, 7 OR 8
C INDICATING THAT WORD OR ITS ABBREVIATION WAS
C FOLLOWED BY PRINTING CHARACTER OTHER THAN
C COMMA, SEMICOLON, EXCLAMATION POINT OR
C AMPERSAND, THEN LCNERR CONTAINS SUBSCRIPT IN
C IBUFFR ARRAY OF LOCATION WHICH CONTAINS NEXT
C SPACE, TAB CHARACTER, COMMA, SEMICOLON,
C EXCLAMATION POINT OR AMPERSAND OR IS SET TO
C MAXBFR+1 IF NO ALLOWED DELIMITER CHARACTER
C APPEARS TO RIGHT OF WORD OR ITS ABBREVIATION
C
DIMENSION IBUFFR(MAXBFR),IWORD(MAXWRD),
1KNTLTR(MAXKNT)
DATA KOMENT,IEND,IAND,KOMMA,ISPACE,ITAB/
11H!,1H;,1H&,1H,,1H ,1H /
INIMNY=MANY
IF(MANY.LT.0)MANY=-MANY
C
C TEST IF CHARACTER STARTS A WORD
1 CALL DAVERB(LOWWRD,MAXWRD,IWORD ,LOWKNT,MAXKNT,
1 KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND ,MATCH ,LCNWRD,
2 LCNKNT,LCNBFR)
LCNERR=LOWBFR
IF(KIND.GT.2)GO TO 3
IF(KIND.EQ.1)GO TO 8
LETTER=IBUFFR(LOWBFR)
IF(LETTER.EQ.KOMENT)GO TO 7
IF(LETTER.EQ.IEND)GO TO 5
IF(LETTER.EQ.KOMMA)GO TO 4
IF(LETTER.EQ.IAND)GO TO 6
C
C IF MATCH FOUND, CHECK IF FOLLOWING CHARACTER IS LEGAL
2 LCNERR=LCNERR+1
IF(KIND.LE.2)GO TO 3
IF(KIND.LE.5)KIND=KIND+3
3 IF(LCNERR.GT.MAXBFR)GO TO 11
LETTER=IBUFFR(LCNERR)
IF(LETTER.EQ.ISPACE)GO TO 11
IF(LETTER.EQ.ITAB)GO TO 11
IF(LETTER.EQ.KOMENT)GO TO 11
IF(LETTER.EQ.IEND)GO TO 11
IF(LETTER.EQ.KOMMA)GO TO 11
IF(LETTER.EQ.IAND)GO TO 11
GO TO 2
C
C TEST IF COMMA CAN PRECEDE A VALUE
4 IF(INIMNY.LE.0)GO TO 10
INIMNY=-INIMNY
LOWBFR=LOWBFR+1
GO TO 1
C
C SEMICOLON FOUND
5 IF(INIMNY.LT.0)GO TO 10
LOWBFR=LOWBFR+1
KIND=9
GO TO 9
C
C AMPERSAND FOUND
6 IF(INIMNY.LT.0)MANY=INIMNY
KIND=10
LOWBFR=MAXBFR+1
GO TO 12
C
C EXCLAMATION POINT FOUND
7 IF(INIMNY.LT.0)GO TO 10
LOWBFR=MAXBFR+1
KIND=1
GO TO 9
C
C END OF LINE FOUND
8 IF(INIMNY.LT.0)GO TO 10
C
C RETURN TO CALLING ROUTINE
9 MANY=0
GO TO 12
10 KIND=11
11 MANY=MANY+1
12 RETURN
C408421442172!;&
END
SUBROUTINE DAVERB(LOWWRD,MAXWRD,IWORD ,LOWKNT,MAXKNT,
1 KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND ,MATCH ,LCNWRD,
2 LCNKNT,LCNBFR)
C RENBR(/IDENTIFY WORDS OR ABBREVIATIONS)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DAVERB INTERPRETS AN ARRAY READ BY THE CALLING
C PROGRAM WITH A MULTIPLE OF AN A1 FORMAT AND
C IDENTIFIES THE WORDS AND WORD ABBREVIATIONS CONTAINED
C IN THIS ARRAY. THE WORDS ARE RECOGNIZED BY BEING
C MATCHED AGAINST A USER DEFINED DICTIONARY. IF THE
C ARRAY CONTAINS ABBREVIATIONS OF WORDS IN THE
C DICTIONARY, THEN DAVERB ALSO SPECIFIES WHETHER THESE
C ABBREVIATIONS ARE AMBIGUOUS.
C
C ARGUMENT LIST DEFINITIONS:
C
C LOWBFR IS USED FOR BOTH INPUT AND OUTPUT. KIND,
C MATCH, LCNWRD, LCNKNT AND LCNBFR ARE USED ONLY FOR
C OUTPUT. REMAINING ARGUMENTS ARE USED ONLY FOR INPUT.
C
C LOWWRD = SUBSCRIPT OF LOCATION IN IWORD ARRAY WHICH
C CONTAINS 1ST LETTER OF 1ST WORD. NOTE THAT
C IF KNTLTR(LOWKNT) IS NEGATIVE, THEN THE 1ST
C LETTER OF 1ST WORD WILL BE FOUND IN ARRAY
C LOCATION IWORD(LOWWRD-KNTLTR(LOWKNT)).
C MAXWRD = DIMENSION OF IWORD ARRAY.
C IWORD = DICTIONARY ARRAY CONTAINING CHARACTERS OF
C WORDS TO BE RECOGNIZED, 1 CHARACTER PER
C ARRAY LOCATION AS READ BY A1 FORMAT OR ELSE
C DEFINED BY 1H FIELD. SECTIONS OF A WORD CAN
C BE ABBREVIATED AND/OR SEPARATED BY SPACES OR
C TABS IF THE WORD IN IWORD CONTAINS A SINGLE
C SPACE BETWEEN EACH SUCH SECTION AND IF THE
C LENGTH STORED IN THE KNTLTR ARRAY IS 100
C MORE THAN THE ACTUAL LENGTH (INCLUDING THE
C SPACES). ALL LETTERS IN THE IWORD ARRAY
C MUST BE UPPER CASE.
C LOWKNT = SUBSCRIPT OF KNTLTR ARRAY LOCATION DEFINING
C LENGTH OF FIRST WORD WHICH CAN BE MATCHED IN
C THE IWORD ARRAY. THIS FIRST WORD WILL START
C AT IWORD(LOWWRD). IF NO WORDS ARE TO BE
C RECOGNIZED, THEN EITHER MAXKNT SHOULD BE
C LESS THAN LOWKNT, OR ELSE BOTH LOWKNT AND
C MAXKNT CAN POINT TO THE SAME ZERO ENTRY IN
C THE KNTLTR ARRAY.
C MAXKNT = SUBSCRIPT OF KNTLTR ARRAY LOCATION DEFINING
C LENGTH OF FINAL WORD WHICH CAN BE MATCHED IN
C THE IWORD ARRAY.
C KNTLTR = ARRAY CONTAINING THE NUMBERS OF CHARACTERS
C IN THE WORDS IN THE IWORD ARRAY. A ZERO OR
C NEGATIVE VALUE IN THE KNTLTR ARRAY OFFSETS
C THE NEXT POSSIBLE WORD WHICH CAN BE MATCHED
C IN THE IWORD ARRAY BY THE NUMBER OF LETTERS
C GIVEN BY THE ABSOLUTE VALUE OF THE NEGATIVE
C NUMBER IN THE KNTLTR ARRAY. DIMENSION OF
C KNTLTR MUST BE AT LEAST MAXKNT. FOR EXAMPLE
C TO RECOGNIZE THE WORDS
C
C YES, NO, MAYBE
C
C THE CONTENTS OF THE IWORD ARRAY WOULD BE
C
C 1HY,1HE,1HS,1HN,1HO,1HM,1HA,1HY,1HB,1HE
C
C AND CONTENTS OF THE KNTLTR ARRAY WOULD BE
C
C 3,2,5
C
C IF A WORD IN THE IWORD ARRAY CONTAINS
C EMBEDDED SPACES, THEN 100 MUST BE ADDED TO
C THE LENGTH STORED FOR THIS WORD IN THE
C KNTLTR ARRAY TO ALLOW THE PORTION OF THE
C WORD LEFT OF THE SPACE TO BE ABBREVIATED.
C VALUES 101 THROUGH 199 IN KNTLTR ARRAY THUS
C INDICATE WORDS CONTAINING SPACES WHICH HAVE
C LENGTHS OF 1 THROUGH 99 RESPECTIVELY. THE
C VALUE 100 IN THE KNTLTR ARRAY IS TREATED THE
C SAME AS A ZERO.
C IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS
C TYPED BY USER, READ BY A MULTIPLE OF AN A1
C FORMAT, WHICH IS TO BE SEARCHED FOR WORDS.
C IBUFFR THEN CONTAINS 1 LETTER PER COMPUTER
C STORAGE LOCATION. LETTERS IN THE IBUFFR
C ARRAY CAN BE EITHER UPPER OR LOWER CASE.
C MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR ARRAY TO BE
C SEARCHED
C LOWBFR = SUBSCRIPT WITHIN THE IBUFFR ARRAY OF THE
C FIRST (LEFTMOST) CHARACTER WHICH CAN BE
C SCANNED FOR WORDS. LOWBFR WILL BE RETURNED
C POINTING TO THE NEXT CHARACTER BEYOND A
C MATCHED WORD IF A WORD IS FOUND. IF THERE
C IS NOTHING AT OR TO RIGHT OF LOWBFR, THEN
C LOWBFR WILL BE LEFT POINTING AT MAXBFR+1 AND
C KIND WILL BE RETURNED CONTAINING ONE.
C LOWBFR MUST BE SET BY CALLING PROGRAM BEFORE
C ANYTHING IS PROCESSED IN CURRENT CONTENTS
C OF THE IBUFFR ARRAY, BUT THEN SHOULD NOT BE
C MODIFIED BY CALLING PROGRAM UNTIL THE ENTIRE
C CONTENTS OF IBUFFR ARRAY HAS BEEN PROCESSED.
C KIND = RETURNED DESCRIBING THE KIND OF ITEM LOCATED
C IN THE IBUFFR ARRAY.
C = 1, NOTHING WAS FOUND AT OR TO THE RIGHT OF
C LOWBFR. THE CALLING PROGRAM SHOULD READ A
C NEW LINE INTO IBUFFR.
C = 2, ACCEPTABLE WORD OR ABBREVIATION THEREOF
C WAS NOT FOUND, BUT A PRINTING CHARACTER WAS
C FOUND WHICH DOES NOT BEGIN ANY WORD IN THE
C DICTIONARY. LOWBFR IS RETURNED POINTING TO
C THIS PRINTING CHARACTER.
C = RETURNED CONTAINING 3, 4 OR 5 IF A WORD IN
C THE DICTIONARY WAS MATCHED EVEN PARTIALLY.
C FOR EXAMPLE, IF DICTIONARY CONTAINED BOTH OF
C THE WORDS NO AND NONE, THEN
C A) INITIAL LETTER N IN THE BUFFER FOLLOWED
C BY SOME CHARACTER OTHER THAN THE LETTER O
C WOULD BE AMBIGUOUS ABBREVIATION AND THE
C POINTER NAMED MATCH WOULD BE RETURNED
C POINTING TO (CONTAINING SEQUENCE NUMBER
C WITHIN DICTIONARY OF) WHICHEVER WORD NO
C OR NONE APPEARED FIRST IN THE DICTIONARY.
C B) INITIAL LETTERS N AND O FOLLOWED BY SOME
C CHARACTER OTHER THAN THE LETTER N WOULD
C BE AN EXACT MATCH WITH THE WORD NO.
C C) INITIAL LETTERS N AND O AND N WOULD BE A
C PARTIAL BUT NONAMBIGUOUS MATCH WITH THE
C WORD NONE.
C LEADING SPACES AND/OR TABS ARE IGNORED. A
C STRING OF CHARACTERS CONTAINING EMBEDDED
C SPACES AND/OR TABS CAN MATCH A WORD IN THE
C DICTIONARY ONLY IF THE WORD IN DICTIONARY
C CONTAINS A SINGLE SPACE AT THE POSITION AT
C WHICH THE SPACES AND/OR TABS ARE ALLOWED
C (BUT NOT NECESSARY).
C = 3, A WORD IN THE IWORD ARRAY WAS MATCHED
C EXACTLY. MATCH IS RETURNED CONTAINING THE
C SEQUENCE NUMBER OF THE WORD MATCHED IN THE
C IWORD ARRAY.
C = 4, A NONAMBIGUOUS ABBREVIATION OF A WORD IN
C THE IWORD ARRAY WAS FOUND. MATCH IS
C RETURNED CONTAINING THE SEQUENCE NUMBER OF
C THE WORD IN THE IWORD ARRAY.
C = 5, AN AMBIGUOUS ABBREVIATION OF A WORD WAS
C FOUND. MATCH IS RETURNED CONTAINING THE
C SEQUENCE NUMBER OF THE FIRST WORD MATCHED IN
C THE IWORD ARRAY.
C MATCH = RETURNED CONTAINING THE SEQUENCE NUMBER OF A
C WORD MATCHED IN THE IWORD ARRAY IF KIND IS
C RETURNED CONTAINING 3, 4 OR 5. FOR EXAMPLE,
C IF THE SECOND WORD IS MATCHED, THEN MATCH
C WOULD BE RETURNED CONTAINING 2. THE
C SEQUENCE NUMBER OF THE WORD IN THE IWORD
C ARRAY DOES NOT INCLUDE THE LETTERS SKIPPED
C OVER BY THE VALUE OF LOWWRD, AND DOES NOT
C INCLUDE THE LETTERS SKIPPED OVER BY NEGATIVE
C VALUES ENCOUNTERED IN THE KNTLTR ARRAY.
C MATCH IS RETURNED CONTAINING KIND-2 IF KIND
C IS RETURNED .LE.2 INDICATING THAT NO WORD IN
C THE IWORD ARRAY COULD BE MATCHED EVEN
C PARTIALLY. THIS MEANS THAT IF THE CALLING
C PROGRAM TESTS FOR KIND=5 AFTER THE RETURN
C FROM DAVERB, AND IF KIND=4 IS TO BE TAKEN AS
C EQUIVALENT TO KIND=3, THEN CALLING PROGRAM
C CAN ADD 2 TO THE VALUE OF MATCH AND USE THIS
C SUM AS INDEX FOR A COMPUTED GO TO STATEMENT.
C LCNWRD = IF KIND IS RETURNED CONTAINING 3 OR GREATER,
C LOCWRD IS RETURNED WITH SUBSCRIPT OF IWORD
C LOCATION CONTAINING FIRST LETTER OF MATCHED
C WORD.
C LCNKNT = IF KIND IS RETURNED CONTAINING 3 OR GREATER,
C LCNKNT IS RETURNED WITH SUBSCRIPT OF KNTWRD
C LOCATION CONTAINING THE WORD LENGTH.
C LCNBFR = IF KIND IS RETURNED CONTAINING 3 OR GREATER,
C INDICATING THAT A WORD OR ITS ABBREVIATION
C WAS FOUND, THEN LCNBFR IS RETURNED
C CONTAINING THE SUBSCRIPT OF THE IBUFFR ARRAY
C LOCATION WHICH CONTAINS THE FIRST CHARACTER
C OF THE WORD OR ITS ABBREVIATION.
C
DIMENSION IBUFFR(MAXBFR),IWORD(MAXWRD),
1KNTLTR(MAXKNT),KONVRT(10),KAPITL(26),LOWER(26)
C
C CCCC AAA UU UU TTTTTTTT IIII OOOO NN NN
C CC AAAA UU UU TT II OO OO NNN NN
C CC AA AA UU UU TT II OO OO NNNN NN
C CC AA AA UU UU TT II OO OO NN NN NN
C CC AAAAAAA UU UU TT II OO OO NN NNNN
C CC AA AA UU UU TT II OO OO NN NNN
C CCCC AA AA UUU TT IIII OOOO NN NN
C
C TO CONVERT LOWER CASE LETTERS IN THE INPUT TEXT
C BUFFER INTO UPPER CASE LETTERS WHICH CAN BE MATCHED
C AGAINST THE DICTIONARY, THIS ROUTINE COMPARES THE
C CHARACTERS IN THE INPUT TEXT BUFFER AGAINST THE LOWER
C CASE LETTERS IN THE LOWER ARRAY. THE LETTERS IN THE
C LOWER ARRAY MUST BE ARRANGED IN INCREASING NUMERICAL
C ORDER. IF THE NUMERICAL ORDER IS NOT THE SAME AS THE
C ALPHABETICAL ORDER, THEN THE DATA STATEMENTS
C APPEARING BELOW MUST BE CHANGED OR ELSE SOME OR ALL
C LOWER CASE LETTERS IN THE INPUT TEXT BUFFER WILL NOT
C BE TREATED AS EQUIVALENT TO THE CORRESPONDING UPPER
C CASE LETTERS. ONCE THE LETTERS IN THE LOWER ARRAY
C ARE SORTED INTO INCREASING NUMERICAL ORDER, THE UPPER
C CASE LETTERS IN THE KAPITL ARRAY SHOULD BE REARRANGED
C SO THAT LOWER AND UPPER CASE VERSIONS OF EACH LETTER
C APPEAR IN LOCATIONS IN THE LOWER AND KAPITL ARRAYS
C HAVING THE SAME SUBSCRIPTS.
C
C IF THE COMPUTER UPON WHICH THIS ROUTINE IS USED DOES
C NOT SUPPORT LOWER CASE LETTERS, THEN BOTH THE LOWER
C AND KAPITL ARRAYS CAN CONTAIN THE LETTERS 1HA THROUGH
C 1HZ IN ALPHABETICAL ORDER (EVEN IF THIS IS NOT THE
C NUMERICALLY SORTED ORDER).
C
C KAPITL = UPPER CASE LETTERS A THROUGH Z SORTED ON
C LOWER ARRAY
DATA KAPITL/
11HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
21HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
31HU,1HV,1HW,1HX,1HY,1HZ/
C
C LOWER = LOWER CASE LETTERS A THROUGH Z SORTED INTO
C NUMERICALLY INCREASING ORDER
DATA LOWER/
11Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
21Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,
31Hu,1Hv,1Hw,1Hx,1Hy,1Hz/
C
C IBLANK = THE BLANK OR SPACE CHARACTER
C ITAB = TABULATION CHARACTER, THIS CAN BE REPLACED
C BY SPACE IF TAB CHARACTER IS NOT AVAILABLE
DATA IBLANK,ITAB/1H ,1H /
C
C SEARCH FOR FIRST PRINTING CHARACTER
GO TO 2
1 LOWBFR=LOWBFR+1
2 IF(LOWBFR.GT.MAXBFR)GO TO 29
NOWLTR=IBUFFR(LOWBFR)
IF(NOWLTR.EQ.IBLANK)GO TO 1
IF(NOWLTR.EQ.ITAB)GO TO 1
C
C SET INITIAL CONSTANTS IF FIND PRINTING CHARACTER
LMTBFR=MAXBFR
LCNBFR=LOWBFR
IEND=LOWWRD
MSTSAM=1
KNTKNV=0
KNTWRD=LOWKNT-1
INDEX=0
3 IEXACT=1
4 KNTWRD=KNTWRD+1
IF(KNTWRD.GT.MAXKNT)GO TO 28
C
C GET NEXT WORD IN DICTIONARY
JEND=KNTLTR(KNTWRD)
KEND=JEND-100
IF(KEND.GE.0)JEND=KEND
IF(JEND.LE.0)GO TO 27
KEND=0
NXTCMP=IEND
IEND=IEND+JEND
JEXACT=-1
INDEX=INDEX+1
NXTBFR=LOWBFR
NOWSAM=1
C
C GET NEXT CHARACTERS TO BE COMPARED
5 IF(NXTBFR.GT.LMTBFR)GO TO 22
KOMPAR=IBUFFR(NXTBFR)
IF(KOMPAR.EQ.IBLANK)GO TO 15
IF(KOMPAR.EQ.ITAB)GO TO 15
IF(NOWSAM.LE.KNTKNV)GO TO 13
C
C DETERMINE UPPER CASE VERSION OF A LOWER CASE LETTER.
C THIS IS A TERNARY SEARCH TAKING ADVANTAGE OF THE SIZE
C OF ALPHABET BEING NEARLY 3**3. THE 3RD OF THE ARRAY
C CONTAINING THE DESIRED LETTER IS FIRST LOCATED, THEN
C THE 3RD OF THIS 3RD, AND FINALLY EACH OF THE
C REMAINING 3 LETTERS ARE TESTED INDIVIDUALLY. TO
C PREVENT TESTING AGAINST THE 27TH LETTER WHICH DOES
C NOT EXIST, UPPER 3RD IS TAKEN AS UPPER 9 SORTED
C LETTERS, RATHER THAN FROM 19TH THROUGH 27TH LETTERS,
C SO THAT LOWER(18) IS TESTED AGAINST IN UPPER 3RD EVEN
C THOUGH LETTER BEING MATCHED HAS ALREADY BEEN FOUND TO
C BE LARGER THAN THIS.
IF(KOMPAR.GT.LOWER(18))GO TO 7
IF(KOMPAR.GT.LOWER(9))GO TO 6
IF(KOMPAR.LT.LOWER(1))GO TO 11
KUT=3
GO TO 8
6 KUT=12
GO TO 8
7 IF(KOMPAR.GT.LOWER(26))GO TO 11
KUT=20
8 IF(KOMPAR.LE.LOWER(KUT))GO TO 9
KUT=KUT+3
IF(KOMPAR.GT.LOWER(KUT))KUT=KUT+3
9 IF(KOMPAR.EQ.LOWER(KUT))GO TO 10
KUT=KUT-1
IF(KOMPAR.EQ.LOWER(KUT))GO TO 10
KUT=KUT-1
IF(KOMPAR.NE.LOWER(KUT))GO TO 11
10 KOMPAR=KAPITL(KUT)
11 IF(KNTKNV.GE.10)GO TO 12
KNTKNV=KNTKNV+1
KONVRT(KNTKNV)=KOMPAR
C
C DETERMINE IF LETTER IN BUFFER MATCHES DICTIONARY.
12 IF(KOMPAR.EQ.IWORD(NXTCMP))GO TO 19
GO TO 14
13 IF(KONVRT(NOWSAM).EQ.IWORD(NXTCMP))GO TO 19
14 IF(KEND.LE.0)GO TO 23
GO TO 17
15 IF(KEND.LE.0)GO TO 23
16 NXTBFR=NXTBFR+1
IF(NXTBFR.GT.LMTBFR)GO TO 22
IF(IBUFFR(NXTBFR).EQ.IBLANK)GO TO 16
IF(IBUFFR(NXTBFR).EQ.ITAB)GO TO 16
17 KEND=0
18 IF(IWORD(NXTCMP).EQ.IBLANK)GO TO 20
JEXACT=0
NXTCMP=NXTCMP+1
IF(NXTCMP.LT.IEND)GO TO 18
GO TO 24
19 NOWSAM=NOWSAM+1
NEWBFR=NXTBFR
KEND=JEND
NXTBFR=NXTBFR+1
20 NXTCMP=NXTCMP+1
21 IF(NXTCMP.LT.IEND)GO TO 5
GO TO 24
C
C WORD CANNOT EXTEND FURTHER TO RIGHT
22 LMTBFR=NEWBFR
23 JEXACT=0
24 IF(NOWSAM.LT.MSTSAM)GO TO 4
IF(NOWSAM.GT.MSTSAM)GO TO 26
IF(IEXACT.GE.0)GO TO 25
IF(JEXACT.LT.0)GO TO 3
GO TO 4
25 IF(JEXACT.GE.0)GO TO 3
26 IEXACT=JEXACT
MSTSAM=NOWSAM
MATCH=INDEX
LSTBFR=NEWBFR+1
LCNKNT=KNTWRD
LCNWRD=IEND
GO TO 4
27 IEND=IEND-JEND
GO TO 4
C
C ENTIRE DICTIONARY HAS BEEN SEARCHED
28 IF(MSTSAM.LE.1)GO TO 30
LOWBFR=LSTBFR
KIND=4+IEXACT
JEND=KNTLTR(LCNKNT)
IF(JEND.GE.100)JEND=JEND-100
LCNWRD=LCNWRD-JEND
GO TO 31
C
C NO PRINTING CHARACTERS WERE FOUND TO BE IDENTIFIED
29 KIND=1
MATCH=-1
GO TO 31
C
C NOT EVEN A PARTIAL MATCH COULD BE MADE
30 KIND=2
MATCH=0
C
C RETURN TO CALLING PROGRAM
31 RETURN
C
C IEXACT = -1, EXACT MATCH FOUND BUT MUST CHECK THAT
C A LONGER MATCH CANNOT BE FOUND WITH ANOTHER
C WORD (FOR EXAMPLE, IF IWORD ARRAY CONTAINS
C BOTH OF THE WORDS NO AND NONE, THEN THE
C BUFFER CONTENTS "NON" WOULD MATCH WORD NO
C EXACTLY, BUT THE PARTIAL MATCH WITH WORD
C NONE WOULD BE BETTER)
C = 0, A PARTIAL MATCH HAS BEEN FOUND
C = 1, NO MATCH FOUND OR DUPLICATE PARTIAL
C MSTSAM = 1 + MAXIMUM NUMBER OF LETTERS MATCHED
C NOWSAM = 1 + NUMBER OF LETTERS MATCHING CURRENT WORD
C834811258610
END
SUBROUTINE DAIHFT(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
1 LOWBFR,KIND ,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE)
C RENBR(/FREE FORMAT INTEGER INPUT ROUTINE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DAIHFT INTERPRETS AN ARRAY READ BY THE CALLING
C PROGRAM WITH A MULTIPLE OF AN A1 FORMAT AND RETURNS
C THE VALUES IN THIS ARRAY.
C
C NUMBERS INTERPRETTED BY DAIHFT CAN CONTAIN LEADING
C SIGN, EMBEDDED DECIMAL POINT AND/OR TRAILING E WITH
C SIGNED EXPONENT. A PERCENT SIGN FOLLOWING THE NUMBER
C IMPLIES E-2, TRAILING LETTER K IMPLIES E3 AND
C TRAILING LETTER M IMPLIES E6.
C
C ARGUMENT LIST DEFINITIONS:
C
C KONTRL = 0 OR GREATER, NUMBER IS EVALUATED AS DECIMAL
C INTEGER. NUMBER CAN CONTAIN A DECIMAL POINT
C (FOR EXAMPLE 1.23K OR 1.23E3 EQUALS 1230),
C BUT IS STORED AS AN INTEGER IN DAIHFT, AND
C IS OUTPUT AS ARGUMENT IVALUE. ANY DECIMAL
C INTEGER WHICH THE COMPUTER CAN REPRESENT CAN
C BE EVALUATED. THIS INCLUDES, ON TWOS
C COMPLEMENT COMPUTERS, THE LARGEST NEGATIVE
C NUMBER THE ABSOLUTE VALUE OF WHICH CANNOT BE
C STORED. ON THE PDP10, A 36 BIT COMPUTER
C WITH TWOS COMPLEMENT NOTATION, THE RANGE OF
C DECIMAL INTEGERS IS -34359738368 THROUGH
C 34359738367 (OCTAL NOTATION OF BIT PATTERNS
C BEING 400000000000 THROUGH 377777777777).
C = -1, ITEM IN IBUFFR ARRAY IS OCTAL. THE
C NUMBER CAN BE TYPED WITH A DECIMAL POINT
C AND/OR WITH AN EXPONENT. HOWEVER, THE
C NUMBER FOLLOWING THE LETTER E OF THE
C EXPONENT IS EVALUATED IN DECIMAL. THE VALUE
C OF THE OCTAL NUMBER IS RETURNED AS THE
C ARGUMENT IVALUE. IT MUST BE NOTED THAT
C NUMBERS EVALUATED AS NEGATIVE OCTAL INTEGERS
C HAVE THE NEGATIVE OCTAL INTEGER AS THEIR
C VALUE, NOT AS THEIR BIT REPRESENTATION IN
C COMPUTER STORAGE. FOR EXAMPLE, ON A 36 BIT
C TWOS COMPLEMENT COMPUTER, THE OCTAL NUMBER
C -400000000000 (WHICH COULD ALSO BE TYPED AS
C -4E11 OR -4E+11 WHERE THE 11 AFTER THE E IS
C IN DECIMAL) IS REPRESENTED AS BIT PATTERN
C HAVING OCTAL NOTATION 400000000000 AND THE
C OCTAL NUMBER -377777777777 IS REPRESENTED BY
C THE BIT PATTERN 400000000001.
C = -2, DO NOT EVALUATE NUMBERS. INSTEAD THE
C CHARACTERS FORMING NUMBER ARE TREATED LIKE
C ANY OTHER PRINTING CHARACTERS.
C ITRAIL = SPECIFIES WHETHER EXPONENTS ARE TO BE
C RECOGNIZED.
C = -1, ALLOW NUMBERS TO BE FOLLOWED BY E
C EXPONENT, BUT DO NOT RECOGNIZE PERCENT SIGN,
C K OR M AT END OF NUMBER. E IS NOT
C RECOGNIZED IF NOT PRECEDED BY SIGN, DECIMAL
C POINT OR DIGIT.
C = 0, DO NOT ALLOW TRAILING PERCENT SIGN, K M
C OR E EXPONENT.
C = 1, ALLOW NUMBERS TO BE FOLLOWED BY PERCENT
C SIGN, K M OR E EXPONENT. PERCENT SIGN, K M
C OR E IS NOT RECOGNIZED IF NOT PRECEDED BY
C SIGN, DECIMAL POINT OR DIGIT.
C
C FOLLOWING VALUES DO NOT REQUIRE THAT EXPONENT
C BE PRECEDED BY NUMBER. ALTHOUGH RETURNED
C VALUE WILL ALWAYS BE ZERO IF NO VALUE DIGITS
C ARE FOUND, CALLING PROGRAM COULD ADJUST THIS
C RETURNED VALUE.
C
C = -3, LEADING E EXPONENT IS RECOGNIZED.
C LEADING DIGITS, SIGNS AND DECIMAL POINTS ARE
C NOT ALLOWED.
C = -2, SAME AS ITRAIL=-1, EXCEPT THAT IN
C ADDITION E EXPONENT IS RECOGNIZED EVEN IF
C NOT PRECEDED BY DIGITS, SIGN OR DECIMAL
C POINT.
C = 2, SAME AS ITRAIL=1, EXCEPT THAT IN ADDITION
C LEADING PERCENT SIGN, OR LETTERS K M OR E
C EXPONENT ARE RECOGNIZED EVEN IF NOT PRECEDED
C BY DIGITS, SIGN OR DECIMAL POINT.
C = 3, ONLY LEADING PERCENT SIGN OR LETTERS K M
C OR E EXPONENT ARE RECOGNIZED. LEADING
C DIGITS, SIGNS OR DECIMAL POINTS ARE NOT
C ALLOWED.
C
C IF 10 IS SUBTRACTED FROM ITRAIL VALUES -3
C THROUGH 3, AND IF EITHER VALUE DIGITS OR
C DIGITS FOLLOWING LETTER E ARE MISSING, THEN
C ONE, RATHER THAN ZERO, IS ASSUMED TO BE THE
C DEFAULT FOR THE VALUE OR THE EXPONENT
C RESPECTIVELY. -E- WOULD BE EQUIVALENT TO
C -1E-1 AND -E OR -E+ WOULD BE EQUIVALENT TO
C -1E1
C
C IF 10 IS ADDED TO ITRAIL VALUES -3 THROUGH 3,
C THEN VALUE IS RETURNED AS THOUGH NEITHER
C EXPONENT NOR DECIMAL POINT HAD BEEN TYPED.
C VALUE INDICATED BY COMBINATION OF DIGITS,
C DECIMAL POINT AND/OR EXPONENT CAN BE OBTAINED
C AS VALUE*10**KSHIFT OR IVALUE*10**KSHIFT.
C VALUE INDICATED BY COMBINATION OF DIGITS AND
C DECIMAL POINT BUT IGNORING EXPONENT CAN BE
C OBTAINED AS VALUE*10**(KSHIFT-JSHIFT) OR
C IVALUE*10**(KSHIFT-JSHIFT).
C IEXTRA = EXTRA SHIFT TO BE APPLIED TO VALUE. SHIFT
C IS STATED AS POWER OF RADIX. THIS IS
C APPLIED IN ADDITION TO SHIFT REPORTED IN
C ISHIFT, JSHIFT AND KSHIFT AS SPECIFIED BY
C USER. FOR EXAMPLE, IF DOLLAR VALUE IS TO BE
C RETURNED AS INTEGER NUMBER OF CENTS, IEXTRA
C WOULD HAVE VALUE 2.
C IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS
C TYPED BY USER, READ BY A MULTIPLE OF AN A1
C FORMAT, WHICH IS TO BE SEARCHED FOR WORDS
C AND NUMBERS. IBUFFR THEN CONTAINS 1 LETTER
C PER COMPUTER STORAGE LOCATION.
C MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR ARRAY TO BE
C SEARCHED
C LOWBFR = SUBSCRIPT WITHIN THE IBUFFR ARRAY OF THE
C FIRST (LEFTMOST) CHARACTER WHICH CAN BE
C SCANNED FOR NUMBERS. LOWBFR WILL BE RETURNED
C POINTING TO FIRST PRINTING CHARACTER WHICH
C CANNOT APPEAR IN A NUMBER, OR BEYOND THE END
C OF THE BUFFER IF THE BUFFER DOES NOT CONTAIN
C ANY PRINTING CHARACTERS.
C KIND = RETURNED DESCRIBING THE KIND OF ITEM LOCATED
C IN THE IBUFFR ARRAY.
C = 1, NOTHING WAS FOUND AT OR TO THE RIGHT OF
C LOWBFR. THE CALLING PROGRAM SHOULD READ A
C NEW LINE INTO IBUFFR.
C = 2, NUMBER WAS NOT FOUND, BUT A PRINTING
C CHARACTER WHICH CANNOT START A NUMBER WAS
C FOUND. LOWBFR IS RETURNED POINTING TO THIS
C PRINTING CHARACTER.
C = 3, A NUMBER WAS FOUND. LOWBFR IS RETURNED
C POINTING TO CHARACTER TO RIGHT OF NUMBER.
C ISHIFT = 0, RETURNED IF NONE OF CHARACTERS E, %, K OR
C M FOLLOW NUMBER
C = 1, PERCENT SIGN FOLLOWS NUMBER
C = 2, K FOLLOWS NUMBER
C = 3, M FOLLOWS NUMBER
C = LESS THAN ZERO, RETURNED IF E FOLLOWS
C NUMBER.
C = -1, E AND POSSIBLY SIGNED NUMBER FOLLOW
C NUMBER.
C = -2, E IS FOLLOWED BY PLUS SIGN NOT IN TURN
C FOLLOWED BY DIGITS.
C = -3, E IS FOLLOWED BY MINUS SIGN NOT IN TURN
C FOLLOWED BY DIGITS.
C = -4, E IS FOLLOWED BY NEITHER SIGN NOR DIGITS
C JSHIFT = EXPONENT INDICATED BY FOLLOWING PERCENT
C SIGN, K, M OR E FOLLOWED BY DIGITS. THIS
C WILL HAVE BEEN APPLIED TO RETURNED VALUE IF
C ITRAIL EQUALS EITHER -1 OR 1. 12.34K OR
C 12.34E3 WOULD GIVE JSHIFT OF 3. 12% OR
C 12E-2 WOULD GIVE JSHIFT -2.
C KSHIFT = EXPONENT WHICH WOULD BE NECESSARY TO OBTAIN
C DESIRED VALUE IF NUMBER HAD BEEN TYPED
C WITHOUT DECIMAL POINT. 12.34 STATED WITHOUT
C DECIMAL POINT WOULD BE 1234E-2 SO KSHIFT
C WOULD BE -2. 12.34K WOULD BE 1234E1 SO
C KSHIFT WOULD BE 1.
C LSHIFT = ZERO OR LESS, THE VALUE ZERO IS BEING
C RETURNED FOR EITHER VALUE OR IVALUE,
C WHICHEVER IS APPROPRIATE.
C = -4, NUMBER CONTAINED NEITHER VALUE DIGITS,
C NOR DECIMAL POINT, NOR LEADING PLUS SIGN,
C NOR LEADING MINUS SIGN. THIS VALUE OF
C LSHIFT IS ALWAYS RETURNED IF KIND IS
C RETURNED CONTAINING A VALUE OTHER THAN 3.
C IF KIND IS RETURNED CONTAINING THE VALUE 3,
C THEN ITRAIL MUST BE EITHER -3 OR 3, AND THE
C CONTENTS OF THE INPUT TEXT BUFFER MUST BEGIN
C WITH A REPRESENTATION OF AN EXPONENT.
C = -3, A LEADING MINUS SIGN BUT NO VALUE DIGITS
C WAS FOUND.
C = -2, A LEADING PLUS SIGN BUT NO VALUE DIGITS
C WAS FOUND.
C = -1, A LEADING PERIOD BUT NO VALUE DIGITS WAS
C FOUND.
C = 0, ONE OR MORE ZERO DIGITS WERE FOUND, BUT
C THE NUMBER CONTAINED NO DIGITS OTHER THAN
C ZERO. THE NUMBER REPRESENTATION MAY OR MAY
C NOT HAVE BEEN BEGUN BY A PLUS SIGN OR A
C MINUS SIGN AND MAY OR MAY NOT HAVE CONTAINED
C A DECIMAL POINT.
C = GREATER THAN ZERO, LSHIFT IS NUMBER OF
C DIGITS COUNTING LEFTMOST NON-ZERO DIGIT AND
C ALL WHICH WERE SPECIFIED TO ITS RIGHT. THIS
C IS INDEPENDENT OF ANY SHIFT IMPLIED BY A
C DECIMAL POINT OR EXPONENT
C IVALUE = RETURNED WITH VALUE IF NUMBER IS FOUND. THE
C ORIGINAL CONTENT OF IVALUE IS DESTROYED. IN
C PARTICULAR, IF KIND IS RETURNED CONTAINING
C EITHER 1 OR 2, THEN IVALUE WILL BE ZEROED.
C
DIMENSION IBUFFR(MAXBFR),IDIGIT(10),KAPLTR(3),
1LOWLTR(3),JPOWER(3)
C
C IDIGIT CONTAINS ALPHAMERIC FORM OF DIGITS 0 THRU 9
DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C IBLANK CONTAINS SPACE CHARACTER AND ITAB CONTAINS
C TAB CHARACTER. IF TAB CHARACTER IS NOT AVAILABLE,
C ITAB SHOULD INSTEAD CONTAIN A SPACE ALSO.
DATA IPLUS,IMINUS,IDOT,IBLANK,ITAB/
11H+,1H-,1H.,1H ,1H /
C
C KAPLTR = LIST OF UPPER CASE LETTERS WHICH CAN FOLLOW
C A NUMBER TO INDICATE AN EXPONENT.
C LOWLTR = LIST OF LOWER CASE LETTERS CORRESPONDING TO
C UPPER CASE LETTERS IN KAPLTR ARRAY.
C JPOWER = VALUE OF THE EXPONENT ASSOCIATED WITH THE
C PARALLEL CHARACTERS IN THE KAPLTR AND LOWLTR
C ARRAYS. JPOWER CAN BE NEGATIVE, FOR EXAMPLE
C PERCENT SIGN WOULD CORRESPOND TO JPOWER=-2.
C MAXTST = NUMBER OF ITEMS IN EACH OF KAPLTR, LOWLTR
C AND JPOWER ARRAYS.
C KAPEXP = UPPER CASE LETTER E
C LOWEXP = LOWER CASE LETTER E
C
C UPPER CASE LETTERS CAN BE SUBSTITUTED FOR LOWER CASE
C IN FOLLOWING DATA STATEMENTS, IF COMPUTER UPON WHICH
C THIS ROUTINE IS USED DOES NOT SUPPORT LOWER CASE.
C
DATA KAPLTR/1H%,1HK,1HM/
DATA LOWLTR/1H%,1Hk,1Hm/
DATA JPOWER/-2,3,6/
DATA MAXTST/3/
DATA KAPEXP,LOWEXP/1HE,1He/
C
C INITIALIZE
ISIGN=0
IVALUE=0
ISHIFT=0
JSHIFT=0
KSHIFT=0
LSHIFT=-4
IRADIX=10
IF(KONTRL.LT.0)IRADIX=8
IADD=IRADIX-2
IPOWER=0
NUMKNT=-4
NMBEXP=-1
NUMPNT=-1
IDEFLT=0
IF(ITRAIL.LT.-5)IDEFLT=1
KTRAIL=ITRAIL
IF(KTRAIL.GT.5)KTRAIL=KTRAIL-10
IF(KTRAIL.LT.-5)KTRAIL=KTRAIL+10
LTRAIL=KTRAIL
IF(LTRAIL.LT.0)LTRAIL=-LTRAIL
GO TO 2
C
C *********************
C * SCAN FOR NUMBER *
C *********************
C
C LOOP LOOKING AT CHARACTERS IN IBUFFR ARRAY
1 LOWBFR=LOWBFR+1
2 IF(LOWBFR.GT.MAXBFR)GO TO 23
NOWLTR=IBUFFR(LOWBFR)
IF(NMBEXP.GE.0)GO TO 18
IF(ISIGN.NE.0)GO TO 4
C
C SCAN OVER LEADING SPACES AND/OR TABS
IF(NOWLTR.EQ.IBLANK)GO TO 1
IF(NOWLTR.EQ.ITAB)GO TO 1
C
C LOOK FOR INITIAL SIGNS + OR -
IF(KONTRL.LE.-2)GO TO 34
IF(LTRAIL.GE.3)GO TO 4
IF(NOWLTR.EQ.IPLUS)GO TO 3
IF(NOWLTR.NE.IMINUS)GO TO 4
ISIGN=-1
NUMKNT=-3
GO TO 1
3 ISIGN=1
NUMKNT=-2
GO TO 1
C
C LOOK FOR % K OR M FOLLOWING NUMBER
C LOCK OUT THESE AND ALSO E IF NO PART OF NUMBER FOUND
4 IF(LTRAIL.GE.2)GO TO 5
IF(ISIGN.EQ.0)GO TO 10
IF(KTRAIL.EQ.0)GO TO 10
5 IF(KTRAIL.LT.0)GO TO 8
I=0
6 I=I+1
IF(I.GT.MAXTST)GO TO 8
IF(NOWLTR.EQ.KAPLTR(I))GO TO 7
IF(NOWLTR.NE.LOWLTR(I))GO TO 6
7 IPOWER=JPOWER(I)
JSIGN=1
NMBEXP=1
ISHIFT=I
LOWBFR=LOWBFR+1
GO TO 24
C
C LOOK FOR LETTER E
8 IF(NOWLTR.EQ.KAPEXP)GO TO 9
IF(NOWLTR.NE.LOWEXP)GO TO 10
9 JSIGN=0
NMBEXP=0
ISHIFT=-4
GO TO 17
C
C LOOK FOR LEADING OR EMBEDDED PERIOD
10 IF(LTRAIL.GE.3)GO TO 22
IF(NUMPNT.GE.0)GO TO 11
IF(NOWLTR.NE.IDOT)GO TO 11
IF(ISIGN.EQ.0)NUMKNT=-1
GO TO 16
C
C LOOK FOR DIGIT OTHER THAN IN EXPONENT FIELD
11 DO 14 I=1,IRADIX
IF(NOWLTR.NE.IDIGIT(I))GO TO 14
IF(NUMKNT.GT.0)GO TO 12
NUMKNT=0
IF(I.EQ.1)GO TO 13
12 NUMKNT=NUMKNT+1
C FOLLOWING ALLOWS LARGEST NEGATIVE NUMBER FOR
C WHICH THERE IS NOT CORRESPONDING POSITIVE VALUE
13 IF(NUMKNT.EQ.1)IVALUE=I-2
IF(NUMKNT.GT.1)IVALUE=(IRADIX*IVALUE)+I+IADD
GO TO 15
14 CONTINUE
GO TO 22
C
C DIGIT, E OR . FOUND SO MARK AS BEING IN NUMBER
15 IF(NUMPNT.LT.0)GO TO 17
16 NUMPNT=NUMPNT+1
17 IF(ISIGN.EQ.0)ISIGN=1
GO TO 1
C
C LOOK FOR SIGN IN EXPONENT FIELD
18 IF(JSIGN.NE.0)GO TO 20
IF(NOWLTR.EQ.IPLUS)GO TO 19
IF(NOWLTR.NE.IMINUS)GO TO 20
JSIGN=-1
ISHIFT=-3
GO TO 1
19 JSIGN=1
ISHIFT=-2
GO TO 1
C
C LOOK FOR DIGITS IN EXPONENT FIELD
20 DO 21 I=1,10
IF(NOWLTR.NE.IDIGIT(I))GO TO 21
IPOWER=(10*IPOWER)+I-1
NMBEXP=1
ISHIFT=-1
IF(JSIGN.EQ.0)JSIGN=1
GO TO 1
21 CONTINUE
GO TO 24
C
C DECIDE WHAT TO DO IF NO MATCH FOUND
22 IF(ISIGN.NE.0)GO TO 24
GO TO 34
C
C *******************************
C * NUMBER HAS BEEN EVALUATED *
C *******************************
C
23 IF(ISIGN.EQ.0)GO TO 33
24 KIND=3
C
C ADJUST EXPONENT SIGN
IF(NMBEXP.LT.0)GO TO 25
IF(NMBEXP.EQ.0)IPOWER=IDEFLT
IF(JSIGN.LT.0)IPOWER=-IPOWER
C
C SHIFT AN INTEGER ACCORDING TO EXPONENT
25 JSHIFT=IPOWER
KSHIFT=IPOWER
IF(NUMPNT.GT.0)KSHIFT=KSHIFT-NUMPNT
LSHIFT=NUMKNT
IF(NUMPNT.GT.0)IPOWER=IPOWER-NUMPNT
IF(ITRAIL.GT.5)IPOWER=0
IPOWER=IPOWER+IEXTRA
IF(NUMKNT.LT.0)IVALUE=IDEFLT
IF(ISIGN.GE.0)GO TO 26
IVALUE=-IVALUE
C NOTE THAT NEGATIVE NUMBER AT THIS POINT HAS ABSOLUTE
C VALUE 1 TOO LOW TO ALLOW THE LARGEST NEGATIVE NUMBER
C WHICH HAS NO CORRESPONDING POSITIVE VALUE IN TWOS
C COMPLEMENT NOTATION
IF(NUMKNT.GT.0)IVALUE=IVALUE-1
GO TO 27
26 IF(NUMKNT.GT.0)IVALUE=IVALUE+1
27 IF(IPOWER.LE.0)GO TO 31
IPOWER=IPOWER-1
KVALUE=IVALUE
IVALUE=IRADIX*IVALUE
IF(ISIGN.GE.0)GO TO 28
IF(IVALUE.GE.KVALUE)GO TO 30
GO TO 29
28 IF(IVALUE.LE.KVALUE)GO TO 30
29 IF((IVALUE/IRADIX).EQ.KVALUE)GO TO 27
30 IVALUE=KVALUE
31 IF(IPOWER.GE.0)GO TO 35
IPOWER=IPOWER+1
KVALUE=IVALUE
IVALUE=IVALUE/IRADIX
IF(ISIGN.GE.0)GO TO 32
IF((IRADIX*IVALUE).LT.KVALUE)IVALUE=IVALUE+1
32 IF(IVALUE.NE.0)GO TO 31
GO TO 35
C
C IF DELIMITER AT END OF LINE, MARK VALUE AS MISSING
33 KIND=1
GO TO 35
34 KIND=2
C
C RETURN TO CALLING PROGRAM
35 RETURN
C
C IBLANK = THE BLANK OR SPACE CHARACTER
C JSIGN = 0, NEITHER SIGN NOR DIGITS AFTER E
C = 1, EITHER PLUS OR DIGITS AFTER E
C = -1, MINUS SIGN AFTER E
C ITAB = THE TAB CHARACTER
C ISIGN = 0, NO PART OF NUMBER ENCOUNTERED
C = -1, MINUS SIGN AT START OF NUMBER
C = 1, NUMBER DOES NOT START WITH MINUS SIGN
C NMBEXP = -1, NO EXPONENT FIELD YET FOUND
C = 0, EXPONENT FIELD FOUND BUT NUMBER NOT
C YET FOUND
C = 1, NUMBER FOUND IN EXPONENT FIELD
C NOWLTR = THE CHARACTER CURRENTLY BEING TESTED
C NUMKNT = NUMBER OF DIGITS IN VALUE FIELD
C = 0, LEFT HAND ZERO ONLY READ SO FAR
C = -1, NO DIGITS YET FOUND
C NUMPNT = -1, DECIMAL POINT NOT YET FOUND
C = 0, DECIMAL POINT ENCOUNTERED IN VALUE FIELD
C = .GT.0, VALUE IS NUMBER OF DIGITS ENCOUNTERED
C TO RIGHT OF DECIMAL POINT IN NUMBER.
C979391843284%
END
SUBROUTINE DAFLAG(KONECT,LOWSTR,MAXSTR,MAXBFR,IBUFFR,
1 LOWBFR,MANY ,KIND ,INILTR,KNTLTR,MAXDSK,MAXNAM,
2 MAXNUM,MAXFLG,KONTNT,MINPRT,MAXPRT)
C RENBR(/EVALUATE FORM DSK:NAME.EXT[NUMBER,NUMBER])
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C ROUTINE TO LOCATE COMPONENTS OF FILE SPECIFICATION OF
C FORM
C
C DSK:NAME.EXT[12,34,56]/SWITCH:ARGUMENT/SWITCH:'TEXT'
C
C ONLY ONE DEVICE FIELD, ONE NAME FIELD AND ONE
C BRACKETED FIELD CAN APPEAR IN THE FILE SPECIFICATION.
C THE DEVICE FIELD MUST APPEAR BEFORE THE NAME FIELD,
C BUT THE BRACKETED FIELD CAN BE BEFORE, BETWEEN, OR
C AFTER THESE. THE SWITCH FIELDS CAN APPEAR BEFORE
C AND/OR AFTER THE REST OF THE FILE SPECIFICATION.
C
C THE COMPONENTS OF EACH FIELD WITHIN THE FILE
C DESCRIPTION ARE IDENTIFIED TO THE CALLING PROGRAM BY
C LENGTH AND BY STARTING LOCATION WITHIN THE BUFFER.
C THIS INFORMATION IS RETURNED WITHIN THE 2 ARRAYS
C KNTLTR AND INILTR RESPECTIVELY. SINCE EACH FIELD CAN
C CONSIST OF ANY NUMBER OF COMPONENTS CONNECTED BY THE
C APPROPRIATE CHARACTER (COLON, COMMA OR PERIOD), AND
C SINCE FOR SOME APPLICATIONS A TERMINAL SEPARATOR
C CHARACTER HAS SPECIAL MEANING, A ZERO CHARACTER COUNT
C IS RETURNED IN THE KNTLTR ARRAY FOR THE FINAL
C COMPONENT OF A FIELD IN WHICH AN OPTIONAL TERMINAL
C CONNECTING CHARACTER IS FOUND. SINCE THERE IS NEVER
C ANY QUESTION ABOUT WHETHER AN ITEM IN THE DEVICE
C FIELD WAS FOLLOWED BY THE CONNECTING CHARACTER, THE
C DESCRIPTION OF THE DEVICE FIELD DOES NOT INCLUDE A
C FINAL ZERO CHARACTER COUNT.
C
C A TEXT STRING DELIMITED BY APOSTROPHES IS TREATED AS
C A SWITCH EVEN IF NOT PRECEDED BY A SLASH. THE
C LOCATION OF A TEXT STRING IS THAT OF THE INITIAL
C APOSTROPHE, AND THE LENGTH INCLUDES THE INITIAL, BUT
C NOT THE FINAL, APOSTROPHE. IF THE FINAL APOSTROPHE
C IS MISSING, THEN THE TEXT STRING IS ASSUMED TO EXTEND
C THROUGH THE RIGHTMOST PRINTING CHARACTER IN THE
C BUFFER. WITHIN A TEXT STRING, TWO ADJACENT
C APOSTROPHES INDICATE A SINGLE APOSTROPHE WHICH IS TO
C BE INCLUDED WITHIN THE STRING. IF 2 ADJACENT
C APOSTROPHES ARE ENCOUNTERED WITHIN THE TEXT STRING,
C THEN THE REMAINDER OF THE STRING IS MOVED 1 CHARACTER
C TO THE LEFT SO THAT THE RETURNED CONTENTS OF THE
C BUFFER AND THE RETURNED LENGTH IN THE KNTLTR ARRAY DO
C NOT INCLUDE THE EXTRA APOSTROPHE.
C
C AN ASTERISK WHICH IS FOLLOWED IMMEDIATELY BY A
C PRINTING CHARACTER OTHER THAN A PUNCTUATION MARK IS
C TREATED AS THOUGH SEPARATED FROM THIS FOLLOWING
C CHARACTER BY A PERIOD IF IN THE NAME FIELD, BY A
C COMMA IF IN THE BRACKETED FIELD OR BY A COLON IF IN
C THE SWITCH FIELD.
C
C FOR EXAMPLE, IF THE CONTENTS OF THE BUFFER ARE
C
C DSK:DAFLAG.F4[6001,56,FASP]/LINE:60:/TITLE:'JAN 76'
C
C THEN THE FOLLOWING INFORMATION WOULD BE RETURNED BY 3
C CONSECUTIVE CALLS TO THIS ROUTINE
C
C FIELD KNTLTR CONTENTS INILTR CONTENTS
C
C BY THE FIRST CALL TO THIS ROUTINE
C
C DEVICE 3 1
C
C NAME 6 5
C 2 12
C
C BRACKETED 4 15
C 2 20
C 4 23
C
C BY THE SECOND CALL TO THIS ROUTINE
C
C SWITCH 4 29
C 2 34
C 0 UNDEFINED
C
C BY THE THIRD CALL TO THIS ROUTINE
C
C SWITCH 5 38
C 7 44
C
C THE FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT.
C
C KONECT = -1, SPACES AND/OR TAB CHARACTERS CAN APPEAR
C BETWEEN COMPONENTS OF ANY FIELD, AND CAN
C REPLACE SEPARATING PERIODS AND COMMAS IN THE
C NAME AND BRACKETED FIELDS RESPECTIVELY.
C SUCH SPACES AND/OR TABS MARK END OF A
C PARTICULAR COMPONENT OF FIELD, BUT DO NOT
C SIGNAL EITHER END OF FIELD OR END OF FILE
C SPECIFICATION. COMPONENTS OF FILE
C SPECIFICATION WILL BE LOCATED THROUGH END OF
C BUFFER, OR UP TO FOLLOWING EXCLAMATION
C POINT, AMPERSAND OR SEMICOLON, OR UP TO
C FOLLOWING COMMA WHICH IS NOT IN BRACKETED
C FIELD. SINGLE CALL TO THIS ROUTINE WILL
C REPORT EITHER CONTENTS OF SINGLE SWITCH
C FIELD OR COMBINATION OF DEVICE FIELD, NAME
C FIELD AND BRACKETED FIELD WHETHER OR NOT
C THESE ARE SEPARATED BY SPACES AND/OR TABS.
C = 0, SIMILAR TO KONECT=-1 EXCEPT THAT SPACES
C AND TAB CHARACTERS CANNOT APPEAR BETWEEN
C FIELDS AND CANNOT APPEAR BETWEEN COMPONENTS
C OF DEVICE AND NAME FIELDS. FILE
C SPECIFICATION WILL BEGIN WITH FIRST PRINTING
C CHARACTER OTHER THAN PUNCTUATION CHARACTERS
C COMMA, AMPERSAND, EQUALS SIGN, SEMICOLON OR
C EXCLAMATION POINT, THEN EXTEND THROUGH END
C OF BUFFER, OR UP TO FIRST SPACE OR TAB
C CHARACTER WHICH WHICH IS NEITHER WITHIN
C BRACKETED FIELD NOR WITHIN SWITCH FIELD NOR
C WITHIN TEXT STRING DELIMITED BY APOSTROPHES,
C OR UP TO FOLLOWING EXCLAMATION POINT,
C AMPERSAND OR SEMICOLON, OR UP TO FOLLOWING
C COMMA WHICH IS NOT IN BRACKETED FIELD.
C SINGLE CALL TO THIS ROUTINE WILL REPORT
C EITHER CONTENTS OF SINGLE SWITCH FIELD OR
C COMBINATION OF DEVICE FIELD, NAME FIELD AND
C BRACKETED FIELD PROVIDING THESE ARE
C CONTIGUOUS.
C = 1, SIMILAR TO KONECT=-1 EXCEPT THAT SPACES
C AND TAB CHARACTERS CANNOT APPEAR BETWEEN
C COMPONENTS OF DEVICE AND NAME FIELDS.
C LOWSTR = SUBSCRIPT OF FIRST LOCATION WITHIN INILTR
C AND KNTLTR ARRAYS WHICH CAN BE USED TO HOLD
C DESCRIPTION OF COMPONENTS OF FILE
C SPECIFICATION.
C MAXSTR = SUBSCRIPT OF FINAL LOCATION WITHIN INILTR
C AND KNTLTR ARRAYS WHICH CAN BE USED TO HOLD
C DESCRIPTION OF COMPONENTS OF FILE
C SPECIFICATION.
C MAXBFR = SUBSCRIPT OF FINAL (RIGHTMOST) LOCATION
C WITHIN IBUFFR ARRAY WHICH CONTAINS CHARACTER
C WHICH CAN BE PART OF FILE SPECIFICATION.
C
C FOLLOWING ARGUMENTS ARE USED FOR BOTH INPUT TO, AND
C OUTPUT FROM THIS ROUTINE.
C
C IBUFFR = ARRAY CONTAINING IN LOCATIONS IBUFFR(LOWBFR)
C THROUGH IBUFFR(MAXBFR) CHARACTERS READ BY
C CALLING PROGRAM WITH MULTIPLE OF A1 FORMAT
C AND WHICH CAN FORM FILE SPECIFICATION.
C CONTENTS OF IBUFFR ARRAY ARE RETURNED
C UNCHANGED, WITH EXCEPTION THAT PORTION OF
C TEXT STRING TO RIGHT OF ADJACENT APOSTROPHES
C IN TEXT STRING IN SWITCH FIELD IS MOVED 1
C CHARACTER TO LEFT.
C LOWBFR = SUBSCRIPT OF FIRST (LEFTMOST) LOCATION
C WITHIN IBUFFR ARRAY WHICH CONTAINS CHARACTER
C WHICH CAN BE PART OF FILE SPECIFICATION.
C LOWBFR IS RETURNED POINTING TO FIRST
C CHARACTER WHICH SHOULD BE EVALUATED BY
C SUBSEQUENT CALL TO THIS ROUTINE, OR ELSE IS
C RETURNED POINTING BEYOND END OF BUFFER IF
C BUFFER IS EMPTY OR IF BUFFER CONTAINS MERELY
C COMMENT.
C MANY = SHOULD BE INPUT CONTAINING ZERO EACH TIME
C THIS ROUTINE IS CALLED TO BEGIN PROCESSING
C OF A NEW LOGICAL SECTION OF TEXT, AS FOR
C EXAMPLE WHEN BEGINNING PROCESSING OF A LINE
C OF TEXT NOT TIED TO THE PREVIOUS LINE BY AN
C AMPERSAND AT THE END OF THE PREVIOUS LINE,
C OR WHEN PROCESSING THE TEXT TO THE RIGHT OF
C A SEMICOLON OR TO THE RIGHT OF AN EQUALS
C SIGN.
C = RETURNED CONTAINING THE VALUE WHICH MANY
C SHOULD HAVE WHEN THIS ROUTINE OR ANY OTHER
C IN THE FASP PACKAGE HAVING MANY AS AN
C ARGUMENT IS NEXT CALLED. THE RETURNED VALUE
C OF MANY SHOULD NOT BE CHANGED BY THE CALLING
C PROGRAM UNLESS THE INTERPRETATION OF THE
C CONTENTS OF THE BUFFER IS BEING ABANDONED
C PREMATURELY, IN WHICH CASE MANY SHOULD BE
C RESET TO HAVE A ZERO VALUE.
C = -1, RETURNED IF A MISSING ITEM IS TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA OR FINDS THAT THE BUFFER
C CONTAINS NOTHING OTHER THAN A POSSIBLE
C COMMENT. MANY IS RETURNED CONTAINING -1 IF
C A COMMA PRECEDES EITHER AN AMPERSAND OR A
C SWITCH FIELD.
C = 0, RETURNED IF A MISSING ITEM IS TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA, BUT A MISSING ITEM IS NOT
C INDICATED IF THE BUFFER CONTAINS NOTHING
C OTHER THAN A POSSIBLE COMMENT. MANY IS
C RETURNED CONTAINING ZERO IF BUFFER IS FOUND
C TO BE EMPTY, OR IF FIRST PRINTING CHARACTER
C AT OR TO RIGHT OF IBUFFR(LOWBFR) IS FOUND TO
C BE EXCLAMATION POINT, SEMICOLON OR EQUALS
C SIGN. THESE ARE ALL CONDITIONS UNDER WHICH
C NEXT CALL TO THIS ROUTINE WOULD EVALUATE
C START OF NEW GROUP OF FILE SPECIFICATIONS.
C MANY IS RETURNED UNCHANGED IF A SWITCH FIELD
C IS FOUND AT THE START OF THE CONTENTS OF THE
C BUFFER.
C = 1, RETURNED IF A MISSING ITEM IS NOT TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA OR FINDS THAT THE BUFFER
C CONTAINS NOTHING OTHER THAN A POSSIBLE
C COMMENT. MANY IS RETURNED CONTAINING ONE IF
C A FILE SPECIFICATION CONSISTING OF MORE THAN
C JUST A SWITCH FIELD IS FOUND, OR IF A
C MISSING ITEM IS BEING INDICATED.
C
C FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT. THEIR
C INPUT VALUES ARE IGNORED.
C
C KIND = RETURNED DESCRIBING TYPE OF ITEM
C ENCOUNTERED.
C = 1, NOTHING, EXCEPT POSSIBLY COMMENT
C INDICATED BY LEADING EXCLAMATION POINT, WAS
C FOUND AT OR TO RIGHT OF IBUFFR(LOWBFR).
C LOWBFR IS RETURNED POINTING BEYOND END OF
C BUFFER.
C = 2, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF IBUFFR(LOWBFR) IS SEMICOLON. LOWBFR IS
C RETURNED POINTING TO CHARACTER TO RIGHT OF
C SEMICOLON. IT IS SUGGESTED THAT CALLING
C PROGRAM TREAT THIS AS INDICATION BY USER
C THAT PRECEDING COMMAND HAS BEEN COMPLETED
C AND THAT SUBSEQUENT COMMAND WILL FOLLOW ON
C SAME LINE.
C = 3, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF IBUFFR(LOWBFR) IS EQUALS SIGN. LOWBFR IS
C RETURNED POINTING TO CHARACTER TO RIGHT OF
C EQUALS SIGN. ON PDP10 COMPUTER, EQUALS SIGN
C IS USED TO SEPARATE DESTINATION AND SOURCE
C FILE SPECIFICATIONS.
C = 4, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF IBUFFR(LOWBFR) IS AMPERSAND. CHARACTERS
C TO RIGHT OF AMPERSAND ARE TAKEN TO BE
C COMMENT. LOWBFR IS RETURNED POINTING BEYOND
C END OF BUFFER. IT IS SUGGESTED THAT CALLING
C PROGRAM TREAT THIS AS REQUEST BY USER THAT
C COMMAND BE CONTINUED ON FOLLOWING LINE.
C EFFECT IS NOT QUITE SAME AS IF USER HAD
C TYPED ALL OF FILE SPECIFICATIONS ON SINGLE
C LINE SINCE FILE SPECIFICATION CANNOT BE
C SPLIT ACROSS LINE BOUNDARY.
C = 5, MISSING FILE SPECIFICATION WAS INDICATED
C BY AN EXTRA COMMA.
C = 6, PARTIAL FILE SPECIFICATION WAS FOUND
C WHICH WILL BE CONTINUED BY SUBSEQUENT CALL
C TO THIS ROUTINE. MANY WILL NOT BE
C INCREMENTED UNTIL FINAL SECTION OF FILE
C SPECIFICATION (KIND BEING RETURNED
C CONTAINING 7 OR 8) IS LOCATED. IF FILE NAME
C AND/OR DEVICE AND/OR BRACKETED FIELD HAS
C BEEN FOUND BY CURRENT CALL TO THIS ROUTINE,
C THEN PORTION TO RIGHT OF THAT EVALUATED
C CONTAINS SWITCH. IF SWITCH HAS BEEN FOUND
C BY CURRENT CALL TO THIS ROUTINE, THEN
C PORTION RIGHT OF THAT EVALUATED COULD
C CONTAIN ANY ITEM.
C = 7, FILE SPECIFICATION AND/OR SWITCHES WERE
C FOUND. IF PREVIOUS CALL TO THIS ROUTINE
C RETURNED KIND=6 INDICATING PARTIAL
C SPECIFICATION, THEN INFORMATION RETURNED BY
C CURRENT CALL TO THIS ROUTINE COMPLETES FILE
C SPECIFICATION.
C = 8, FILE SPECIFICATION AND/OR SWITCHES WERE
C FOUND, BUT THESE WERE FOLLOWED BY UNEXPECTED
C CHARACTER POINTED TO BY RETURNED VALUE OF
C LOWBFR. FOR EXAMPLE, TEXT
C DEVICE:NAME.EXTENSION: WOULD BE EVALUATED
C AS THOUGH BUFFER TERMINATED PRIOR TO SECOND
C COLON, AND LOWBFR WILL BE RETURNED POINTING
C TO THIS SECOND COLON. TEXT
C DEVICE:NAME.EXTENSION[6001,56][22,56] WOULD
C BE EVALUATED AS THOUGH BUFFER TERMINATED
C PRIOR TO SECOND BRACKETED FIELD, AND LOWBFR
C WOULD BE RETURNED POINTING TO SECOND LEFT
C BRACKET.
C INILTR = ARRAY RETURNED CONTAINING SUBSCRIPTS WITHIN
C IBUFFR ARRAY OF INITIAL CHARACTERS OF WORDS
C FORMING FILE SPECIFICATION. LOCATIONS
C INILTR(LOWSTR) THROUGH INILTR(MAXDSK)
C CONTAIN LOCATIONS IN BUFFER OF INITIAL
C CHARACTERS OF DEVICE NAMES. LOCATIONS
C INILTR(MAXDSK+1) THROUGH INILTR(MAXNAM)
C CONTAIN LOCATIONS IN BUFFER OF INITIAL
C CHARACTERS OF WORDS IN NAME FIELD.
C LOCATIONS INITLR(MAXNAM+1) THROUGH
C INILTR(MAXNUM) CONTAIN LOCATIONS IN BUFFER
C OF INITIAL CHARACTERS OF WORDS IN BRACKETED
C FIELD. LOCATIONS INILTR(LOWSTR) THROUGH
C INILTR(MAXFLG) CONTAIN LOCATIONS IN BUFFER
C OF INITIAL CHARACTERS OF WORDS AND TEXT
C STRINGS APPEARING IN SWITCH FIELDS. IF TEXT
C STRING APPEARS IN SWITCH FIELD, LOCATION IN
C IBUFFR ARRAY INDICATED BY INILTR ARRAY WILL
C CONTAIN APOSTROPHE.
C KNTLTR = ARRAY RETURNED CONTAINING NUMBERS OF
C CHARACTERS IN EACH OF WORDS FOR WHICH FIRST
C CHARACTERS ARE IN BUFFER LOCATIONS INDICATED
C BY VALUES IN INILTR ARRAY. SUBSCRIPTS OF
C INILTR ARRAY AND KNTLTR ARRAY LOCATIONS
C DESCRIBING PARTICULAR WORD ARE IDENTICAL.
C MAXDSK = RETURNED CONTAINING SUBSCRIPT OF INILTR AND
C KNTLTR ARRAY LOCATIONS DESCRIBING RIGHTMOST
C WORD IN DEVICE FIELD OF FILE SPECIFICATION.
C IF DEVICE FIELD IS NOT FOUND, THEN MAXDSK
C WILL BE RETURNED CONTAINING LOWSTR-1.
C MAXNAM = RETURNED CONTAINING SUBSCRIPT OF INILTR AND
C KNTLTR ARRAY LOCATIONS DESCRIBING RIGHTMOST
C WORD IN NAME FIELD OF FILE SPECIFICATION.
C IF NAME FIELD IS NOT FOUND, THEN MAXNAM WILL
C BE RETURNED EQUAL TO MAXDSK.
C MAXNUM = RETURNED CONTAINING SUBSCRIPT OF INILTR AND
C KNTLTR ARRAY LOCATIONS DESCRIBING RIGHTMOST
C WORD IN BRACKETED FIELD OF FILE
C SPECIFICATION. IF BRACKETED FIELD IS NOT
C FOUND, THEN MAXNUM WILL BE RETURNED EQUAL TO
C MAXNAM.
C MAXFLG = RETURNED CONTAINING SUBSCRIPT OF INILTR AND
C KNTLTR ARRAY LOCATIONS DESCRIBING RIGHTMOST
C WORD OF SWITCH FIELD. IF SWITCH FIELD IS
C NOT FOUND, THEN MAXFLG IS RETURNED EQUAL TO
C LOWSTR-1.
C KONTNT = BIT CODED NUMBER RETURNED DESCRIBING
C LOCATION OF BRACKETED FIELD RELATIVE TO
C DEVICE AND NAME FIELDS. RIGHT BIT IS ONE IF
C AND ONLY IF NAME FIELD IS FOUND. SECOND BIT
C FROM RIGHT IS ONE IF AND ONLY IF DEVICE
C FIELD IS FOUND. FOURTH AND THIRD BITS FROM
C RIGHT ARE 00 IF NO BRACKETED FIELD IS FOUND,
C 01 IF BRACKETED FIELD APPEARS FIRST, 10 IF
C BRACKETED FIELD FOLLOWS DEVICE FIELD, AND 11
C IF BRACKETED FIELD FOLLOWS NAME FIELD.
C FOLLOWING TABLE PRESENTS VALUES OF KONTNT
C RETURNED FOR ALL POSSIBLE COMBINATIONS OF
C DEVICE, NAME AND BRACKETED FIELDS. MINUS
C SIGNS REPRESENT VALUES OF KONTNT WHICH
C CANNOT BE RETURNED. VALUE ZERO INDICATES
C THAT NEITHER DEVICE, NOR NAME NOR BRACKETED
C FIELDS WERE FOUND, BUT DOES NOT INDICATE
C WHETHER SWITCH FIELD WAS FOUND.
C
C DECIMAL BINARY DECIMAL BINARY
C 0 0 NOTHING 8 1000 ------
C 1 1 NAME 9 1001 ------
C 2 10 DEVICE: 10 1010 DEVICE:[]
C 3 11 DEVICE:NAME 11 1011 DEVICE:[]NAME
C 4 100 [] 12 1100 ------
C 5 101 []NAME 13 1101 NAME[]
C 6 110 []DEVICE: 14 1110 ------
C 7 111 []DEVICE:NAME 15 1111 DEVICE:NAME[]
C
C 16 IS ADDED TO KONTNT IF AT SIGN @ IS FOUND
C ANYWHERE IN FILE SPECIFICATION OTHER THAN
C WITHIN A SWITCH FIELD.
C MINPRT = SUBSCRIPT OF IBUFFR ARRAY LOCATION WHICH
C CONTAINS FIRST CHARACTER OF FILE
C SPECIFICATION OR SWITCH IF KIND IS RETURNED
C CONTAINING VALUE OF 6 OR GREATER. MINPRT
C AND MAXPRT CAN BE USED AS LIMITS OF IBUFFR
C ARRAY SUBSCRIPTS IF TEXT MUST BE DISPLAYED
C TO USER. MINPRT AND MAXPRT ARE RETURNED
C UNDEFINED IF KIND IS RETURNED CONTAINING
C VALUE LESS THAN 6.
C MAXPRT = SUBSCRIPT OF IBUFFR ARRAY LOCATION WHICH
C CONTAINS FINAL CHARACTER OF FILE
C SPECIFICATION OR SWITCH IF KIND IS RETURNED
C CONTAINING VALUE OF 6 OR GREATER.
C
DIMENSION KNTLTR(MAXSTR),INILTR(MAXSTR),
1IBUFFR(MAXBFR)
C
C CCCC AAA UU UU TTTTTTTT IIII OOOO NN NN
C CC AAAA UU UU TT II OO OO NNN NN
C CC AA AA UU UU TT II OO OO NNNN NN
C CC AA AA UU UU TT II OO OO NN NN NN
C CC AAAAAAA UU UU TT II OO OO NN NNNN
C CC AA AA UU UU TT II OO OO NN NNN
C CCCC AA AA UUU TT IIII OOOO NN NN
C
C LEFT AND RIGHT SQUARE BRACKETS MUST BE DEFINED USING
C OCTAL NOTATION FOR PDP10 F40 COMPILER. LET FOLLOWING
C COMMENT BE THE COMPILED DATA STATEMENT IF F40 IS USED
C DATA ILEFT,IRIGHT/"555004020100,"565004020100/
DATA ILEFT,IRIGHT/1H[,1H]/
C
DATA ISTAR,ICOLON,IDOT,ICOMMA,ISLASH,IQUOTE,IEND,
1IAND,KOMENT,IEQUAL,KOMAND,IBLANK,ITAB/1H*,1H:,1H.,
21H,,1H/,1H',1H;,1H&,1H!,1H=,1H@,1H ,1H /
C
C MAJOR = -1, PROCESSING NAME SECTION
C = 0, PROCESSING CONTENTS OF BRACKETS
C = 1, PROCESSING SWITCH
C = 2, IN TEXT STRING
C
NEWSPC=1
MAXDSK=LOWSTR-1
MAXNAM=MAXDSK
MAXNUM=MAXDSK
MAXFLG=MAXDSK
NONDSK=0
NONNAM=0
NONNUM=0
KONTNT=0
LOCATN=4
KIND=1
LOWBFR=LOWBFR-1
MIDPRT=LOWBFR
IF(MANY.GE.0)GO TO 46
KIND=5
MANY=1
GO TO 46
1 LOWBFR=LOWBFR+1
MAXPRT=MIDPRT
IF(LOWBFR.GT.MAXBFR)GO TO 32
LETTER=IBUFFR(LOWBFR)
IF(LETTER.EQ.IBLANK)GO TO 24
IF(LETTER.EQ.ITAB)GO TO 24
IF(KIND.NE.7)MINPRT=LOWBFR
MIDPRT=LOWBFR
LSTSPC=NEWSPC
NEWSPC=0
C
C CHECK FOR GENERAL PUNCTUATION CHARACTERS
IF(LETTER.EQ.IEND)GO TO 26
IF(LETTER.EQ.IAND)GO TO 20
IF(LETTER.EQ.KOMENT)GO TO 21
IF(LETTER.EQ.IEQUAL)GO TO 27
IF(LETTER.EQ.ISLASH)GO TO 10
IF(LETTER.EQ.IQUOTE)GO TO 11
IF(LETTER.EQ.ICOMMA)GO TO 22
IF(MAJOR.GT.0)GO TO 3
IF(LETTER.EQ.KOMAND)GO TO 19
IF(MAJOR.EQ.0)GO TO 4
C
C CHECK FOR KEY CHARACTERS IN NAME FIELD
IF(KIND.EQ.7)GO TO 2
INDRCT=MANY
IF(KIND.EQ.5)INDRCT=-1
MANY=1
KIND=7
2 IF(LETTER.EQ.ICOLON)GO TO 30
IF(LETTER.EQ.ILEFT)GO TO 9
IF(NONNAM.GT.0)GO TO 31
IF(LETTER.EQ.IDOT)GO TO 23
GO TO 5
C
C CHECK FOR KEY CHARACTERS IN SWITCH SECTION
3 IF(KOUNT.LT.0)GO TO 29
I=MAJOR
MAJOR=1
IF(LETTER.EQ.ICOLON)GO TO 23
IF(I.NE.2)GO TO 5
GO TO 29
C
C CHECK FOR KEY CHARACTERS IN BRACKET FIELD
4 IF(LETTER.EQ.ILEFT)GO TO 31
IF(LETTER.EQ.IRIGHT)GO TO 25
IF(LETTER.EQ.IDOT)GO TO 23
IF(LETTER.EQ.ICOLON)GO TO 23
C
C EXTEND NAME OR NUMBER OR SWITCH
5 IF(KOUNT.GT.0)GO TO 6
LTRLFT=LOWBFR
KOUNT=1
GO TO 1
6 IF(LSTSPC.NE.0)GO TO 7
IF(IBUFFR(MAXPRT).EQ.ISTAR)GO TO 8
KOUNT=KOUNT+1
GO TO 1
7 IF(MAJOR.GT.0)GO TO 29
8 LOWBFR=LOWBFR-1
GO TO 23
C
C LEFT BRACKET OTHER THAN IN SWITCH FIELD
9 IF(NONNUM.NE.0)GO TO 31
NEXT=4
GO TO 33
C
C INITIAL SLASH FOUND
10 IF(KIND.EQ.7)GO TO 29
IF(KIND.EQ.5)MANY=-1
KIND=7
MAJOR=1
GO TO 44
C
C APOSTROPHE STARTS TEXT STRING
11 IF(MAJOR.LE.0)GO TO 12
IF(KOUNT.EQ.0)GO TO 13
IF(KOUNT.NE.1)GO TO 29
IF(LSTSPC.NE.0)GO TO 29
IF(IBUFFR(MAXPRT).EQ.ISTAR)GO TO 8
GO TO 29
12 IF(KIND.EQ.7)GO TO 29
IF(KIND.EQ.5)MANY=-1
KIND=7
MAJOR=2
13 LTRLFT=LOWBFR
I=LOWBFR
MIDPRT=LOWBFR
14 IF(I.GE.MAXBFR)GO TO 16
I=I+1
LOWBFR=LOWBFR+1
IBUFFR(LOWBFR)=IBUFFR(I)
IF(IBUFFR(I).EQ.IBLANK)GO TO 14
IF(IBUFFR(I).EQ.ITAB)GO TO 14
MIDPRT=LOWBFR
IF(IBUFFR(I).NE.IQUOTE)GO TO 14
IF(I.GE.MAXBFR)GO TO 15
IF(IBUFFR(I+1).NE.IQUOTE)GO TO 15
I=I+1
GO TO 14
15 MIDPRT=MIDPRT-1
16 KOUNT=MIDPRT-LTRLFT+1
17 IF(LOWBFR.EQ.I)GO TO 18
LOWBFR=LOWBFR+1
IBUFFR(LOWBFR)=IBLANK
GO TO 17
18 IF(MAJOR.EQ.2)GO TO 25
MAJOR=2
GO TO 1
C
C AT SIGN
19 IF(KONTNT.GT.15)GO TO 31
IF(KIND.EQ.7)MANY=INDRCT
IF(KIND.EQ.5)MANY=-1
KIND=7
KONTNT=KONTNT+16
GO TO 25
C
C AMPERSAND FOUND
20 IF(KIND.EQ.7)GO TO 32
IF(KIND.EQ.5)MANY=-1
KIND=4
C
C EXCLAMATION POINT FOUND
21 LOWBFR=MAXBFR+1
GO TO 32
C
C COMMA FOUND OTHER THAN IN NUMBER SECTION
22 IF(MAJOR.EQ.0)GO TO 23
IF(KIND.NE.1)GO TO 32
KIND=5
IF(MANY.GT.0)GO TO 1
GO TO 32
C
C COMMA IN BRACKET SECTION OR COLON IN SWITCH SECTION
23 NEXT=3
IF(KOUNT.LT.0)KOUNT=0
GO TO 33
C
C SPACE OR TAB FOUND
24 IF(NEWSPC.NE.0)GO TO 1
NEWSPC=1
IF(KONECT.LT.0)GO TO 1
IF(MAJOR.GE.0)GO TO 1
IF(KIND.NE.7)GO TO 1
IF(KONECT.EQ.0)GO TO 32
25 NEXT=5
GO TO 33
C
C SEMICOLON FOUND
26 IF(KIND.NE.1)GO TO 32
KIND=2
GO TO 28
C
C EQUALS SIGN FOUND
27 IF(KIND.NE.1)GO TO 32
KIND=3
28 LOWBFR=LOWBFR+1
GO TO 32
C
C CURRENT CALL CANNOT RETURN ALL INFORMATION
29 KIND=6
GO TO 32
C
C COLON FOUND IN NAME FIELD
30 IF(NONDSK.LE.0)GO TO 35
C
C ILLEGAL CHARACTER, BUT MUST CLEAN UP BEFORE EXIT
31 KIND=8
C
C PREPARE TO EXIT TO CALLING PROGRAM
32 NEXT=1
C
C TERMINATE GROUP OF NAMES OR NUMBERS
33 IF(KOUNT.LT.0)GO TO 42
IF(MAJOR.GT.0)GO TO 40
IF(MAJOR.EQ.0)GO TO 34
LOCAL=MAXNAM
IF(NONNAM.EQ.0)KONTNT=KONTNT+1
LOCATN=12
NONNAM=-1
NONDSK=1
GO TO 36
34 LOCAL=MAXNUM
IF(NONNUM.EQ.0)KONTNT=KONTNT+LOCATN
NONNUM=-1
GO TO 37
35 IF(KOUNT.LT.0)KOUNT=0
NEXT=2
LOCAL=MAXDSK
IF(NONDSK.EQ.0)KONTNT=KONTNT+2
LOCATN=8
NONDSK=-1
IF(MAXDSK.LT.MAXSTR)MAXDSK=MAXDSK+1
36 IF(MAXNAM.LT.MAXSTR)MAXNAM=MAXNAM+1
37 IF(MAXNUM.LT.MAXSTR)MAXNUM=MAXNUM+1
INDEX=MAXNUM
LOCAL=LOCAL+1
38 IF(INDEX.LE.LOCAL)GO TO 41
IF(INDEX.GT.MAXSTR)GO TO 39
INILTR(INDEX)=INILTR(INDEX-1)
KNTLTR(INDEX)=KNTLTR(INDEX-1)
39 INDEX=INDEX-1
GO TO 38
40 IF(MAXFLG.GE.MAXSTR)GO TO 42
MAXFLG=MAXFLG+1
LOCAL=MAXFLG
41 IF(LOCAL.GT.MAXSTR)GO TO 42
KNTLTR(LOCAL)=KOUNT
INILTR(LOCAL)=LTRLFT
C
C NEXT = 1, EXIT
C = 2, AFTER COLON OF DEVICE FIELD
C = 3, AFTER PERIOD IN NAME OR COMMA IN
C BRACKETED SECTION OR COLON IN SWITCH SECTION
C = 4, MARK THAT ARE IN BRACKETED SECTION
C = 5, TERMINATE CURRENT SECTION SO ITS TYPE
C WILL NOT BE PERMITTED
42 GO TO(49,47,44,43,45),NEXT
C
C MARK THAT ARE IN BRACKET SECTION
43 MAJOR=0
44 KOUNT=0
GO TO 48
C
C TERMINATE CURRENT SECTION
45 IF(MAJOR.GT.0)GO TO 47
IF(NONDSK.LT.0)NONDSK=1
IF(NONNAM.LT.0)NONNAM=1
IF(NONNUM.LT.0)NONNUM=1
46 MAJOR=-1
C
C PREPARE FOR NEXT ITEM IN LIST
47 KOUNT=-1
48 LTRLFT=LOWBFR+1
GO TO 1
C
C RETURN TO CALLING PROGRAM
49 IF(KIND.EQ.5)MANY=1
IF(KIND.LT.4)MANY=0
RETURN
C264038073645[]:';&!@
END
SUBROUTINE DACASE(MINBFR,MAXBFR,IBUFFR)
C RENBR(/CONVERT LOWER CASE LETTERS TO UPPER)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C MINBFR = SUBSCRIPT OF FIRST LOCATION IN IBUFFR ARRAY
C CONTAINING CHARACTER TO BE CONVERTED TO
C UPPER CASE. MINBFR IS RETURNED UNCHANGED.
C MAXBFR = SUBSCRIPT OF FINAL LOCATION IN IBUFFR ARRAY
C CONTAINING CHARACTER TO BE CONVERTED TO
C UPPER CASE. MAXBFR IS RETURNED UNCHANGED.
C IBUFFR = ARRAY CONTAINING IN LOCATIONS HAVING
C SUBSCRIPTS MINBFR THROUGH MAXBFR CHARACTERS
C READ BY MULTPLE OF 1A FORMAT WHICH ARE TO BE
C CONVERTED TO UPPER CASE IF INPUT IN LOWER
C CASE.
C
DIMENSION IBUFFR(MAXBFR),KAPITL(26),LOWER(26)
C
C CCCC AAA UU UU TTTTTTTT IIII OOOO NN NN
C CC AAAA UU UU TT II OO OO NNN NN
C CC AA AA UU UU TT II OO OO NNNN NN
C CC AA AA UU UU TT II OO OO NN NN NN
C CC AAAAAAA UU UU TT II OO OO NN NNNN
C CC AA AA UU UU TT II OO OO NN NNN
C CCCC AA AA UUU TT IIII OOOO NN NN
C
C TO CONVERT LOWER CASE LETTERS IN THE INPUT TEXT
C BUFFER INTO UPPER CASE LETTERS, THIS ROUTINE COMPARES
C THE CHARACTERS IN THE INPUT TEXT BUFFER AGAINST THE
C LOWER CASE LETTERS IN THE LOWER ARRAY. THE LETTERS
C IN THE LOWER ARRAY MUST BE ARRANGED IN INCREASING
C NUMERICAL ORDER. IF THE NUMERICAL ORDER IS NOT THE
C SAME AS THE ALPHABETICAL ORDER, THEN THE DATA
C STATEMENTS APPEARING BELOW MUST BE CHANGED OR ELSE
C SOME OR ALL LOWER CASE LETTERS IN THE INPUT TEXT
C BUFFER WILL NOT BE CONVERTED INTO THE CORRESPONDING
C UPPER CASE LETTERS. ONCE THE LETTERS IN THE LOWER
C ARRAY ARE SORTED INTO INCREASING NUMERICAL ORDER, THE
C UPPER CASE LETTERS IN THE KAPITL ARRAY SHOULD BE
C REARRANGED SO THAT LOWER AND UPPER CASE VERSIONS OF
C EACH LETTER APPEAR IN LOCATIONS IN THE LOWER AND
C KAPITL ARRAYS HAVING THE SAME SUBSCRIPTS.
C
C IF THE COMPUTER UPON WHICH THIS ROUTINE IS USED DOES
C NOT SUPPORT LOWER CASE LETTERS, THEN BOTH THE LOWER
C AND KAPITL ARRAYS CAN CONTAIN THE LETTERS 1HA THROUGH
C 1HZ IN ALPHABETICAL ORDER (EVEN IF THIS IS NOT THE
C NUMERICALLY SORTED ORDER).
C
C KAPITL = UPPER CASE LETTERS A THROUGH Z SORTED ON
C LOWER ARRAY
DATA KAPITL/
11HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
21HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
31HU,1HV,1HW,1HX,1HY,1HZ/
C
C LOWER = LOWER CASE LETTERS A THROUGH Z SORTED INTO
C NUMERICALLY INCREASING ORDER
DATA LOWER/
11Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
21Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,
31Hu,1Hv,1Hw,1Hx,1Hy,1Hz/
C
C THIS IS A TERNARY SEARCH TAKING ADVANTAGE OF THE SIZE
C OF ALPHABET BEING NEARLY 3**3. THE 3RD OF THE ARRAY
C CONTAINING THE DESIRED LETTER IS FIRST LOCATED, THEN
C THE 3RD OF THIS 3RD, AND FINALLY EACH OF THE
C REMAINING 3 LETTERS ARE TESTED INDIVIDUALLY. TO
C PREVENT TESTING AGAINST THE 27TH LETTER WHICH DOES
C NOT EXIST, UPPER 3RD IS TAKEN AS UPPER 9 SORTED
C LETTERS, RATHER THAN FROM 19TH THROUGH 27TH LETTERS,
C SO THAT LOWER(18) IS TESTED AGAINST IN UPPER 3RD EVEN
C THOUGH LETTER BEING MATCHED HAS ALREADY BEEN FOUND TO
C BE LARGER THAN THIS.
INDEX=MINBFR
1 IF(INDEX.GT.MAXBFR)GO TO 8
LETTER=IBUFFR(INDEX)
IF(LETTER.GT.LOWER(18))GO TO 3
IF(LETTER.GT.LOWER(9))GO TO 2
IF(LETTER.LT.LOWER(1))GO TO 7
J=3
GO TO 4
2 J=12
GO TO 4
3 IF(LETTER.GT.LOWER(26))GO TO 7
J=20
4 IF(LETTER.LE.LOWER(J))GO TO 5
J=J+3
IF(LETTER.GT.LOWER(J))J=J+3
5 IF(LETTER.EQ.LOWER(J))GO TO 6
J=J-1
IF(LETTER.EQ.LOWER(J))GO TO 6
J=J-1
IF(LETTER.NE.LOWER(J))GO TO 7
6 IBUFFR(INDEX)=KAPITL(J)
7 INDEX=INDEX+1
GO TO 1
8 RETURN
C
C THE FOLLOWING BINARY SEARCH COULD BE USED AS A MODEL
C IF A LARGER ALPHABET HAD TO BE CONVERTED
C INDEX=MINBFR
C GO TO 3
C 1 IBUFFR(INDEX)=KAPITL(NOWTST)
C 2 INDEX=INDEX+1
C 3 IF(INDEX.GT.MAXBFR)GO TO 7
C LETTER=IBUFFR(INDEX)
C IF(LETTER.LT.LOWER(1))GO TO 2
C IF(LETTER.GT.LOWER(26))GO TO 2
C MAXTST=26
C MINTST=1
C NOWTST=MINTST
C GO TO 5
C 4 MAXTST=NOWTST
C 5 LNGTST=(MAXTST-MINTST)/2
C NOWTST=MAXTST-LNGTST
C IF(LETTER.EQ.LOWER(NOWTST))GO TO 1
C IF(LETTER.GT.LOWER(NOWTST))GO TO 6
C IF(LNGTST.GT.0)GO TO 4
C IF(MAXTST.LE.MINTST)GO TO 2
C NOWTST=MINTST
C GO TO 4
C 6 IF(LNGTST.LE.0)GO TO 2
C MINTST=NOWTST
C GO TO 5
C 7 RETURN
C319577213350
END