Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50541/lbllib.for
There is 1 other file named lbllib.for in the archive. Click here to see a list.
      SUBROUTINE GETADR(ITTY,IDISK,LMTKND,LMTSEC,
     1LTRKND,ISTART,ICHAIN,LENGTH,LTRSTR,KNTINP,LOCATN,
     2LMTSTR,INFORM,LTRBFR,LMTBFR)
C     RENBR(/GET COMPONENTS OF NEXT ADDRESS)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     This routine reads all but the first line of the file
C     which specifies the components of the addresses.  The
C     routine stores the components of the next address  in
C     the file each time it is called.
C
C     ITTY   = UNIT NUMBER UPON WHICH ERROR MESSAGES ARE
C              DISPLAYED.
C     IDISK  = UNIT NUMBER FROM WHICH INFORMATION IS READ.
C     KNTINP = 0 ON INPUT, FIRST TIME THAT THIS ROUTINE
C              HAS BEEN CALLED.  CALLING PROGRAM HAS JUST
C              OPENED THE INPUT FILE.
C            = -2 ON INPUT, FIRST TIME THAT THIS ROUTINE
C              HAS BEEN CALLED, BUT CALLING PROGRAM READ
C              THE FIRST LINE IN THE INPUT FILE AND THIS
C              LINE IS ALREADY IN THE LTRBFR ARRAY.
C            = -1 ON INPUT, PREVIOUS CALL TO THIS ROUTINE
C              READ THE END OF FILE.
C            = GREATER THAN ZERO ON INPUT, SUBSEQUENT TIME
C              THAT THIS ROUTINE HAS BEEN CALLED.  THE VALUE
C              OF KNTINP IS THE VALUE RETURNED BY THE PREVIOUS
C              CALL TO THIS ROUTINE.
C            = 0 RETURNED IF NO MORE ADDRESSES ARE IN FILE.
C            = GREATER THAN ZERO, RETURNED IF AN ADDRESS IS
C              RETURNED WHICH WAS NOT TERMINATED BY AN END OF
C              FILE.  KNTINP IS THE LINE COUNT OF THE INPUT
C              LINE WHICH TERMINATED THE ADDRESS.
C            = -2 RETURNED IF AN ADDRESS IS RETURNED BUT
C              THIS WAS TERMINATED BY AN END OF FILE.
C              NEXT CALL TO THIS ROUTINE WILL RETURN KNTINP=0.
C     LMTKND = MAXIMUN NUMBER OF DIFFERENT TYPES OF ITEMS
C              WHICH CAN BE RECOGNIZED.  IF ADDRESSES CAN
C              CONTAIN NAME, STREET, CITY, STATE AND ZIP
C              CODE NUMBER, THEN LMTKND WOULD BE 5 EVEN IF
C              NOT ALL OF THESE APPEARED IN EVERY ADDRESS
C              AND EVEN IF SOME ADDRESSES CONTAINED CONTINUATION
C              LINES FOR SOME TIMES OF ITEMS.  LMTKND IS THE
C              DIMENSION OF THE LTRKND AND ISTART ARRAYS.
C     LMTSEC = MAXIMUM NUMBER OF COMPONENTS OF A SINGLE
C              ADDRESS, COUNTING CONTINUATION LINES AS
C              SEPARATE COMPONENTS.  THIS IS DIMENSION OF
C              LENGTH AND ICHAIN, AND THE FIRST DIMENSION
C              OF LTRSTR.
C     ISTART = ARRAY CONTAINING FIRST SUBSCRIPT OF LTRSTR
C              LOCATIONS RETURNED WITH A PARTICULAR TYPE OF
C              COMPONENT OF AN ADDRESS.  IF MORE THAN ONE
C              COMPONENT OF THIS TYPE IS RETURNED, THEN THE
C              ICHAIN ARRAY LOCATION WITH SAME SUBSCRIPT
C              POINTS TO NEXT OF THESE, AND THE ICHAIN ARRAY
C              LOCATION PARALLEL TO THAT LOCATION POINTS TO
C              NEXT, AND SO ON.  THE CHAIN IS ENDED EITHER
C              BY A ZERO ISTART VALUE IF NO COMPONENT OF THIS
C              TYPE WAS FOUND, OR BY A ZERO ICHAIN VALUE.
C     ICHAIN = ARRAY CONTAINING THE LOCATION WITHIN THE
C              LTRSTR ARRAY OF THE NEXT CONTINUATION LINE.
C     LENGTH = ARRAY CONTAINING THE COLUMN NUMBER OF THE
C              RIGHTMOST PRINTING CHARACTER IN EACH ITEM
C              RETURNED IN THE LTRSTR ARRAY.
C     LTRSTR = ARRAY RETURNED CONTAINING THE LETTERS IN
C              THE LINES READ FROM THE INPUT FILE.
C     INFORM = 0, DO NOT TELL USER OF ERRORS, AS WHEN THE
C              RESULTING ADDRESSES ARE WRITTEN TO THE
C              CONTROLLING TERMINAL.
C            = 1, REPORT ERRORS.
C
      DIMENSION ISTART(LMTKND),ICHAIN(LMTSEC),
     1LENGTH(LMTSEC),LOCATN(LMTSEC)
      DIMENSION LTRSTR(LMTSTR),LTRKND(LMTKND),LTRBFR(LMTBFR),
     1LTRABC(26),LWRABC(26)
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
      DATA LTRATS,LTRNUM,LTRSPA/1H@,1H#,1H /
C
C     INITIALIZE BEFORE NEXT ADDRESS
      KNTSTR=0
      KNTLTR=0
      DO 1 I=1,LMTKND
      ISTART(I)=0
    1 CONTINUE
      IF(KNTINP.GE.0)GO TO 2
      IF(KNTINP.NE.-2)GO TO 25
      KNTINP=1
      GO TO 4
C
C     READ NEXT LINE
    2 READ(IDISK,3,END=24)LTRBFR
    3 FORMAT(80A1)
      KNTINP=KNTINP+1
    4 MAXBFR=LMTBFR+1
    5 MAXBFR=MAXBFR-1
      IF(MAXBFR.LE.0)GO TO 2
      IF(LTRBFR(MAXBFR).EQ.LTRSPA)GO TO 5
C
C     IDENTIFY TYPE OF LINE
      IF(LTRBFR(1).EQ.LTRATS)GO TO 7
      IF(INFORM.NE.0)WRITE(ITTY,6)KNTINP,(LTRBFR(I),I=1,MAXBFR)
    6 FORMAT(' Line',1I6,' does not start with @'/1x,80A1)
      GO TO 2
    7 IF(LTRBFR(2).EQ.LTRATS)GO TO 24
      IF(LTRBFR(2).EQ.LTRNUM)GO TO 23
      IF(MAXBFR.LT.3)GO TO 2
      LTRNOW=LTRBFR(2)
      DO 8 I=1,LMTKND
      IF(LTRNOW.NE.LTRKND(I))GO TO 8
      IPOINT=I
      GO TO 15
    8 CONTINUE
      DO 11 I=1,26
      IF(LTRNOW.EQ.LTRABC(I))GO TO 9
      IF(LTRNOW.EQ.LWRABC(I))GO TO 10
      GO TO 11
    9 LTRNOW=LWRABC(I)
      GO TO 12
   10 LTRNOW=LTRABC(I)
      GO TO 12
   11 CONTINUE
   12 DO 13 I=1,LMTKND
      IF(LTRNOW.NE.LTRKND(I))GO TO 13
      IPOINT=I
      GO TO 15
   13 CONTINUE
      IF(INFORM.NE.0)WRITE(ITTY,14)KNTINP,(LTRBFR(I),I=1,MAXBFR)
   14 FORMAT(' Line',1I6,' has unknown 2nd character'/1X,80A1)
      GO TO 2
C
C     STORE THE LINE
   15 IF(KNTSTR.GE.LMTSEC)GO TO 21
      IF((KNTLTR+MAXBFR-2).GT.LMTSTR)GO TO 21
      KNTSTR=KNTSTR+1
      IF(ISTART(IPOINT).EQ.0)GO TO 18
      IPOINT=ISTART(IPOINT)
   16 NEXT=ICHAIN(IPOINT)
      IF(NEXT.EQ.0)GO TO 17
      IPOINT=NEXT
      GO TO 16
   17 ICHAIN(IPOINT)=KNTSTR
      GO TO 19
   18 ISTART(IPOINT)=KNTSTR
   19 ICHAIN(KNTSTR)=0
      LOCATN(KNTSTR)=KNTLTR+1
      LENGTH(KNTSTR)=MAXBFR-2
      DO 20 I=3,MAXBFR
      KNTLTR=KNTLTR+1
      LTRSTR(KNTLTR)=LTRBFR(I)
   20 CONTINUE
      GO TO 2
C
C     INSUFFICIENT ROOM TO STORE ADDRESS
   21 IF(INFORM.NE.0)WRITE(ITTY,22)KNTINP,(LTRBFR(I),I=1,MAXBFR)
   22 FORMAT(' Line',1I6,' exceeds storage'/1X,80A1)
      GO TO 2
C
C     END OF ADDRESS READ
   23 IF(KNTSTR.LE.0)GO TO 2
      GO TO 26
C
C     END OF FILE READ
   24 IF(KNTSTR.LE.0)GO TO 25
      KNTINP=-1
      GO TO 26
   25 KNTINP=0
   26 RETURN
      END
      SUBROUTINE PUTADR(LMTONE,LMTKND,LMTSEC,LMTTWO,ISTART,
     1    ICHAIN,LENGTH,LTRSTR,LOCATN,LMTSTR,LNGLIN,KNTLIN,
     2    LMTLIN,LTRADR,LMTCHR,KNTCHR,IFCODE,LOCTTL,INFORM)
C     RENBR(/CONSTRUCT ADDRESS FROM ITS COMPONENTS)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     This  routine  constructs   an   address   from   its
C     components.   Which  components are placed into which
C     lines is specified by the KONTNT  and  ITRAIL  arrays
C     described below.
C
      DIMENSION ISTART(LMTKND),ICHAIN(LMTSEC),
     1LENGTH(LMTSEC),LOCATN(LMTSEC),LNGLIN(LMTLIN),
     2LTRADR(LMTCHR),LTRSTR(LMTSTR)
      DIMENSION KONTNT(23),ITRAIL(23)
C
C     KONTNT = DEFINES ITEMS ON EACH LINE OF ADDRESS.
C              VALUES ARE LOCATIONS IN ALPHABET OF LETTERS
C              IDENTIFYING ITEMS IN THE ORIGINAL FILE READ
C              AS DATA.  THE END OF THE ITEMS ON EACH LINE
C              IS INDICATED BY A ZERO VALUE.
C     ITRAIL = INDICATES WHAT TO INSERT BEFORE THE ITEM
C              INDICATED BY THE PARALLEL ENTRY IN THE
C              KONTNT ARRAY IF THIS ITEM IS NOT FIRST ON LINE.
C            = 0, INSERT SINGLE SPACE BETWEEN ADJACENT ITEMS
C              ON SAME LINE.
C            = 1, INSERT COMMA AND SPACE BETWEEN ADJACENT
C              ITEMS ON SAME LINE.
C            = 2, INSERT 2 SPACES BETWEEN ADJACENT ITEMS ON
C              SAME LINE.
C
      DATA KONTNT/
     111, 0,
     216, 6,13,12, 5, 0,
     320, 0,
     4 4, 0,
     515, 0,
     6 1, 0,
     7 3,19,26,14, 0,
     825, 0/
      DATA ITRAIL/
     1 0, 0,
     2 0, 0, 0, 0, 1, 0,
     3 0, 0,
     4 0, 0,
     5 0, 0,
     6 0, 0,
     7 0, 1, 2, 1, 0,
     8 0, 0/
C
C     LOOP THROUGH THE LINES OF THE ADDRESS
      LOCTTL=0
      KNTLIN=0
      KNTCHR=0
      IWHAT=0
      LNGTST=1
      DO 7 LINE=1,8
      INICHR=KNTCHR
      INILIN=KNTLIN
C
C     LOOP THROUGH THE VARIOUS ITEMS ON SAME LINE
    1 IWHAT=IWHAT+1
      IF(KONTNT(IWHAT).EQ.0)GO TO 5
      IF(IFCODE.NE.0)GO TO 2
      IF(LINE.EQ.1)GO TO 1
    2 NEXT=0
      IPOINT=KONTNT(IWHAT)
      INSERT=ITRAIL(IWHAT)
    3 IF(KNTLIN.GE.LMTLIN)GO TO 8
      CALL PACLIN(INSERT,LMTONE,IPOINT,  NEXT,LMTKND,
     1    LMTSEC,LMTTWO,ISTART,ICHAIN,LENGTH,LTRSTR,IFDONE,
     2    LOCATN,LMTSTR,INICHR,KNTCHR,LMTCHR,LTRADR,LMTLIN,
     3    LNGTST)
C
C     ITEM WOULD NOT FIT ON LINE ALREADY PARTLY FULL
      IF(IFDONE.GE.0)GO TO 4
      IF(IFDONE.EQ.-2)GO TO 8
      KNTLIN=KNTLIN+1
      LNGLIN(KNTLIN)=KNTCHR-INICHR
      INICHR=KNTCHR
      GO TO 2
C
C     ADDITIONAL LINES OF ITEM OF SAME TYPE MUST BE SHOWN
    4 IF(NEXT.LE.0)GO TO 1
      KNTLIN=KNTLIN+1
      LNGLIN(KNTLIN)=KNTCHR-INICHR
      INICHR=KNTCHR
      GO TO 3
C
C     ALL ITEMS COMPLETED
    5 IF(KNTCHR.LE.INICHR)GO TO 6
      KNTLIN=KNTLIN+1
      LNGLIN(KNTLIN)=KNTCHR-INICHR
      INICHR=KNTCHR
C
C     RECORD POSITION OF FIRST LINE OF TITLE
    6 IF(LINE.NE.3)GO TO 7
      IF(KNTLIN.GT.INILIN)LOCTTL=INILIN+1
    7 CONTINUE
C
C     ALL DONE WITH THIS ADDRESS
    8 RETURN
      END
      SUBROUTINE PACLIN(INSERT,LMTONE,IPOINT,  NEXT,LMTKND,
     1    LMTSEC,LMTTWO,ISTART,ICHAIN,LENGTH,LTRSTR,IFDONE,
     2    LOCATN,LMTSTR,INICHR,KNTCHR,LMTCHR,LTRADR,LMTLIN,
     3    LNGTST)
C     RENBR(/INSERT NEXT COMPONENT INTO LINE)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     This routine inserts the next component into  a  line
C     of the address.
C
C     INSERT = 0, INSERT SPACE BETWEEN ITEMS
C            = 1, INSERT COMMA AND SPACE BETWEEN ITEMS
C            = 2, INSERT 2 SPACES
C     LMTCHR = MAXIMUM NUMBER OF CHARACTERS IN A SINGLE OUTPUT
C              LINE.
C     LTRADR = ARRAY TO BE RTURND WITH OUTPUT LINE.
C     KNTCHR = NUMBER OF LOCATIONS ALREADY IN USE IN LTRADR.
C     IPOINT = TYPE OF ITEM BEING COPIED.  REALLY LOCATION
C              OF FIRST ITEM OF THIS TYPE IN ISTART ARRAY.
C     NEXT   = 0 ON INPUT IF FIRST ITEM OF THIS TYPE.
C            = NON-ZERO ON INPUT, IS LOCATION IN LENGTH
C              AND LTRSTR ARRAY OF LINE TO BE COPIED.
C            = 0 RETURNED IF ALL ITEMS OF THIS TYPE DONE.
C            = NON-ZERO RETURNED IF MORE ITEMS OF THIS TYPE
C              EXIST.  NEXT SHOULD BE SENT TO NEXT CALL
C              OF THIS ROUTINE UNCHANGED.
C     IFDONE = -1 RETURNED IF CURRENT ITEM COULD NOT FIT ON
C              LINE.  CALLING PROGRAM SHOULD ADVANCE LINE
C              COUNT AND THEN CALL THIS ROUTINE AGAIN.
C            = -2 RETURNED IF THE OUTPUT BUFFER DOES NOT
C              HAVE ENOUGH ROOM AT ALL FOR THIS LINE.
C            = 0 RETURNED IF CURRENT ITEM FIT ONTO LINE.
C            = 1 RETURNED IF CURRENT ITEM HAD TO BE TRUNCATED
C              TO FIT ON LINE WHICH WAS EMPTY.  CALLING
C              PROGRAM SHOULD PRINT LINE.
C     LNGTST = 0, ALLOW MULTIPLE ENTRY LINE TO BE FULL LENGTH.
C            = 1, RESTRICT LENGTH OF MULTIPLE ENTRY LINE.
C
      DIMENSION ISTART(LMTKND),ICHAIN(LMTSEC),
     1LENGTH(LMTSEC),LOCATN(LMTSEC),LTRADR(LMTCHR),
     2LTRSTR(LMTSTR)
C
      DATA LTRCOM,LTRSPA/1H,,1H /
C
      INIBFR=KNTCHR
      MAXONE=INICHR+LMTONE
      MAXTWO=INICHR+LMTTWO
      IF(LNGTST.EQ.0)MAXTWO=MAXONE
C
C     LOCATE THE COMPONENT TO BE INSERTED
      IF(NEXT.NE.0)GO TO 2
      NEXT=ISTART(IPOINT)
      IF(NEXT.EQ.0)GO TO 9
C
C     REMOVE SPACES AT START OF INITIAL LINE
      IFIRST=LOCATN(NEXT)
      IFINAL=IFIRST+LENGTH(NEXT)-1
    1 IF(IFIRST.GE.IFINAL)GO TO 3
      IF(LTRSTR(IFIRST).NE.LTRSPA)GO TO 3
      IFIRST=IFIRST+1
      GO TO 1
C
C     RETAIN SPACES AT START OF CONTINUATION LINE
    2 IFIRST=LOCATN(NEXT)
      IFINAL=IFIRST+LENGTH(NEXT)-1
C
C     INSERT SPACE AFTER PREVIOUS ITEM
    3 IF(KNTCHR.LE.INICHR)GO TO 7
      IF(INSERT.EQ.1)GO TO 4
      IF(INSERT.EQ.2)GO TO 5
      IF(KNTCHR.GE.MAXTWO)GO TO 11
      IF(KNTCHR.GE.LMTCHR)GO TO 10
      KNTCHR=KNTCHR+1
      LTRADR(KNTCHR)=LTRSPA
      GO TO 6
    4 IF((KNTCHR+1).GE.MAXTWO)GO TO 11
      IF((KNTCHR+1).GE.LMTCHR)GO TO 10
      KNTCHR=KNTCHR+1
      LTRADR(KNTCHR)=LTRCOM
      KNTCHR=KNTCHR+1
      LTRADR(KNTCHR)=LTRSPA
      GO TO 6
    5 IF((KNTCHR+1).GE.MAXTWO)GO TO 11
      IF((KNTCHR+1).GE.LMTCHR)GO TO 10
      KNTCHR=KNTCHR+1
      LTRADR(KNTCHR)=LTRSPA
      KNTCHR=KNTCHR+1
      LTRADR(KNTCHR)=LTRSPA
    6 IF((KNTCHR+LENGTH(NEXT)).GT.MAXTWO)GO TO 11
C
C     INSERT NEW ITEM
    7 DO 8 INDEX=IFIRST,IFINAL
      IF(KNTCHR.GE.MAXONE)GO TO 12
      IF(KNTCHR.GE.LMTCHR)GO TO 10
      KNTCHR=KNTCHR+1
      LTRADR(KNTCHR)=LTRSTR(INDEX)
    8 CONTINUE
      NEXT=ICHAIN(NEXT)
    9 IFDONE=0
      GO TO 13
C
C     CURRENT ITEM WILL NOT FIT ON LINE
   10 KNTCHR=INIBFR
      IFDONE=-2
      GO TO 13
   11 KNTCHR=INIBFR
      IFDONE=-1
      GO TO 13
   12 NEXT=ICHAIN(NEXT)
      IFDONE=1
      GO TO 13
C
C     RETURN TO CALLING PROGRAM
   13 RETURN
      END
      SUBROUTINE ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
C     RENBR(/EVALUATE USER RESPONSE TO INITIAL QUESTIONS)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     Reads a command typed by the user.   This command can
C     consist of a letter,  a number,  or a letter followed
C     by a number.  The number can contain sign and decimal
C     point.
C
C     JTTY   = UNIT NUMBER FROM WHICH TEXT TYPED BY USER IS READ
C     KIND   = RETURNED DESCRIBING TYPE OF RESPONSE
C            = 1, EMPTY LINE
C            = 2, NUMBER WITHOUT DECIMAL POINT
C            = 3, NUMBER WITH DECIMAL POINT
C            = 4, LETTER
C            = 5, LETTER FOLLOWED BY NUMBER WITHOUT DECIMAL POINT
C            = 6, LETTER FOLLOWED BY NUMBER WITH DECIMAL POINT
C            = 7, QUESTION MARK
C            = 8, UNKNOWN RESPONSE.  IF THIS STARTS WITH A LETTER
C              OF ALPHABET, THEN LETTER IS RETURNED WITH POSITION
C              IN ALPHABET.  OTHERWISE LETTER IS RETURNED ZERO.
C     LETTER = RETURNED CONTAINING POSITION IN ALPHABET OF LETTER
C              IF KIND IS RETURNED SET TO 4, 5 OR 6.
C     IVALUE = RETURNED CONTAINING VALUE OF A NUMBER TYPED WITHOUT
C              DECIMAL POINT IF KIND IS RETURNED SET TO 2 OR 5.
C     AVALUE = RETURNED CONTAINING VALUE OF A NUMBER TYPED WITH
C              OR WITHOUT DECIMAL POINT IF KIND IS RETURNED SET TO
C              2, 3, 5 OR 6.
C
      DIMENSION LTRDGT(10),LTRABC(26),LWRABC(26),
     1LTRBFR(20)
C
      DATA LTRSPA,LTRDOT,LTRQUE,LTRMIN,LTRPLU/
     1 1H ,1H.,1H?,1H-,1H+/
      DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
C
C     LMTBFR = DIMENSION OF LTRBFR ARRAY, MAXIMUM NUMBER OF
C              CHARACTERS IN AN ANSWER.
      DATA LMTBFR/20/
C
C     GET LINE TYPED BY USER
      READ(JTTY,1,END=23)LTRBFR
    1 FORMAT(72A1)
C
C     INITIALIZE
      LETTER=0
      IMINUS=0
      IVALUE=0
      AVALUE=0
      KIND=1
      POWER=1.0
      LOCBFR=0
C
C     SCAN ACROSS LINE LOOKING FOR INITIAL LETTER
    2 LOCBFR=LOCBFR+1
      IF(LOCBFR.GT.LMTBFR)GO TO 24
      LTRNOW=LTRBFR(LOCBFR)
      IF(LTRNOW.EQ.LTRSPA)GO TO 2
      IF(LTRNOW.EQ.LTRQUE)GO TO 6
      DO 4 I=1,26
      IF(LTRNOW.EQ.LTRABC(I))GO TO 3
      IF(LTRNOW.EQ.LWRABC(I))GO TO 3
      GO TO 4
    3 LETTER=I
      KIND=4
      GO TO 5
    4 CONTINUE
      GO TO 8
C
C     SKIP OVER ANY SPACES BETWEEN LETTER AND NUMBER
    5 LOCBFR=LOCBFR+1
      IF(LOCBFR.GT.LMTBFR)GO TO 24
      LTRNOW=LTRBFR(LOCBFR)
      IF(LTRNOW.EQ.LTRSPA)GO TO 5
      GO TO 8
C
C     QUESTION MARK
    6 KIND=7
C
C     IDENTIFY THE NUMBER TO RIGHT OF LETTER OR BY ITSELF
    7 LOCBFR=LOCBFR+1
      IF(LOCBFR.GT.LMTBFR)GO TO 24
      LTRNOW=LTRBFR(LOCBFR)
C
C     CHECK FOR ALLOWED CHARACTERS OTHER THAN DIGITS
    8 IF(LTRNOW.EQ.LTRSPA)GO TO 14
      IF(LTRNOW.EQ.LTRDOT)GO TO 15
      IF(LTRNOW.EQ.LTRPLU)GO TO 19
      IF(LTRNOW.EQ.LTRMIN)GO TO 18
C
C     CHECK FOR DIGIT
      DO 13 I=1,10
      IF(LTRNOW.NE.LTRDGT(I))GO TO 13
      GO TO(9,11,12,10,11,12,23),KIND
    9 KIND=2
      GO TO 11
   10 KIND=5
      GO TO 11
   11 IADDON=I-1
      IF(IMINUS.NE.0)IADDON=-IADDON
      IVALUE=(10*IVALUE)+IADDON
      AVALUE=IVALUE
      GO TO 7
   12 POWER=POWER/10.0
      ADDON=I-1
      IF(IMINUS.NE.0)ADDON=-ADDON
      AVALUE=AVALUE+(POWER*ADDON)
      GO TO 7
   13 CONTINUE
      GO TO 23
C
C     SPACE
   14 IF(KIND.NE.4)GO TO 22
      GO TO 7
C
C     PERIOD IN NUMBER
   15 IF(KIND.EQ.1)GO TO 16
      IF(KIND.EQ.2)GO TO 16
      IF(KIND.EQ.4)GO TO 17
      IF(KIND.EQ.5)GO TO 17
      GO TO 23
   16 KIND=3
      GO TO 7
   17 KIND=6
      GO TO 7
C
C     PLUS OR MINUS
   18 IMINUS=-1
   19 IF(KIND.EQ.1)GO TO 20
      IF(KIND.EQ.4)GO TO 21
      GO TO 23
   20 KIND=2
      GO TO 7
   21 KIND=5
      GO TO 7
C
C     CHECK FOR ANY ADDITIONAL ITEM TO RIGHT OF NUMBER
   22 LOCBFR=LOCBFR+1
      IF(LOCBFR.GT.LMTBFR)GO TO 24
      LTRNOW=LTRBFR(LOCBFR)
      IF(LTRNOW.EQ.LTRSPA)GO TO 22
      GO TO 23
C
C     ERROR
   23 KIND=8
   24 RETURN
      END
      SUBROUTINE GETTWO(JTTY,KNDANS,IALLOW,LMTBFR,KIND,
     1LETTER,IVALUE,AVALUE,MINBFR,MAXBFR,LTRBFR)
C     RENBR(/EVALUATE USER RESPONSE OF LETTER AND ARGUMENT)
C
C     Donald Barth, Yale School of Management
C
C     This program reads a command typed by the user.  This
C     command  can  consist  of  a  letter  or  of a letter
C     followed  by  an  argument.   The  type  of  argument
C     allowed  is  determined  by  the leading letter.  The
C     arguments can be integer numbers,  real  numbers,  an
C     arbitrary text string, or the words yes or no.
C
C     The following input arguments are returned unchanged
C
C     JTTY   = unit number from which to read text typed by
C              user
C     KNDANS = array dimensioned at 26 which specifies  the
C              type  of argument allowed for each letter of
C              alphabet
C            = 0, no argument allowed for this letter
C            = 1, integer number
C            = 2, real number.  This is a number which  can
C              include a fractional part to the right of an
C              optional period.
C            = 3, any alphameric string
C            = 4, the words yes or no
C     IALLOW = 0, evaluate leading letter and  a  following
C              argument of the type determined by the value
C              in  the  parallel  location  in  the  KNDANS
C              array.
C            = greater than 0, evaluate an  argument  only.
C              Do  not evaluate a leading letter.  The type
C              of argument accepted is that which would  be
C              allowed  by  the  same  value  in the KNDANS
C              array.
C            = 1, integer number
C            = 2, real number
C            = 3, any alphabetic
C            = 4, the words yes or no
C     LMTBFR = dimension of  LTRBFR  array.   This  is  the
C              maximum  number  of  characters which can be
C              evaluated in a single line typed by the user
C
C     The   following   output   arguments   are   returned
C     describing the response typed by the user
C
C     KIND   = returned describing type of response
C            = 1, empty line
C            = 2, letter without argument
C            = 3, argument only
C            = 4, letter with argument
C            = 5, question mark
C            = 6, letter and following question mark
C            = 7, unknown response
C     LETTER = returned containing position in alphabet  of
C              letter typed as command
C     IVALUE = returned   containing   value   of   integer
C              argument
C            = if yes or no are allowed as arguments,  then
C              1 = no
C              2 = yes
C     AVALUE = returned containing  value  of  real  number
C              argument
C     MINBFR = if an arbitrary alphameric string is allowed
C              as argument, MINBFR is subscript of leftmost
C              location in LTRBFR array returned containing
C              a character of the string.
C            = if question mark  is  typed,  returned  with
C              location  in  LTRBFR  array  of the question
C              mark.
C     MAXBFR = if an arbitrary alphameric string is allowed
C              as   argument,   MAXBFR   is   subscript  of
C              rightmost location in LTRBFR array  returned
C              containing a character of the string.
C     LTRBFR = array returned containing the text typed  by
C              the user.
C
      DIMENSION LTRDGT(10),LTRABC(26),LWRABC(26),
     1KNDANS(26),LTRYES(5),LWRYES(5),LNGYES(2)
      DIMENSION LTRBFR(LMTBFR)
C
      DATA LTRSPA,LTRDOT,LTRQUE,LTRMIN,LTRPLU/
     1 1H ,1H.,1H?,1H-,1H+/
      DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
C
C     WORDS YES AND NO
      DATA LTRYES/1HN,1HO,1HY,1HE,1HS/
      DATA LWRYES/1Hn,1Ho,1Hy,1He,1Hs/
      DATA LNGYES/2,3/
C
C     GET LINE TYPED BY USER
      READ(JTTY,1,END=33)LTRBFR
    1 FORMAT(80A1)
C
C     FIND FIRST AND LAST PRINTING CHARACTERS
      KIND=1
      MINBFR=0
    2 IF(MINBFR.GE.LMTBFR)GO TO 34
      MINBFR=MINBFR+1
      IF(LTRBFR(MINBFR).EQ.LTRSPA)GO TO 2
      MAXBFR=LMTBFR
    3 IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 4
      MAXBFR=MAXBFR-1
      GO TO 3
C
C     TEST IF A SINGLE CHARACTER ON LINE IS QUESTION MARK
    4 IF(MINBFR.LT.MAXBFR)GO TO 5
      IF(LTRBFR(MINBFR).EQ.LTRQUE)GO TO 31
    5 CONTINUE
C
C     IDENTIFY THE INITIAL LETTER
      IF(IALLOW.GT.0)GO TO 10
      LTRNOW=LTRBFR(MINBFR)
      DO 7 I=1,26
      IF(LTRNOW.EQ.LTRABC(I))GO TO 6
      IF(LTRNOW.EQ.LWRABC(I))GO TO 6
      GO TO 7
    6 LETTER=I
      KIND=2
      GO TO 8
    7 CONTINUE
      GO TO 33
C
C     FIND NEXT PRINTING CHARACTER AFTER INITIAL LETTER
    8 IF(MINBFR.GE.MAXBFR)GO TO 34
      MINBFR=MINBFR+1
      IF(LTRBFR(MINBFR).EQ.LTRSPA)GO TO 8
      IF(MINBFR.LT.MAXBFR)GO TO 9
      IF(LTRBFR(MINBFR).EQ.LTRQUE)GO TO 32
    9 CONTINUE
C
C     BRANCH TO CODE TO PROCESS ARGUMENT
      ITYPE=KNDANS(LETTER)
      GO TO 11
   10 ITYPE=IALLOW
   11 CONTINUE
      IF(ITYPE.EQ.0)GO TO 33
      GO TO(12,12,30,25),ITYPE
C
C     INITIALIZE
   12 IMINUS=0
      IDOT=0
      IVALUE=0
      AVALUE=0
      POWER=1.0
      GO TO 14
C
C     IDENTIFY THE NUMBER TO RIGHT OF LETTER OR BY ITSELF
   13 IF(MINBFR.GE.MAXBFR)GO TO 34
      MINBFR=MINBFR+1
   14 LTRNOW=LTRBFR(MINBFR)
C
C     CHECK FOR ALLOWED CHARACTERS OTHER THAN DIGITS
      IF(LTRNOW.EQ.LTRSPA)GO TO 33
      IF(LTRNOW.EQ.LTRDOT)GO TO 20
      IF(LTRNOW.EQ.LTRPLU)GO TO 24
      IF(LTRNOW.EQ.LTRMIN)GO TO 23
C
C     CHECK FOR DIGIT
      DO 19 I=1,10
      IF(LTRNOW.NE.LTRDGT(I))GO TO 19
      GO TO(15,15,16,16),KIND
   15 KIND=KIND+2
   16 IF(ITYPE.EQ.2)GO TO 17
      IADDON=I-1
      IF(IMINUS.NE.0)IADDON=-IADDON
      IVALUE=(10*IVALUE)+IADDON
      GO TO 13
   17 IF(IDOT.NE.0)GO TO 18
      ADDON=I-1
      IF(IMINUS.NE.0)ADDON=-ADDON
      AVALUE=(10.0*AVALUE)+ADDON
      GO TO 13
   18 POWER=POWER/10.0
      ADDON=I-1
      IF(IMINUS.NE.0)ADDON=-ADDON
      AVALUE=AVALUE+(POWER*ADDON)
      GO TO 13
   19 CONTINUE
      GO TO 33
C
C     PERIOD IN NUMBER
   20 IF(ITYPE.NE.2)GO TO 33
      IF(KIND.LE.2)GO TO 21
      IF(IDOT.NE.0)GO TO 33
      GO TO 22
   21 KIND=KIND+2
   22 IDOT=1
      GO TO 13
C
C     PLUS OR MINUS
   23 IMINUS=-1
   24 IF(KIND.GT.2)GO TO 33
      KIND=KIND+2
      GO TO 13
C
C     CHECK FOR WORDS YES OR NO
   25 MAXTST=0
      J=MAXBFR-MINBFR+1
      DO 29 I=1,2
      MINTST=MAXTST+1
      MAXTST=MAXTST+LNGYES(I)
      IF(LNGYES(I).LT.J)GO TO 29
      NOWBFR=MINBFR
      GO TO 27
   26 MINTST=MINTST+1
      NOWBFR=NOWBFR+1
   27 IF(MINTST.GT.MAXTST)GO TO 28
      IF(NOWBFR.GT.MAXBFR)GO TO 28
      IF(LTRBFR(NOWBFR).EQ.LTRYES(MINTST))GO TO 26
      IF(LTRBFR(NOWBFR).EQ.LWRYES(MINTST))GO TO 26
      GO TO 29
   28 KIND=KIND+2
      IVALUE=I
      GO TO 34
   29 CONTINUE
      GO TO 33
C
C     ANY FOLLOWING CHARACTERS ALLOWED
   30 KIND=KIND+2
      GO TO 34
C
C     QUESTION MARK TYPED
   31 KIND=5
      GO TO 34
   32 KIND=6
      GO TO 34
C
C     ERROR
   33 KIND=7
C
C     RETURN TO CALLING PROGRAM
   34 RETURN
      END