Google
 

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