Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0169/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