Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0174/liball.for
There are 3 other files named liball.for in the archive. Click here to see a list.
SUBROUTINE RSMCHK(LTRWHO,LWRWHO,LMTWHO,IPRJCT,IPRGRM, IDISK,
1 IYEAR,ICHECK,IPRINT,JVIDEO,LTRBFR,LMTBFR,ITTY,NUMWHO)
C RENBR(/DETERMINE CLASS OF CURRENT USER)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C THIS ROUTINE MUST RECOGNIZE THE ACCOUNT NAMING
C CONVENTIONS FOR THE COMPUTER BEING USED.
C
C The student resume program and the administrator
C program can only be run from accounts which are
C specified in a validation file which resides in the
C resume storage area. The validation file is named
C RESUME.WHO and contains 1 line for each account, or
C for each group of accounts, from which the programs
C can be run. Lines are read from the validation file
C until a line is found which exactly specifies the
C account from which the program is being run or which
C specifies a group of accounts of which the current
C account is a member. The subsequent lines in the
C validation file are ignored even if they also specify
C the current account. It is thus possible to treat a
C few members of a group of accounts differently than
C the rest of the members of the group by inserting
C lines which specify the special accounts before the
C line which specifies the rest of the group of
C accounts.
C
C The following is a typical validation file.
C
C 1 0 0 2 <S.E.*> !EVEN NUMBER YEAR CLASS
C 2 0 0 2 <S.S.*> !ODD NUMBER YEAR CLASS
C 3 0 0 2 <S.G.*> !GRADUATE STUDENTS
C 4 0 0 2 <S.N.*> !NON-MAJORS
C -1 999 999 2 <S.P.ADMIN> !FORESTRY SCHOOL ADMINISTRA
C 999 1 0 2 <S.P.FORESTRY> !FORESTRY SCHOOL STUDENTS
C 998 1 1 2 <S.D.SMITH> !TESTING
C -3 0 999 2 <S.D.BARTH> !ADMINISTRATOR
C -2 0 999 2 <S.W.JONES> !WORD PROCESSING
C 0 0 0 2 <S.*> !ALL OTHERS
C =
C
C The general form of an entry in the RESUME.WHO file
C is
C NUMBER1 NUMBER2 NUMBER3 NUMBER4 <ACCOUNT.NAME>
C or if accounts are identified by project number and
C programmer number
C NUMBER1 NUMBER2 NUMBER3 NUMBER4 [PROJECT,PROGRAMMER]
C Where
C NUMBER1 -1 or less enables administrator functions
C =-3 allows all administrator funtions
C = -2 allows production of proofs and
C unsubmitting of submitted resumes
C = -1 allows editing of submitted resumes
C = 0 through 999 places account into class
C having this value
C = 1000 or greater prevents use of the student
C resume program
C NUMBER2 = for administrator is lowest class which can
C be processed
C = 0 for others indicates each user has own
C account
C = 1 for others indicates all users use same
C account and give passwords they select
C = 2 for others indicates all users use same
C account and give passwords assigned to them
C NUMBER3 = for administrator is highest class which
C can be processed
C = 0 for others indicates output will be on
C letter quality printer
C = 1 for others indicates ultimate output will
C be typeset
C NUMBER4 = 0, terminal used to run program types on
C paper
C = 1, video terminal which scrolls
C = 2, video terminal on which form feed clears
C screen
C
C Anything which appears to the right of an exclamation
C point is treated as a comment and is ignored. The
C end of the file is marked by a line which starts with
C an equal sign. The line which starts with an equal
C sign and all lines which follow the line which starts
C with an equal sign are ignored.
C
C The accounts which can be used to run the programs
C are specified by name on the DECsystem20. Account
C are arranged in a tree structure with periods
C separating the list of nodes. The account names
C which appear to the right of the numbers in the
C validation file should be preceded by a less than
C sign and followed by a greater than sign although any
C sequence of printing characters which does not start
C with a left square bracket is also taken to be an
C account name. An asterisk can be included at right
C end of the account name if any sequence of nodes is
C to be allowed starting at that point. A period can
C appear between the names of the nodes to the left and
C the asterisk but is not required. In order to be
C matched, the name of the account being used must
C include a node at the location of the asterisk. An
C account name consisting only of nodes to the left of
C the location of the asterisk will not be matched.
C For example
C
C 1 0 0 0 <*> !allows any account
C 1 0 0 0 <S.O> !allows <S.O> but not <S.O.SMITH>
C !or <S.O.JONES>
C 1 0 0 0 <S.O.*> !allows <S.O.SMITH> and
C !<S.O.JONES> but not <S.O>
C 1 0 0 0 <S.O*> !same as the above
C 1 0 0 0 <S.O.SMITH> !allows <S.O.SMITH> but not <S.O>
C !or <S.O.JONES>
C
C The accounts which can be used to run the program are
C specified by numbers on the DECsystem10. Each
C purpose for which the computer can be used is
C assigned a project number and these project numbers
C are paired with a programmer number which identifies
C a particular user. The project and programmer
C numbers are octal numbers, and never include either
C of the decimal digits 8 or 9. Accounts are specified
C in the validation file by a left square bracket,
C followed by the project number, a comma, the
C programmer number and a right square bracket. Spaces
C can appear on either side of the numbers and can
C replace the separating comma. A question mark can
C appear anywhere in either number where any digit is
C to be allowed. An asterisk can appear instead of a
C number if any number is to be allowed. A comma can
C separate the asterisk from the other number but is
C not necessary. For example,
C
C 1 0 0 0 [201,3556] !allows programmer 3556 to use
C !project 201
C 1 0 0 0 [*,3556] !allows programmer 3556 to use
C !any project
C 1 0 0 0 [*3556] !same as the above
C 1 0 0 0 [201,*] !allows any programmer to use
C !project 201
C 1 0 0 0 [?01,*] !allows any programmer to use
C !project 1 or 101 or 201 or 301
C !or 401 or 501 or 601 or 701
C 1 0 0 0 [?01*] !same as the above
C
C
C Description of the arguments of this routine
C
C LTRWHO = input containing the name of the account
C from which this proram is being run. The
C LTRWHO array should be defined as though
C read by a multiple of an A1 format. This
C will be matched against lines in the file
C which contain account names starting with
C less than signs. LTRWHO can start with a
C less than sign, but it is not necessary.
C LMTWHO = input containing the number of characters in
C the LTRWHO array. This number can include
C rightmost blanks.
C IPRJCT = input containing the DECsystem10 project
C number from which this program is being run.
C This will be matched against the first
C number to the right of a left square bracket
C in any line in the input file.
C IPRGRM = input containing the DECsystem10 programmer
C number from which this program is being run.
C This will be matched against the second
C number to the right of a left square bracket
C in any line in the input file.
C IDISK = input containing the number of the input
C device from which the input file is to be
C read.
C IYEAR = returned containing the class number
C = -3 all administrator functions are enabled
C = -2 can proof and unsubmit any submitted
C resume
C = -1 can edit any submitted resume
C = 0 through 999, returned with class number
C = 1000 if the user is not allowed to run the
C program
C ICHECK = returned indicating if the calling program
C must ask for a password
C = 0, do not require that the user supply a
C password
C = 1, require that the user supply a password
C = if IYEAR is -1 or less, then ICHECK is
C lowest class number which can be processed
C IPRINT = returned indicating if the final resume will
C be typeset
C = 0, the final resume will be typed on a
C letter quality terminal
C = 1, the final resume will be typeset
C = if IYEAR is -1 or less, then IPRINT is
C highest class number which can be processed
C JVIDEO = returned indicating the type of terminal
C which will be used
C = 0, terminal types onto paper
C = 1, scrolling video terminal which cannot
C clear screen when form feed is received
C = 2, scrolling video terminal which clears
C screen when form feed is received
C LTRBFR = array into which each line of the input file
C can be read
C
C UPPER CASE A-Z, LOWER CASE A-Z AND DIGITS 0-9
COMMON/RSMFIV/LTRABC(26),LWRABC(26),LTRDGT(10)
C
DIMENSION LTRWHO(LMTWHO),LWRWHO(LMTWHO),LTRBFR(LMTBFR)
C
C LTRSTA = THE ASTERISK CHARACTER
C LTRQUE = THE PERCENT SIGN CHARACTER
C LTRMIN = THE MINUS SIGN CHARACTER
C LTRPLU = THE PLUS SIGN CHARACTER
C LTREQU = THE EQUAL SIGN CHARACTER
C LTRSPA = THE SPACE CHARACTER
C LTREXC = THE EXCLAMATION MARK CHARACTER
C LTRLTS = THE LESS THAN SIGN CHARACTER
C LTRGTS = THE GREATER THAN SIGN CHARACTER
C LTRLSB = THE LEFT SQUARE BRACKET CHARACTER
C LTRRSB = THE RIGHT SQUARE BRACKET CHARACTER
C LTRCOM = THE COMMA CHARACTER
C LTRDOT = THE PERIOD
C
DATA LTRSTA,LTRQUE,LTRMIN,LTRPLU,LTREQU,LTRSPA,LTREXC,
1 LTRLTS,LTRGTS,LTRLSB,LTRRSB,LTRCOM,LTRDOT/
2 1H*,1H?,1H-,1H+,1H=,1H ,1H!,1H<,1H>,1H[,1H],1H,,1H./
C
C GET LOWER CASE FORMS OF LETTERS IN ACCOUNT NAME
IF(LMTWHO.LE.0)GO TO 4
DO 3 I=1,LMTWHO
LTRNOW=LTRWHO(I)
LWRWHO(I)=LTRNOW
IF(LTRNOW.EQ.LTRSPA)GO TO 3
DO 2 J=1,26
IF(LTRNOW.EQ.LTRABC(J))GO TO 1
IF(LTRNOW.EQ.LWRABC(J))GO TO 1
GO TO 2
1 LTRWHO(I)=LTRABC(J)
LWRWHO(I)=LWRABC(J)
GO TO 3
2 CONTINUE
3 CONTINUE
4 CONTINUE
C
C OPEN THE FILE DESCRIBING KNOWN ACCOUNTS
CALL RSMOPN(1,NUMWHO,IYEAR,ITTY,IDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 32
C
C READ NEXT LINE FROM INPUT FILE
5 READ(IDISK,6,END=33)LTRBFR
6 FORMAT(80A1)
C
C CYCLE THROUGH THE 4 NUMBERS AT START OF LINE
IFIRST=0
DO 12 IPASS=1,4
C
C GET NEXT PRINTING CHARACTER IN LINE
7 IFIRST=IFIRST+1
IF(IFIRST.GT.LMTBFR)GO TO 5
LTRNOW=LTRBFR(IFIRST)
IF(LTRNOW.EQ.LTRSPA)GO TO 7
IF(LTRNOW.EQ.LTREXC)GO TO 5
IF(LTRNOW.EQ.LTREQU)GO TO 33
MINUS=0
IF(LTRNOW.EQ.LTRPLU)GO TO 8
IF(LTRNOW.NE.LTRMIN)GO TO 9
MINUS=1
8 IFIRST=IFIRST+1
C
C EVALUATE NUMBER
9 IVALUE=0
10 IF(IFIRST.GT.LMTBFR)GO TO 5
LTRNOW=LTRBFR(IFIRST)
DO 11 I=1,10
IF(LTRNOW.NE.LTRDGT(I))GO TO 11
IVALUE=(10*IVALUE)+I-1
IFIRST=IFIRST+1
GO TO 10
11 CONTINUE
IFIRST=IFIRST-1
IF(MINUS.NE.0)IVALUE=-IVALUE
C
C STORE NUMBER IN PROPER SLOT
IF(IPASS.EQ.1)IYEAR=IVALUE
IF(IPASS.EQ.2)ICHECK=IVALUE
IF(IPASS.EQ.3)IPRINT=IVALUE
IF(IPASS.EQ.4)JVIDEO=IVALUE
12 CONTINUE
C
C LOOK FOR NEXT PRINTING CHARACTER
13 IFIRST=IFIRST+1
IF(IFIRST.GT.LMTBFR)GO TO 5
LTRNOW=LTRBFR(IFIRST)
IF(LTRNOW.EQ.LTRSPA)GO TO 13
IF(LTRNOW.EQ.LTRLTS)GO TO 25
IF(LTRNOW.EQ.LTRLSB)GO TO 14
GO TO 24
C
C *****************************************************
C * *
C * COMPARE PAIR OF NUMBERS BETWEEN SQUARE BRACKETS *
C * *
C *****************************************************
C
14 IPASS=1
15 IFIRST=IFIRST+1
IF(IFIRST.GT.LMTBFR)GO TO 5
LTRNOW=LTRBFR(IFIRST)
IF(LTRNOW.EQ.LTREXC)GO TO 5
IF(LTRNOW.EQ.LTRRSB)GO TO 5
IF(LTRNOW.EQ.LTRSPA)GO TO 15
IF(LTRNOW.EQ.LTRSTA)GO TO 19
IFINAL=IFIRST
16 IFINAL=IFINAL+1
IF(IFINAL.GT.LMTBFR)GO TO 17
LTRNOW=LTRBFR(IFINAL)
IF(LTRNOW.EQ.LTREXC)GO TO 17
IF(LTRNOW.EQ.LTRRSB)GO TO 17
IF(LTRNOW.EQ.LTRSPA)GO TO 17
IF(LTRNOW.EQ.LTRCOM)GO TO 17
IF(LTRNOW.EQ.LTRSTA)GO TO 17
GO TO 16
17 NUMBER=IPRJCT
IF(IPASS.EQ.2)NUMBER=IPRGRM
JFINAL=IFINAL
18 JFINAL=JFINAL-1
IF(JFINAL.LT.IFIRST)GO TO 20
MATCH=NUMBER
NUMBER=NUMBER/8
MATCH=MATCH-(8*NUMBER)
LTRNOW=LTRBFR(JFINAL)
IF(LTRNOW.EQ.LTRQUE)GO TO 18
IF(LTRNOW.EQ.LTRDGT(MATCH+1))GO TO 18
GO TO 5
19 IFINAL=IFIRST+1
GO TO 21
20 IF(NUMBER.NE.0)GO TO 5
21 IFINAL=IFINAL-1
IF(IPASS.EQ.2)GO TO 34
IPASS=2
22 IFINAL=IFINAL+1
IF(IFINAL.GT.LMTBFR)GO TO 5
LTRNOW=LTRBFR(IFINAL)
IF(LTRNOW.EQ.LTREXC)GO TO 5
IF(LTRNOW.EQ.LTRRSB)GO TO 5
IF(LTRNOW.EQ.LTRSPA)GO TO 22
IF(LTRNOW.EQ.LTRCOM)GO TO 23
IFIRST=IFINAL-1
GO TO 15
23 IFIRST=IFINAL
GO TO 15
C
C *****************************************************
C * *
C * ACCOUNT NAME BETWEEN LESS THAN AND GREATER THAN *
C * *
C *****************************************************
C
C GET NEXT CHARACTERS FROM LOCAL NAME AND FILE
24 IFIRST=IFIRST-1
25 IF(LMTWHO.LE.0)GO TO 5
JFIRST=0
IF(LTRWHO(1).EQ.LTRLTS)JFIRST=1
26 INODE=1
GO TO 28
27 INODE=0
28 IFIRST=IFIRST+1
JFIRST=JFIRST+1
IF(IFIRST.GT.LMTBFR)GO TO 30
LTRGBL=LTRBFR(IFIRST)
IF(LTRGBL.EQ.LTREXC)GO TO 30
IF(LTRGBL.EQ.LTRSPA)GO TO 30
IF(LTRGBL.EQ.LTRGTS)GO TO 30
IF(JFIRST.GT.LMTWHO)GO TO 5
LTRLCL=LTRWHO(JFIRST)
IF(LTRLCL.EQ.LTREXC)GO TO 5
IF(LTRLCL.EQ.LTRSPA)GO TO 5
IF(LTRLCL.EQ.LTRGTS)GO TO 5
IF(LTRGBL.EQ.LTRSTA)GO TO 31
IF(LTRGBL.EQ.LTRLCL)GO TO 29
IF(LTRGBL.EQ.LWRWHO(JFIRST))GO TO 29
GO TO 5
29 IF(LTRGBL.NE.LTRDOT)GO TO 27
GO TO 26
C
C END OF LINE REACHED IN FILE
30 IF(JFIRST.GT.LMTWHO)GO TO 34
LTRLCL=LTRWHO(JFIRST)
IF(LTRLCL.EQ.LTREXC)GO TO 34
IF(LTRLCL.EQ.LTRSPA)GO TO 34
IF(LTRLCL.EQ.LTRGTS)GO TO 34
GO TO 5
C
C ASTERISK FOUND IN FILE
31 IF(INODE.NE.0)GO TO 34
IF(LTRLCL.NE.LTRDOT)GO TO 5
GO TO 34
C
C RETURN TO CALLING PROGRAM
32 IYEAR=1000
GO TO 35
33 IYEAR=1000
34 CALL RSMCLS(1,NUMWHO,IYEAR,ITTY,IDISK,IFCLOS)
35 RETURN
END
SUBROUTINE PASWRD(LTRPSW,LMTPSW,ITTY,LNGPSW,NUMWHO,
1LTRBFR,LMTBFR)
C RENBR(/GET PASSWORD AND CONVERT TO NUMBER)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C LTRPSW = ARRAY RETURNED CONTAINING PASSWORD
C LMTPSW = DIMENSION OF LTRPSW
C ITTY = UNIT FROM WHICH MESSAGE IS READ
C LNGPSW = RETURNED WITH NUMBER OF CHARACTERS IN PASSWORD
C NUMWHO = RETURNED WITH NUMBER BASED ON PASSWORD
C = -1 RETURNED IF HELP MESSAGE NEEDED
C LTRBFR = ARRAY USED TO READ IN PASSWORD. SHOULD BE LONGER
C THAN LTRPSW SO OVERFLOW OF LTRPSW CAN BE SENSED.
C LMTBFR = DIMENSION OF LTRBFR
C
C UPPER CASE A-Z, LOWER CASE A-Z AND DIGITS 0-9
COMMON/RSMFIV/LTRABC(26),LWRABC(26),LTRDGT(10)
C
DIMENSION LTRPSW(LMTPSW),
1LTRBFR(LMTBFR)
DATA LTRSPA /1H /
C
C LMTVAL = 1 MORE THAN MAXIMUM VALUE OF NUMBER WHICH CAN
C BE RETURNED BASED UPON PASSWORD
DATA LMTVAL/1000000/
C
C ASK USER FOR PASSWORD
1 WRITE(ITTY,2)
2 FORMAT(' Password? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 19
IF(MAXBFR.EQ.0)GO TO 17
C
C CONVERT THE PASSWORD INTO A 6 DIGIT DECIMAL NUMBER.
C THE WORD IS TREATED ESSENTIALLY AS A RADIX 37 NUMBER.
C THE SPACES BETWEEN WORDS HAVE THE VALUE ZERO.
C THE LETTERS A THROUGH Z HAVE VALUES 1 THROUGH 26.
C THE DIGITS 0 THROUGH 9 HAVE VALUES 27 THROUGH 36
C
C WORD VALUE WORD VALUE
C A 1 A A 1370
C
C 9 36 A 9 1405
C AA 38 AAA 1407
C
C A9 73 A99 2737
C BA 75 B A 2739
C
C B9 110 B 9 2774
C
C WORDS ARE ALSO SHIFTED TO LEFT AND CAPITALIZED
C
NUMWHO=0
LNGPSW=0
IBLANK=-1
DO 11 IOUTER=1,MAXBFR
LTRNOW=LTRBFR(IOUTER)
IF(LTRNOW.EQ.LTRSPA)GO TO 10
C
C CHECK FOR DIGITS
DO 3 INNER=1,10
IF(LTRNOW.NE.LTRDGT(INNER))GO TO 3
NEXT=INNER+26
GO TO 6
3 CONTINUE
C
C CHECK FOR UPPER CASE LETTERS
DO 4 INNER=1,26
IF(LTRNOW.NE.LTRABC(INNER))GO TO 4
NEXT=INNER
GO TO 6
4 CONTINUE
C
C CHECK FOR LOWER CASE LETTERS
DO 5 INNER=1,26
IF(LTRNOW.NE.LWRABC(INNER))GO TO 5
LTRNOW=LTRABC(INNER)
NEXT=INNER
GO TO 6
5 CONTINUE
C
C NO MATCH FOUND
GO TO 13
C
C INSERT THE VALUE OF CHARACTER INTO PASSWORD NUMBER
6 IF(IBLANK.LE.0)GO TO 7
NUMWHO=37*NUMWHO
GO TO 8
7 IBLANK=0
NUMWHO=(37*NUMWHO)+NEXT
8 IF(LNGPSW.GE.LMTPSW)GO TO 15
NUMWHO=NUMWHO-LMTVAL*(NUMWHO/LMTVAL)
IF(IBLANK.EQ.0)GO TO 9
LNGPSW=LNGPSW+1
LTRPSW(LNGPSW)=LTRSPA
GO TO 7
9 LNGPSW=LNGPSW+1
LTRPSW(LNGPSW)=LTRNOW
GO TO 11
C
C BLANK FOUND
10 IF(IBLANK.EQ.0)IBLANK=1
11 CONTINUE
C
C FILL REST OF ARRAY WITH SPACES
I=LNGPSW
12 I=I+1
IF(I.GT.LMTPSW)GO TO 20
LTRPSW(I)=LTRSPA
GO TO 12
C
C ERROR MESSAGE AND HELP MESSAGE
13 WRITE(ITTY,14)LTRNOW
14 FORMAT(' Password contains illegal character ',1A1/
1' Use only letters A through Z, digits 0 through 9 and spaces')
GO TO 1
15 WRITE(ITTY,16)LMTPSW
16 FORMAT(' Password cannot be longer than',1I3,' characters')
GO TO 1
17 WRITE(ITTY,18)
18 FORMAT(' Password must be supplied'/' Type ? for help')
GO TO 1
C
C MAIN PROGRAM MUST SUPPLY HELP MESSAGE
19 NUMWHO=-1
20 RETURN
END
SUBROUTINE RSMOLD(IVERSN,NOWSEC,IDISK,LTRTXT,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL)
C RENBR(/RESTORE CONTENTS OF OLD RESUME)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN),LNGSEC(LMTSEC),
1MARKER(LMTLIN),LTRTTL(LMTLTT),KNTTTL(LMTSEC),LTRBFR(80)
DATA LMTBFR/80/
C
C FIRST LINE OF INPUT FILE WILL START NEW SECTION
ISECTN=0
IF(IVERSN.EQ.0)ISECTN=1
C
C GET NEXT UNUSED LINE NUMBER
NOWLIN=0
IF(KNTLIN.LE.0)GO TO 2
DO 1 I=1,KNTLIN
IF(NOWLIN.LT.MARKER(I))NOWLIN=MARKER(I)
1 CONTINUE
2 CONTINUE
C
C READ NEXT LINE
3 READ(IDISK,4,END=14)LTRBFR
4 FORMAT(500A1)
MINBFR=1
MAXBFR=LMTBFR+1
5 MAXBFR=MAXBFR-1
IF(MAXBFR.LE.0)GO TO 8
IF(LTRBFR(MAXBFR).EQ.1H )GO TO 5
6 IF(LTRBFR(MINBFR).NE.1H )GO TO 7
MINBFR=MINBFR+1
GO TO 6
7 IF(MAXBFR.GT.1)GO TO 8
IF(LTRBFR(1).EQ.1H=)GO TO 14
IF(LTRBFR(1).EQ.1H-)GO TO 11
C
C NORMAL LINE
8 IF(ISECTN.NE.0)GO TO 12
IF(MAXBFR.LE.0)GO TO 3
NOWLIN=NOWLIN+1
KNTLIN=KNTLIN+1
LNGLIN(KNTLIN)=MAXBFR-MINBFR+1
MARKER(KNTLIN)=NOWLIN
LNGSEC(MAXSEC)=LNGSEC(MAXSEC)+1
IF(MAXBFR.LE.0)GO TO 10
DO 9 I=MINBFR,MAXBFR
KNTTXT=KNTTXT+1
LTRTXT(KNTTXT)=LTRBFR(I)
9 CONTINUE
10 GO TO 3
C
C NEXT LINE IS START OF NEW SECTION
11 ISECTN=1
GO TO 3
C
C START OF NEW SECTION
12 IF(MAXBFR.LE.0)GO TO 3
ISECTN=0
MAXSEC=MAXSEC+1
KNTTTL(MAXSEC)=MAXBFR-MINBFR+1
LNGSEC(MAXSEC)=1
KNTLIN=KNTLIN+1
LNGLIN(KNTLIN)=0
MARKER(KNTLIN)=0
IF(MAXBFR.LE.0)GO TO 3
DO 13 I=MINBFR,MAXBFR
MAXLTT=MAXLTT+1
LTRTTL(MAXLTT)=LTRBFR(I)
13 CONTINUE
GO TO 3
C
C RETURN TO CALLING PROGRAM
14 RETURN
END
SUBROUTINE RSMPRF(NOWSEC,ILOCAL,ITTY,IDISK,LTRTXT,LNGLIN,
1LNGSEC,LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL,KNTOUT,IVARY,JVARY,
3KVARY,LVARY,MVARY,LTRWID,LMTWID,MAXBFR,LMTBFR,LTRBFR,IVIDEO,
4LNGCRT,KNTPAG,IONPAG)
C RENBR(/WRITE FORMATTED RESUME TO FILE OR TERMINAL)
C
C DONALD BARTH,YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C ILOCAL = -1, NO OUTPUT. ONLY COUNT LINES
C = 0, OUTPUT IS TO DISK FILE ON UNIT IDISK
C = 1, OUTPUT IS TO TERMINAL ON UNIT ITTY
C IVARY = 0, DO NOT DIVIDE LONG RESUME INTO PAGES
C = 1, DIVIDE LONG RESUME INTO PAGES.
C VALUE OF IVARY IS LENGTH OF PAGE.
C JVARY = 1, NO UNDERLINING NOR BOLDING
C = 2, UNDERLINING AND BOLDING FOR PRINTER
C SINGLE STRIKE OF UNDERLINING
C TWO STRIKES FOR BOLDING
C = 3, UNDERLINING AND BOLDING FOR DIABLO
C OFFSET 1/120 INCH BEFORE 2ND STRIKE FOR BOLDING
C FOUR STRIKES FOR BOLDING AND UNDERLINING
C KVARY = 1, NARROW 80 COLUMN WIDTH
C NO INDENTATION OF NAME AND ADDRESS
C = 2, DIABLO 87 COLUMN WIDTH
C 20 COLUMN INDENTATION OF NAME AND ADDRESS
C = 3, TYPESET LINE WIDTH. NUMBER OF CHARACTERS ON
C LINE DEPENDS UPON WHAT CHARACTERS ARE IN LINE.
C 20 COLUMN INDENTATION OF NAME AND ADDRESS.
C ** EQUIVALENT TO SINGLE SPACE
C = 4, UNLIMITED LENGTH OF LINE
C NO INDENTATION OF NAME AND ADDRESS
C ** EQUIVALENT TO SINGLE SPACE
C NO MULTIPLE SPACES
C WORD RULE IN PLACE OF RULE OF REPEATED CHARACTERS
C LVARY = 1, 2 LINES FOR THE RULES, FIRST HAS
C UNDERSCORES, SECOND IS EMPTY
C = 2, 3 LINES FOR THE RULES, FIRST AND
C THIRD EMPTY, SECOND HAS HYPHENS
C MVARY = -1, USE PLUS AS CARRIAGE CONTROL BEFORE FIRST LINE.
C THIS SUPPRESSES THE LINE FEED BEFORE FIRST LINE.
C = 0, USE SPACE AS CARRIAGE CONTROL BEFORE FIRST LINE.
C THIS GIVE LINE FEED BEFORE FIRST LINE.
C = 1, USE ONE AS CARRIAGE CONTROL BEFORE FIRST LINE.
C THIS GIVES A NEW PAGE.
C
C KNTOUT = RETURNED WITH NUMBER LINES IN RESUME
C
C CHARACTERS FOR WHICH TYPESET WIDTHS ARE AVAILABLE
COMMON/RSMONE/LTRTYP(76)
C
C PROPORTIONAL WIDTHS OF TYPESET CHARACTERS
COMMON/RSMTWO/MAXTYP,LNGTYP(76),LNGSPA,LNGBUL,LNGODD,LNGGAP,
1ITSWID,ITSHIH
C
C CHARACTERS TO SHIFT DIABLO TYPING 1/120 INCH FOR BOLDING
COMMON/RSMTHR/LTRDRK(7)
C
C OTHER DIMENSION INFORMATION
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN),LNGSEC(LMTSEC),
1MARKER(LMTLIN),LTRTTL(LMTLTT),KNTTTL(LMTSEC),LTRWID(LMTWID),
2LTRBFR(LMTBFR)
DIMENSION LTR2ND(200)
C
C RESERVED NAMES OF SECTIONS
DIMENSION LTRNAM(18),LWRNAM(18),LMTNAM(3)
DATA LTRNAM/1HN,1HA,1HM,1HE,
1 1HL,1HO,1HC,1HA,1HL,
2 1HP,1HE,1HR,1HM,1HA,1HN,1HE,1HN,1HT/
DATA LWRNAM/1Hn,1Ha,1Hm,1He,
1 1Hl,1Ho,1Hc,1Ha,1Hl,
2 1Hp,1He,1Hr,1Hm,1Ha,1Hn,1He,1Hn,1Ht/
DATA LMTNAM/4,5,9/
C
C IPRINT = 0, NOTHING YET ON LINE TO RIGHT OF MARGIN
C = 1, AT LEAST 1 WORD HAS BEEN TO RIGHT OF MARGIN
C IBLANK = -1, LOCATION OF A WORD SPLIT HAS BEEN STORED
C = 0, BEFORE OR IN FIRST WORD ON OUTPUT LINE
C = 1, A BLANK HAS BEEN FOUND AFTER A WORD ALREADY
C ON LINE. BLANK MUST BE INSERTED IF THERE IS
C ANYTHING ELSE THAT NEEDS TO GO ON LINE.
C IBULLT = -1, IF A BULLET APPEARS IN LINE DO NOT FLUSH OUT
C THE CURRENT CONTENTS OF LINE FIRST.
C = 0, IF BULLET APPEARS IN LINE, FLUSH CONTENTS
C OF THE OUTPUT LINE FIRST.
C = 1, WITHIN A BULLETED ITEM
C
C LMT2ND = DIMENSION OF LTR2ND ARRAY USED FOR UNDERLINE AND BOLD
DATA LMT2ND/200/
C
C LTRSPA = THE SPACE CHARACTER
C LTRSTA = THE ASTERISK, USED TO INDICATE NEW LINE IN OUTPUT
C LTRBUL = THE CHARACTER USED AS BULLET IN OUTPUT
C LTRMIN = THE MINUS SIGN, USED TO INDICATE LINE TO BEAR BULLET
C LTRUND = THE CHARACTER USED TO MARK UNDERLINED WORDS
C LTRUPA = THE CHARACTER USED TO MARK BOLDFACED WORDS
C LTRMID = THE CHARACTER USED TO RULE LINE AT MID LETTER HEIGHT
C LTRLOW = THE CHARACTER USED TO RULE LINE AT BOTTOM OF LETTER HEIGH
C
DATA LTRSPA,LTRSTA,LTRBUL,LTRMIN,LTRUND,LTRUPA,LTRMID,LTRLOW/
11H ,1H*,1H-,1H-,1H_,1H^,1H-,1H_/
C
C USER HAS NOT YET TYPED ANYTHING AT BOTTOM OF SCREEN
MAXBFR=0
C
C MAXRUL = NUMBER OF MINUS SIGNS TO RULE BETWEEN SECTIONS
MAXRUL=80
IF(KVARY.EQ.1)MAXRUL=80
IF(KVARY.EQ.2)MAXRUL=87
IF(KVARY.EQ.3)MAXRUL=105
IF(KVARY.EQ.4)MAXRUL=87
C
C LTRRUL = CHARACTER USED TO RULE BETWEEN SECTIONS
LTRRUL=LTRMID
IF(LVARY.EQ.1)LTRRUL=LTRLOW
IF(LVARY.EQ.2)LTRRUL=LTRMID
C
C MAXOUT = MAXIMUM NUMBER OF CHARACTERS IN AN OUTPUT LINE
MAXOUT=80
IF(KVARY.EQ.1)MAXOUT=80
IF(KVARY.EQ.2)MAXOUT=87
IF(KVARY.EQ.3)MAXOUT=LMTWID
IF(KVARY.EQ.4)MAXOUT=LMTWID
C
C IFRULE = -1, BEFORE FIRST SECTION
C = 0, BETWEEN SECTIONS
C = 1, INSIDE SECTION
IFRULE=-1
C
C INDICATE THAT SCREEN IS INITIALLY EMPTY
KNTOUT=0
IONPAG=0
KNTPAG=1
ISHOWN=0
C
C *******************************************
C * *
C * LOCATE SECTIONS HAVING RESERVED NAMES *
C * *
C *******************************************
C
MAXPRT=0
MRKSEC=0
LOCONE=0
LOCTWO=0
LOCTHR=0
NOWLIN=0
DO 16 NEWSEC=1,MAXSEC
INISEC=MRKSEC+1
MRKSEC=MRKSEC+KNTTTL(NEWSEC)
MAXLIN=LNGSEC(NEWSEC)
IF(MAXLIN.LE.0)GO TO 9
C
C CHECK IF THE NAME IS ONE OF THOSE RESERVED
K=0
DO 2 INAME=1,3
J=K
K=K+LMTNAM(INAME)
IF((MRKSEC-INISEC+1).NE.LMTNAM(INAME))GO TO 2
DO 1 I=INISEC,MRKSEC
J=J+1
IF(LTRTTL(I).EQ.LTRNAM(J))GO TO 1
IF(LTRTTL(I).EQ.LWRNAM(J))GO TO 1
GO TO 2
1 CONTINUE
JNAME=INAME
GO TO 5
2 CONTINUE
C
C SKIP OVER LINES OF SECTION NOT HAVING RESERVED NAME
IF(MAXLIN.EQ.0)GO TO 4
DO 3 I=1,MAXLIN
NOWLIN=NOWLIN+1
MAXPRT=MAXPRT+LNGLIN(NOWLIN)
3 CONTINUE
4 GO TO 16
C
C STORE INFORMATION ABOUT NAME AND ADDRESS SECTIONS
5 GO TO(6,7,8),JNAME
6 LOCONE=NEWSEC
NAMONE=INISEC
LINONE=NOWLIN
INIONE=MAXPRT
GO TO 9
7 LOCTWO=NEWSEC
NAMTWO=INISEC
LINTWO=NOWLIN
INITWO=MAXPRT
GO TO 9
8 LOCTHR=NEWSEC
NAMTHR=INISEC
LINTHR=NOWLIN
INITHR=MAXPRT
GO TO 9
C
C GET WIDTH OF LONGEST LINE IN THIS SECTION
9 MAXWID=0
NEWLIN=0
10 IF(NEWLIN.GE.MAXLIN)GO TO 12
NEWLIN=NEWLIN+1
NOWLIN=NOWLIN+1
MINPRT=MAXPRT+1
MAXPRT=MAXPRT+LNGLIN(NOWLIN)
MAXSHO=0
MINCPY=MINPRT
MAXCPY=MAXPRT
LOCSHO=5
GO TO 37
11 IF(MAXWID.LT.MAXSHO)MAXWID=MAXSHO
GO TO 10
12 CONTINUE
C
C STORE WIDTH OF LONGEST SECTION
GO TO(13,14,15),JNAME
13 MAXONE=MAXWID
IF(MAXONE.EQ.0)LOCONE=0
GO TO 16
14 MAXTWO=MAXWID
IF(MAXTWO.EQ.0)LOCTWO=0
GO TO 16
15 MAXTHR=MAXWID
IF(MAXTHR.EQ.0)LOCTHR=0
GO TO 16
16 CONTINUE
C
C EXCHANGE ADDRESSES IF THERE IS ONLY A RIGHT ADDRESS
IF(LOCTWO.NE.0)GO TO 17
IF(LOCTHR.EQ.0)GO TO 17
LOCTWO=LOCTHR
NAMTWO=NAMTHR
LINTWO=LINTHR
INITWO=INITHR
MAXTWO=MAXTHR
LOCTHR=0
17 CONTINUE
C
C MARGIN TO LEFT OF NAME AND ADDRESS SECTIONS
MRGLFT=0
IF(KVARY.EQ.1)MRGLFT=0
IF(KVARY.EQ.2)MRGLFT=20
IF(KVARY.EQ.3)MRGLFT=20
IF(KVARY.EQ.4)MRGLFT=0
C
C ************************
C * *
C * PRINT NAME SECTION *
C * *
C ************************
C
IF(NOWSEC.EQ.0)GO TO 18
IF(NOWSEC.EQ.LOCONE)GO TO 18
IF(NOWSEC.EQ.LOCTWO)GO TO 18
IF(NOWSEC.EQ.LOCTHR)GO TO 18
GO TO 36
18 IF(LOCONE.EQ.0)GO TO 23
C
C SET INITIAL CONDITIONS FOR LINE
IRIGHT=0
JUNDER=0
MAXPRT=INIONE
NOWLIN=LINONE
NEWLIN=0
MAXLIN=LNGSEC(LOCONE)
C
C GET NEXT LINE IN NAME SECTION
19 NEWLIN=NEWLIN+1
IF(NEWLIN.GT.MAXLIN)GO TO 23
NOWLIN=NOWLIN+1
MINPRT=MAXPRT+1
MAXPRT=MAXPRT+LNGLIN(NOWLIN)
IF(MINPRT.GT.MAXPRT)GO TO 19
C
C SHIFT NAME TO RIGHT
MAXSHO=0
IF(MRGLFT.EQ.0)GO TO 21
DO 20 I=1,MRGLFT
IF(MAXSHO.GT.MAXOUT)GO TO 22
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRSPA
20 CONTINUE
21 CONTINUE
C
C INSERT LETTERS OF NAME
MINCPY=MINPRT
MAXCPY=MAXPRT
LOCSHO=1
GO TO 37
22 IF(MAXSHO.LE.MRGLFT)GO TO 19
MODIFY=1
JDOUBL=1
LOCSHO=6
GO TO 109
23 CONTINUE
C
C ***************************
C * *
C * PRINT ADDRESS SECTION *
C * *
C ***************************
C
IF(LOCTWO.NE.0)GO TO 24
IF(LOCTHR.NE.0)GO TO 24
GO TO 36
24 CONTINUE
C
C SET LEFT MARGIN FOR RIGHT ADDRESS
MRGRIT=MRGLFT+40
IF(LOCTHR.EQ.0)MAXTHR=0
IF(MRGRIT.GT.(MAXOUT-MAXTHR))MRGRIT=MAXOUT-MAXTHR
C
C SET POINTERS FOR START OF EACH ADDRESS
MAXPRT=INITWO
NOWLIN=LINTWO
MAXLIN=LNGSEC(LOCTWO)
MSTLIN=MAXLIN
IF(LOCTHR.EQ.0)GO TO 25
IAXPRT=INITHR
IOWLIN=LINTHR
IAXLIN=LNGSEC(LOCTHR)
IF(MSTLIN.LT.IAXLIN)MSTLIN=IAXLIN
GO TO 26
25 IAXPRT=0
IOWLIN=0
IAXLIN=0
26 IF(MSTLIN.LE.0)GO TO 36
C
C SET INITIAL CONDITIONS FOR LINE
MODIFY=0
JDOUBL=0
IRIGHT=0
JUNDER=0
NEWLIN=0
C
C BLANK LINE IF BOTH NAME AND ADDRESS SECTIONS
MAXSHO=0
LOCSHO=7
IF(IFRULE.GT.0)GO TO 109
C
C GET NEXT LINE IN ADDRESS
27 NEWLIN=NEWLIN+1
IF(NEWLIN.GT.MSTLIN)GO TO 36
NOWLIN=NOWLIN+1
MINPRT=MAXPRT+1
IF(NEWLIN.GT.MAXLIN)GO TO 28
MAXPRT=MAXPRT+LNGLIN(NOWLIN)
28 IOWLIN=IOWLIN+1
IINPRT=IAXPRT+1
IF(NEWLIN.GT.IAXLIN)GO TO 29
IAXPRT=IAXPRT+LNGLIN(IOWLIN)
29 I=MAXPRT-MINPRT+IAXPRT-IINPRT+2
IF(I.EQ.0)GO TO 27
C
C OFFSET THE LEFT ADDRESS
MAXSHO=0
IF(MRGLFT.EQ.0)GO TO 31
DO 30 I=1,MRGLFT
IF(MAXSHO.GT.MAXOUT)GO TO 31
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRSPA
30 CONTINUE
31 CONTINUE
C
C INSERT LEFT ADDRESS
IF(MINPRT.GT.MAXPRT)GO TO 32
MINCPY=MINPRT
MAXCPY=MAXPRT
LOCSHO=2
GO TO 37
C
C INSERT SEPARATION BETWEEN LEFT AND RIGHT ADDRESSES
32 IF(IINPRT.GT.IAXPRT)GO TO 35
33 IF(MAXSHO.GE.MAXOUT)GO TO 35
IF(MAXSHO.GE.MRGRIT)GO TO 34
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRSPA
GO TO 33
C
C INSERT RIGHT ADDRESS
34 MINCPY=IINPRT
MAXCPY=IAXPRT
LOCSHO=3
GO TO 37
35 LOCSHO=7
GO TO 109
36 CONTINUE
GO TO 44
C
C ************************************************
C * *
C * COPY SECTIONS WHICH ARE NOT WRAPPED AROUND *
C * *
C ************************************************
C
37 JBLANK=-1
DO 42 I=MINCPY,MAXCPY
IF(LOCSHO.EQ.4)GO TO 38
LTRNOW=LTRTXT(I)
GO TO 39
38 LTRNOW=LTRTTL(I)
39 IF(LTRNOW.EQ.LTRSPA)GO TO 41
IF(LTRNOW.EQ.LTRSTA)GO TO 42
IF(LTRNOW.EQ.LTRUPA)GO TO 42
IF(LTRNOW.EQ.LTRUND)GO TO 42
IF(JBLANK.LE.0)GO TO 40
IF(MAXSHO.GE.MAXOUT)GO TO 43
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRSPA
40 JBLANK=0
IF(MAXSHO.GE.MAXOUT)GO TO 43
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRNOW
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRNOW
GO TO 42
41 IF(JBLANK.EQ.0)JBLANK=1
42 CONTINUE
43 GO TO(22,32,35,49,11),LOCSHO
C
C **********************************************
C * *
C * PRINT SECTIONS NOT HAVING RESERVED NAMES *
C * *
C **********************************************
C
C SET COUNTS FOR DISPLAY OF NORMAL SECTIONS
44 MAXPRT=0
NOWLIN=0
KNTPRT=0
MRKSEC=0
MRGLFT=20
C
C GET NEXT SECTION
NEWSEC=0
45 NEWSEC=NEWSEC+1
IF(NEWSEC.GT.MAXSEC)GO TO 107
INISEC=MRKSEC+1
MRKSEC=MRKSEC+KNTTTL(NEWSEC)
MAXLIN=LNGSEC(NEWSEC)
C
C CHECK IF SECTION IS TO BE SHOWN
IF(MAXLIN.LE.0)GO TO 106
IF(NOWSEC.EQ.0)GO TO 46
IF(NEWSEC.LT.NOWSEC)GO TO 103
IF(NEWSEC.GT.NOWSEC)GO TO 107
46 CONTINUE
C
C CHECK IF THIS IS A RESERVED SECTION
IF(NEWSEC.EQ.LOCONE)GO TO 103
IF(NEWSEC.EQ.LOCTWO)GO TO 103
IF(NEWSEC.EQ.LOCTHR)GO TO 103
C
C INITIALIZE VARIABLES FOR A NEW SECTION
CONTINUE
IBULLT=0
IBLANK=0
IPRINT=0
JUNDER=0
IUNDER=0
JDOUBL=0
IDOUBL=0
MODIFY=0
MAXSHO=0
LNGSUM=0
LEGEND=0
IRIGHT=0
LMTTYP=ITSWID
MARGIN=MRGLFT
IF(IFRULE.GT.0)IFRULE=0
C
C PREPARE FOR NEXT LINE
NEWLIN=1
47 NOWLIN=NOWLIN+1
MINPRT=MAXPRT+1
MAXPRT=MAXPRT+LNGLIN(NOWLIN)
IF(MINPRT.GT.MAXPRT)GO TO 101
IF(NOWSEC.LE.0)GO TO 48
IF(NEWSEC.LT.NOWSEC)GO TO 101
C
C COPY SECTION TITLE AT START OF NEW SECTION
48 IF(LEGEND.NE.0)GO TO 51
LEGEND=1
IF(INISEC.GT.MRKSEC)GO TO 51
IBULLT=-1
IDOUBL=0
MODIFY=1
MINCPY=INISEC
MAXCPY=MRKSEC
LOCSHO=4
GO TO 37
49 IF(MAXSHO.EQ.0)GO TO 50
JDOUBL=1
MODIFY=1
C
C INSERT SPACES BETWEEN SECTION NAME AND MARGIN
50 IF(MAXSHO.GE.MRGLFT)GO TO 52
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRSPA
GO TO 50
C
C NEW INPUT LINE NOT START OF SECTION OR NO SECTION NAME
51 IF(IPRINT.NE.0)IBLANK=1
IUNDER=0
IDOUBL=0
IBULLT=0
C
C REMOVE SPACES FROM START OF LINE
52 IF(MINPRT.GT.MAXPRT)GO TO 100
IF(LTRTXT(MINPRT).NE.LTRSPA)GO TO 53
MINPRT=MINPRT+1
GO TO 52
C
C LOOK FOR AT SIGN AT START OF LINE
53 IF(LTRTXT(MINPRT).EQ.LTRMIN)GO TO 70
C
C LOOK FOR * MARKING START OF NEW OUTPUT LINE
KOLUMN=MINPRT-1
54 KOLUMN=KOLUMN+1
IF(KOLUMN.GT.MAXPRT)GO TO 70
IF(LTRTXT(KOLUMN).NE.LTRSTA)GO TO 54
I=1
J=KOLUMN
55 J=J+1
IF(J.GT.MAXPRT)GO TO 56
IF(LTRTXT(J).EQ.LTRSPA)GO TO 55
IF(LTRTXT(J).NE.LTRSTA)GO TO 56
I=I+1
GO TO 55
56 IF(I.EQ.2)GO TO 70
IF(MAXSHO.LE.0)GO TO 57
LOCSHO=1
GO TO 109
57 INDENT=KOLUMN
IBLANK=0
MAXSHO=0
LNGSUM=0
IBULLT=-1
LMTTYP=ITSWID
MARGIN=MRGLFT
IF(MINPRT.GE.MAXPRT)GO TO 102
JPRINT=0
C
C LOOP TO INSERT CHARACTERS TO LEFT OF LEFT MARGIN
58 IF(MAXSHO.GT.MAXOUT)GO TO 68
IF(MAXSHO.LT.MRGLFT)GO TO 59
IF(MINPRT.LT.INDENT)GO TO 59
GO TO 68
59 IF(MINPRT.GE.INDENT)GO TO 66
IF(LTRTXT(MINPRT).EQ.LTRUPA)GO TO 60
IF(LTRTXT(MINPRT).EQ.LTRUND)GO TO 61
IF(LTRTXT(MINPRT).EQ.LTRSPA)GO TO 62
JPRINT=1
GO TO 63
60 IDOUBL=1-IDOUBL
GO TO 65
61 IUNDER=1-IUNDER
GO TO 65
62 IDOUBL=0
IUNDER=0
IF(JPRINT.EQ.0)GO TO 65
63 MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRTXT(MINPRT)
IF(MAXSHO.GT.LMT2ND)GO TO 65
LTR2ND(MAXSHO)=LTRSPA
IF(IDOUBL.EQ.0)GO TO 64
LTR2ND(MAXSHO)=LTRWID(MAXSHO)
JDOUBL=1
MODIFY=1
GO TO 65
64 IF(IUNDER.EQ.0)GO TO 65
LTR2ND(MAXSHO)=LTRUND
JUNDER=1
MODIFY=1
65 MINPRT=MINPRT+1
GO TO 67
66 MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRSPA
67 GO TO 58
68 IUNDER=0
IDOUBL=0
MINPRT=INDENT+1
C
C STORE THE NEW LINE
69 IF(MINPRT.GT.MAXPRT)GO TO 100
IF(LTRTXT(MINPRT).NE.LTRSPA)GO TO 70
MINPRT=MINPRT+1
GO TO 69
70 IF(LTRTXT(MINPRT).NE.LTRMIN)GO TO 75
MINPRT=MINPRT+1
IF(IBULLT.LT.0)GO TO 71
IF(MAXSHO.LE.0)GO TO 71
LOCSHO=2
GO TO 109
71 IBULLT=1
IBLANK=0
LNGSUM=0
MARGIN=MRGLFT
LMTTYP=ITSWID
72 MARGIN=MARGIN+2
LMTTYP=LMTTYP-LNGBUL
73 IF(MINPRT.GT.MAXPRT)GO TO 100
IF(LTRTXT(MINPRT).NE.LTRSPA)GO TO 74
MINPRT=MINPRT+1
GO TO 73
74 IF(LTRTXT(MINPRT).NE.LTRMIN)GO TO 75
MINPRT=MINPRT+1
IBULLT=-IBULLT
IF(IBULLT.LT.0)GO TO 73
GO TO 72
C
C INSERT SPACE BEFORE NEXT PRINTING CHARACTER
75 KOLUMN=MINPRT
76 INDEX=KOLUMN
77 IF(INDEX.GT.MAXPRT)GO TO 100
LTRNOW=LTRTXT(INDEX)
IF(LTRNOW.EQ.LTRSPA)GO TO 82
IF(LTRNOW.EQ.LTRSTA)GO TO 79
IF(LTRNOW.EQ.LTRUND)GO TO 78
IF(LTRNOW.EQ.LTRUPA)GO TO 78
GO TO 83
78 INDEX=INDEX+1
GO TO 77
79 IF(KVARY.EQ.3)GO TO 82
IF(KVARY.EQ.4)GO TO 82
I=1
J=INDEX
80 J=J+1
IF(INDEX.GT.MAXPRT)GO TO 81
LTRNOW=LTRTXT(J)
IF(LTRNOW.EQ.LTRSPA)GO TO 80
IF(LTRNOW.NE.LTRSTA)GO TO 81
I=I+1
GO TO 80
81 INDEX=J-1
IF(I.EQ.1)GO TO 82
IRIGHT=1
JRIGHT=MAXSHO
82 KOLUMN=INDEX
GO TO 95
83 IF(IBLANK.LE.0)GO TO 85
IF((MAXSHO+1).GE.MAXOUT)GO TO 98
IF(KVARY.NE.3)GO TO 84
IF((LNGSUM+LNGSPA-LNGGAP).GE.LMTTYP)GO TO 98
LNGSUM=LNGSUM+LNGSPA
84 IBLANK=-1
LOCSPC=KOLUMN
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRSPA
C
C COPY PRINTING CHARACTER INTO OUTPUT LINE
85 IF(MAXSHO.GE.MAXOUT)GO TO 97
LTRNOW=LTRTXT(KOLUMN)
IF(LTRNOW.EQ.LTRUND)GO TO 93
IF(LTRNOW.EQ.LTRUPA)GO TO 94
IF(KVARY.NE.3)GO TO 88
DO 86 KOMPAR=1,MAXTYP
IF(LTRNOW.NE.LTRTYP(KOMPAR))GO TO 86
LNGSUM=LNGSUM+LNGTYP(KOMPAR)
GO TO 87
86 CONTINUE
LNGSUM=LNGSUM+LNGODD
87 CONTINUE
IF((LNGSUM-LNGGAP).GT.LMTTYP)GO TO 97
88 IF(MAXSHO.GE.MARGIN)GO TO 89
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
IF(MAXSHO.LE.LMT2ND)LTR2ND(MAXSHO)=LTRSPA
GO TO 88
89 IF(IBULLT.LE.0)GO TO 90
IBULLT=0
LTRWID(MAXSHO-1)=LTRBUL
90 IPRINT=1
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRTXT(KOLUMN)
IF(MAXSHO.GT.LMT2ND)GO TO 96
LTR2ND(MAXSHO)=LTRSPA
IF(IDOUBL.EQ.0)GO TO 91
LTR2ND(MAXSHO)=LTRTXT(KOLUMN)
JDOUBL=1
MODIFY=1
91 IF(IUNDER.EQ.0)GO TO 92
LTR2ND(MAXSHO)=LTRUND
JUNDER=1
MODIFY=1
92 GO TO 96
C
C UNDERLINE NEXT WORD
93 IUNDER=1-IUNDER
GO TO 96
C
C BOLDFACE NEXT WORD
94 IDOUBL=1-IDOUBL
GO TO 96
C
C SPACE INDICATES WORD BOUNDARY
95 IF(IPRINT.NE.0)IBLANK=1
IUNDER=0
IDOUBL=0
C
C ADVANCE TO NEXT CHARACTER IN INPUT LINE
96 KOLUMN=KOLUMN+1
GO TO 76
C
C RESET LINE LENGTHS IF WORD OVERFLOWS OUTPUT LINE
97 IF(IBLANK.EQ.0)GO TO 99
MAXSHO=MAXSHO-(KOLUMN-LOCSPC)
KOLUMN=LOCSPC
98 IBLANK=0
99 LOCSHO=3
GO TO 109
100 CONTINUE
GO TO 101
C
C DONE WITH CURRENT LINE
101 NEWLIN=NEWLIN+1
IF(NEWLIN.LE.MAXLIN)GO TO 47
IF(MAXSHO.LE.0)GO TO 106
IUNDER=0
IDOUBL=0
LOCSHO=5
GO TO 109
C
C ASTERISK BY ITSELF INDICATES BLANK LINE
102 LOCSHO=4
GO TO 109
C
C ADVANCE THE CHARACTER COUNT FOR INVISIBLE SECTION
103 IF(MAXLIN.EQ.0)GO TO 105
DO 104 I=1,MAXLIN
NOWLIN=NOWLIN+1
MAXPRT=MAXPRT+LNGLIN(NOWLIN)
104 CONTINUE
105 CONTINUE
GO TO 106
C
C DONE WITH THIS SECTION
106 GO TO 45
C
C DONE WITH ENTIRE RESUME
107 IF(ILOCAL.GT.0)WRITE(ITTY,108)
108 FORMAT(1X)
GO TO 185
C
C ******************************
C * *
C * DEDICATED OUTPUT ROUTINE *
C * *
C ******************************
C
C IDISK = NUMBER OF UNIT TO WHICH OUTPUT IS TO BE
C WRITTEN IF ILOCAL=0 SO THAT THE RESUME IS
C WRITTEN INTO AN OUTPUT FILE.
C IFRULE = DETERMINES WHETHER A RULED LINE IS TO APPEAR
C ABOVE SECTION.
C = -1, BEFORE FIRST SECTION
C = 0, BETWEEN SECTIONS
C = 1, INSIDE A SECTION
C ILOCAL = DETERMINES WHERE OUTPUT IS WRITTEN.
C = -1, DO NOT GENERATE OUTPUT. ONLY COUNT
C NUMBER OF LINES IN RESUME.
C = 0, WRITE RESUME TO DISK FILE ON UNIT IDISK
C = 1, WRITE RESUME TO TERMINAL ON UNIT ITTY
C IRIGHT = WHETHER RIGHT SECTION OF CURRENT LINE IS TO
C BE RIGHT JUSTIFIED.
C = 0, LINE DOES NOT CONTAIN SECTION TO BE RIGHT
C JUSTIFIED.
C = 1, RIGHT JUSTIFY CHARACTERS TO RIGHT OF
C LTRWID(JRIGHT)
C ISHOWN = NUMBER OF LINES DISPLAYED IN CURRENT SCREEN
C ON TERMINAL. THE ROUTINE PAUSES BEFORE
C DISPLAYING THE NEXT LINE IF THE SCREEN IS
C FULL AND WAITS FOR THE USER TO PRESS THE
C RETURN KEY.
C ITTY = UNIT NUMBER TO BE USED WHEN A LINE IS TO BE
C WRITTEN TO THE TERMINAL.
C IVIDEO = DETERMINES WHETHER THE TERMINAL IS VIDEO OR
C HARDCOPY.
C = -1, SLOW HARD COPY TERMINAL
C = 0, VIDEO TERMINAL WITHOUT PAGING.
C = 1, VIDEO TERMINAL. CLEAR SCREEN EACH TIME
C IT FILLS.
C JDOUBL = WHETHER THE CURRENT LINE CONTAINS ANY BOLD
C CHARACTERS.
C = 0, LINE CONTAINS NO BOLD CHARACTERS.
C = 1, LINE CONTAINS SOME BOLD CHARACTERS.
C JRIGHT = IF IRIGHT=1 SO THAT RIGHT PORTION OF LINE IS
C TO BE RIGHT JUSTIFIED, THEN JRIGHT IS
C LOCATION IN LTRWID ARRAY OF CHARACTER TO
C LEFT OF FIRST CHARACTER TO BE SHIFTED.
C JUNDER = WHETHER THE CURRENT LINE CONTAINS ANY
C UNDERLINED CHARACTERS.
C = 0, LINE CONTAINS NO UNDERLINED CHARACTERS.
C = 1, LINE CONTAINS SOME UNDERLINED CHARACTERS.
C KNTOUT = TOTAL NUMBER OF LINES DISPLAYED IN RESUME.
C THIS IS NOT RESET TO ZERO EACH TIME THE
C SCREEN FILLS.
C LMTBFR = DIMENSION OF THE LTRBFR ARRAY INTO WHICH IS
C READ WHAT THE USER TYPES WHEN THE SCREEN IS
C FULL.
C LMT2ND = DIMENSION OF THE LTR2ND ARRAY WHICH STORES
C AN UNDERLINE CHARACTER IF THE CHARACTER IS
C TO BE UNDERLINED OR THE CHARACTER ITSELF IF
C IT IS TO BE BOLDED.
C LOCSHO = DETERMINES THE LOCATION TO WHICH THIS
C SECTION OF THE ROUTINE RETURNS AFTER THE
C LINE HAS BEEN DISPLAYED.
C LTRBFR = ARRAY INTO WHICH IS READ WHAT THE USER TYPES
C WHEN THE SCREEN IS FULL.
C LTRDRK = ARRAY CONTAINING SEQUENCE OF CHARACTERS
C NEEDED TO SHIFT TYPING OF NEXT LINE ON DAISY
C WHEEL TERMINAL SLIGHTLY TO RIGHT TO GIVE
C BOLD CHARATERS.
C LTRRUL = CHARACTER USED TO RULE LINE BETWEEN
C SECTIONS.
C LTRSPA = THE SPACE CHARACTER.
C LTRUND = THE UNDERLINE CHARACTER.
C LTRUPA = THE CHARACTER USED TO MARK BOLD CHARACTERS
C WHEN WRITTEN TO THE SCREEN. NOT NECESSARY
C SAME AS THAT USED AS A FLAG WHEN THE LINE
C WAS TYPED BY THE USER.
C LTRWID = ARRAY CONTAINING THE LINE CHARACTERS TO BE
C IN THE CURRENT LINE OF THE RESUME. THIS
C CONTAINS MAXSHO CHARACTERS.
C LTR2ND = ARRAY CONTAINING THE CHARACTERS WHICH ARE TO
C BE EITHER BOLDED OR UNDERLINED.
C MAXBFR = THE NUMBER OF CHARACTERS TYPED BY THE USER
C WHEN THE SCREEN HAS FILLED.
C MAXOUT = THE MAXIMUM NUMBER OF CHARACTERS IN A SINGLE
C OUTPUT LINE. THIS IS USED HERE ONLY WHEN
C THE RIGHT SECTION MUST BE RIGHT JUSTIFIED.
C MAXRUL = THE NUMBER OF CHARACTERS IN THE LINES RULED
C BETWEEN SECTIONS.
C MAXSHO = NUMBER OF CHARACTERS IN THE LTRWID ARRAY
C WHICH ARE READY TO BE DISPLAYED.
C MODIFY = NUMBER OF EXTRA LINES NEEDED IN THE DISPLAY
C ON THE VIDEO TERMINAL FOR THE CURRENT LINE.
C THIS INDICATES WHETHER THE CURRENT LINE
C CONTAINS EITHER A BOLD OR UNDERLINED
C CHARACTER.
C = 0, LINE CONTAINS NEITHER BOLD NOR UNDERLINED
C CHARACTERS.
C = 1, LINE CONTAINS EITHER BOLD OR UNDERLINED
C CHARACTERS.
C
C THE FOLLOWING VARIABLES ARE NOT USED IN THIS ROUTINE
C BUT ARE USED BY THE CALLING SECTION. THEY ARE RESET
C TO THEIR DEFAULT VALUES BEFORE RETURNING TO THE
C CALLING SECTION.
C
C IDOUBL = 0, NEXT WORD IS NOT TO BE BOLD.
C IPRINT = 0, NO PRINTING CHARACTER HAS YET BEEN FOUND.
C IUNDER = 0, NEXT WORD IS NOT TO BE UNDERLINED.
C LNGSUM = 0, TYPESET WIDTH OF NEXT LINE STARTS AT
C ZERO.
C
C RULE LINE ABOVE A SECTION
109 IF(IFRULE.NE.0)GO TO 132
LINRUL=0
110 LINRUL=LINRUL+1
IF(LINRUL.GT.3)GO TO 132
IF(LVARY.EQ.1)GO TO 111
GO TO 112
111 IF(LINRUL.EQ.1)GO TO 110
112 KNTOUT=KNTOUT+1
IONPAG=IONPAG+1
IF(ILOCAL.LE.0)GO TO 122
IF(IVIDEO.LT.0)GO TO 117
IF(ISHOWN.LT.LNGCRT)GO TO 117
113 WRITE(ITTY,114)
114 FORMAT(1X/' (press RETURN to continue)',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.EQ.0)GO TO 116
IF(MAXBFR.GT.0)GO TO 185
WRITE(ITTY,115)
115 FORMAT(
1' Press the RETURN key to see the rest of your resume'/
2' or type one of the "What next?" options to perform that option')
GO TO 113
116 ISHOWN=0
117 IF(ISHOWN.NE.0)GO TO 118
IF(IVIDEO.GT.0)CALL RSMWIP(ITTY)
118 ISHOWN=ISHOWN+1
IF(LINRUL.EQ.2)GO TO 120
WRITE(ITTY,119)
119 FORMAT(1X)
GO TO 110
120 WRITE(ITTY,121)(LTRRUL,I=1,MAXRUL)
121 FORMAT(1X,1000A1)
GO TO 110
122 IF(LINRUL.EQ.2)GO TO 125
IF(IVARY.EQ.0)GO TO 123
IF(IONPAG.LE.IVARY)GO TO 123
GO TO 110
123 IF(ILOCAL.LT.0)GO TO 110
WRITE(IDISK,124)
124 FORMAT(1X)
GO TO 110
125 IF(IVARY.EQ.0)GO TO 127
IF(IONPAG.LE.IVARY)GO TO 127
LOCSHO=-LOCSHO
GO TO 170
126 LOCSHO=-LOCSHO
127 IF(ILOCAL.LT.0)GO TO 110
IF(KVARY.EQ.4)GO TO 130
WRITE(IDISK,128)(LTRRUL,I=1,MAXRUL)
128 FORMAT(1X,1000A1)
IF(JVARY.NE.3)GO TO 110
WRITE(IDISK,129)(LTRRUL,I=1,MAXRUL)
WRITE(IDISK,129)(LTRRUL,I=1,MAXRUL)
129 FORMAT(1H+,1000A1)
GO TO 110
130 WRITE(IDISK,131)
131 FORMAT(1X,'RULE')
GO TO 110
132 IFRULE=1
C
C TRIM OFF RIGHTMOST SPACES IN LINE TO BE DISPLAYED
133 IF(MAXSHO.LE.0)GO TO 134
IF(LTRWID(MAXSHO).NE.LTRSPA)GO TO 134
MAXSHO=MAXSHO-1
GO TO 133
134 CONTINUE
C
C RIGHT JUSTIFY A SECTION OF TEXT
IF(IRIGHT.EQ.0)GO TO 137
IRIGHT=0
IF(JRIGHT.GE.MAXSHO)GO TO 137
IF(MAXSHO.GE.MAXOUT)GO TO 137
I=MAXSHO
MAXSHO=MAXOUT
J=MAXSHO
135 IF(I.LE.JRIGHT)GO TO 136
LTRWID(J)=LTRWID(I)
IF(J.LE.LMT2ND)LTR2ND(J)=LTR2ND(I)
J=J-1
I=I-1
GO TO 135
136 IF(J.LE.JRIGHT)GO TO 137
LTRWID(J)=LTRSPA
IF(J.LE.LMT2ND)LTR2ND(J)=LTRSPA
J=J-1
GO TO 135
137 CONTINUE
C
C DISPLAY THE LINE CONTAINING CHARACTERS TO BE READ
KNTOUT=KNTOUT+1
IONPAG=IONPAG+1
IF(ILOCAL.LE.0)GO TO 146
IF(IVIDEO.LT.0)GO TO 140
IF((ISHOWN+MODIFY).LT.LNGCRT)GO TO 140
138 WRITE(ITTY,114)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.EQ.0)GO TO 139
IF(MAXBFR.GT.0)GO TO 185
WRITE(ITTY,115)
GO TO 138
139 ISHOWN=0
140 IF(ISHOWN.NE.0)GO TO 141
IF(IVIDEO.GT.0)CALL RSMWIP(ITTY)
141 ISHOWN=ISHOWN+1
IF(MAXSHO.EQ.0)WRITE(ITTY,144)
IF(MAXSHO.GT.0)WRITE(ITTY,145)(LTRWID(I),I=1,MAXSHO)
IF(MODIFY.EQ.0)GO TO 169
ISHOWN=ISHOWN+1
IF(MAXSHO.GT.LMT2ND)MAXSHO=LMT2ND
DO 143 I=1,MAXSHO
IF(LTR2ND(I).EQ.LTRSPA)GO TO 143
IF(LTR2ND(I).EQ.LTRUND)GO TO 142
LTR2ND(I)=LTRUPA
GO TO 143
142 LTR2ND(I)=LTRUND
143 CONTINUE
WRITE(ITTY,145)(LTR2ND(I),I=1,MAXSHO)
144 FORMAT(1X)
145 FORMAT(1X,1000A1)
GO TO 169
C REMOVE MULTIPLE SPACES FROM LINE IF TRANSMITTING
146 IF(KVARY.NE.4)GO TO 150
IF(MAXSHO.LE.0)GO TO 150
J=MAXSHO
MAXSHO=0
K=-1
DO 149 I=1,J
IF(LTRWID(I).NE.LTRSPA)GO TO 147
IF(K.EQ.0)K=1
GO TO 149
147 IF(K.NE.1)GO TO 148
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRSPA
148 K=0
MAXSHO=MAXSHO+1
LTRWID(MAXSHO)=LTRWID(I)
149 CONTINUE
150 IF(IVARY.EQ.0)GO TO 151
IF(IONPAG.LE.IVARY)GO TO 151
IF(MAXSHO.EQ.0)GO TO 169
GO TO 170
151 IF(ILOCAL.LT.0)GO TO 169
IF(KNTOUT.GT.1)GO TO 157
IF(MVARY.EQ.0)GO TO 157
IF(MVARY.GT.0)GO TO 154
C
C TOP LINE, NO LINE FEED BEFORE IT
IF(MAXSHO.EQ.0)WRITE(IDISK,152)
IF(MAXSHO.GT.0)WRITE(IDISK,153)(LTRWID(I),I=1,MAXSHO)
152 FORMAT(2H+ )
153 FORMAT(1H+,1000A1)
GO TO 160
C
C TOP LINE, FORM FEED BEFORE IT
154 IF(MAXSHO.EQ.0)WRITE(IDISK,155)
IF(MAXSHO.GT.0)WRITE(IDISK,156)(LTRWID(I),I=1,MAXSHO)
155 FORMAT(2H1 )
156 FORMAT(1H1,1000A1)
GO TO 160
C
C NOT TOP LINE
157 IF(MAXSHO.EQ.0)WRITE(IDISK,158)
IF(MAXSHO.GT.0)WRITE(IDISK,159)(LTRWID(I),I=1,MAXSHO)
158 FORMAT(2H )
159 FORMAT(1H ,1000A1)
160 CONTINUE
C
C OVERLAY MULTIPLE STRIKE OR UNDERLINE CHARACTERS
IF(MODIFY.EQ.0)GO TO 169
IF(JVARY.EQ.1)GO TO 169
161 ISHOWN=ISHOWN+1
IF(MAXSHO.GT.LMT2ND)MAXSHO=LMT2ND
IF(JDOUBL.EQ.0)GO TO 166
J=0
DO 163 I=1,MAXSHO
IF(LTR2ND(I).EQ.LTRSPA)GO TO 162
IF(LTR2ND(I).EQ.LTRUND)GO TO 162
J=I
GO TO 163
162 LTRWID(I)=LTRSPA
163 CONTINUE
IF(J.EQ.0)GO TO 166
IF(JVARY.NE.3)GO TO 164
WRITE(IDISK,165)(LTRWID(I),I=1,J)
WRITE(IDISK,165)LTRDRK,(LTRWID(I),I=1,J)
GO TO 166
164 WRITE(IDISK,165)(LTRWID(I),I=1,J)
WRITE(IDISK,165)(LTRWID(I),I=1,J)
WRITE(IDISK,165)(LTRWID(I),I=1,J)
165 FORMAT(1H+,1000A1)
166 IF(JUNDER.EQ.0)GO TO 169
J=0
DO 167 I=1,MAXSHO
LTRWID(I)=LTRSPA
IF(LTR2ND(I).EQ.LTRSPA)GO TO 167
IF(LTR2ND(I).NE.LTRUND)GO TO 167
J=I
LTRWID(I)=LTRUND
167 CONTINUE
IF(J.EQ.0)GO TO 169
WRITE(IDISK,168)(LTRWID(I),I=1,J)
168 FORMAT(1H+,1000A1)
IF(JVARY.NE.3)GO TO 169
WRITE(IDISK,168)(LTRWID(I),I=1,J)
WRITE(IDISK,168)(LTRWID(I),I=1,J)
169 MAXSHO=0
LNGSUM=0
IPRINT=0
MODIFY=0
JUNDER=0
IUNDER=0
JDOUBL=0
IDOUBL=0
GO TO(57,71,76,101,106,19,27),LOCSHO
C
C ***********************************************
C * *
C * WRITE OUT NEW PAGE HEADING ON SECOND PAGE *
C * *
C ***********************************************
C
170 KNTPAG=KNTPAG+1
IONPAG=4
IF(ILOCAL.LT.0)GO TO 184
K=0
IF(LOCONE.EQ.0)GO TO 177
J=INIONE
K=LINONE+1
L=LINONE+LNGSEC(LOCONE)
DO 171 I=K,L
J=J+LNGLIN(I)
IF(LNGLIN(I).NE.0)GO TO 172
171 CONTINUE
172 LNGNAM=0
L=INIONE+1
IF(L.GT.J)GO TO 176
KBLANK=-1
DO 175 I=L,J
LTRNOW=LTRTXT(L)
L=L+1
IF(LTRNOW.EQ.LTRSPA)GO TO 174
IF(LTRNOW.EQ.LTRSTA)GO TO 175
IF(LTRNOW.EQ.LTRUPA)GO TO 175
IF(LTRNOW.EQ.LTRUND)GO TO 175
IF(KBLANK.LE.0)GO TO 173
IF((LNGNAM+2).GT.LMTBFR)GO TO 176
LNGNAM=LNGNAM+1
LTRBFR(LNGNAM)=LTRSPA
173 IF(LNGNAM.GE.LMTBFR)GO TO 176
LNGNAM=LNGNAM+1
LTRBFR(LNGNAM)=LTRNOW
KBLANK=0
GO TO 175
174 IF(KBLANK.EQ.0)KBLANK=1
175 CONTINUE
176 CONTINUE
177 IF(LNGNAM.EQ.0)WRITE(IDISK,178)
178 FORMAT(1H1,'Resume')
IF(LNGNAM.GT.0)WRITE(IDISK,179)(LTRBFR(I),I=1,LNGNAM)
179 FORMAT(1H1,'Resume of ',1000A1)
C
C DARKEN THE NAME
IF(JVARY.EQ.1)GO TO 182
IF(LNGNAM.EQ.0)GO TO 182
IF(JVARY.NE.3)GO TO 180
WRITE(IDISK,181)(LTRBFR(I),I=1,LNGNAM)
WRITE(IDISK,181)LTRDRK,(LTRBFR(I),I=1,LNGNAM)
GO TO 182
180 WRITE(IDISK,181)(LTRBFR(I),I=1,LNGNAM)
WRITE(IDISK,181)(LTRBFR(I),I=1,LNGNAM)
WRITE(IDISK,181)(LTRBFR(I),I=1,LNGNAM)
C FORMAT(1H1,'Resume of ',1000A1)
181 FORMAT(1H+,' ',1000A1)
182 CONTINUE
C
C PAGE NUMBER BELOW NAME
WRITE(IDISK,183)KNTPAG
183 FORMAT(1X,'Page',1I2)
WRITE(IDISK,158)
184 IF(LOCSHO.LT.0)GO TO 126
GO TO 151
C
C RETURN TO CALLING PROGRAM
185 RETURN
END
SUBROUTINE RSMSAV(NOWSEC,IDISK,LTRTXT,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL)
C RENBR(/SAVE RESUME IN CENTRAL STORAGE AREA)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN),LNGSEC(LMTSEC),
1MARKER(LMTLIN),LTRTTL(LMTLTT),KNTTTL(LMTSEC)
DATA LTRSPA,LTREQU,LTRMIN/1H ,1H=,1H-/
MAXPRT=0
NOWLIN=0
KNTPRT=0
MRKSEC=0
DO 24 NEWSEC=1,MAXSEC
LEGEND=0
INISEC=MRKSEC+1
MRKSEC=MRKSEC+KNTTTL(NEWSEC)
MAXLIN=LNGSEC(NEWSEC)
IF(MAXLIN.LE.0)GO TO 24
DO 23 NEWLIN=1,MAXLIN
NOWLIN=NOWLIN+1
MINPRT=MAXPRT+1
MAXPRT=MAXPRT+LNGLIN(NOWLIN)
IF(MINPRT.GT.MAXPRT)GO TO 23
1 IF(LEGEND.NE.0)GO TO 9
LEGEND=1
IF(INISEC.GT.MRKSEC)GO TO 9
WRITE(IDISK,2)
2 FORMAT(1H-)
IF(LTRTTL(INISEC).EQ.LTRMIN)GO TO 3
IF(LTRTTL(INISEC).EQ.LTREQU)GO TO 3
GO TO 5
3 I=INISEC
4 I=I+1
IF(I.GT.MRKSEC)GO TO 7
IF(LTRTTL(I).EQ.LTRSPA)GO TO 4
5 WRITE(IDISK,6)(LTRTTL(I),I=INISEC,MRKSEC)
6 FORMAT(500A1)
GO TO 9
7 WRITE(IDISK,8)LTRTTL(INISEC)
8 FORMAT(1X,1A1)
9 KNTPRT=KNTPRT+1
IF(LTRTXT(MINPRT).EQ.LTRMIN)GO TO 10
IF(LTRTXT(MINPRT).EQ.LTREQU)GO TO 10
GO TO 12
10 I=MINPRT
11 I=I+1
IF(I.GT.MAXPRT)GO TO 21
IF(LTRTXT(I).EQ.LTRSPA)GO TO 11
12 IFINAL=MINPRT-1
13 IFIRST=IFINAL+1
14 IFINAL=IFINAL+76
IF(IFINAL.GE.MAXPRT)GO TO 17
MIDDLE=IFINAL+1
15 IF(MIDDLE.LE.IFIRST)GO TO 18
IF(LTRTXT(MIDDLE).EQ.LTRSPA)GO TO 16
MIDDLE=MIDDLE-1
GO TO 15
16 IFINAL=MIDDLE-1
GO TO 18
17 IFINAL=MAXPRT
18 CONTINUE
WRITE(IDISK,19)(LTRTXT(I),I=IFIRST,IFINAL)
19 FORMAT(80A1)
20 IF(IFINAL.GE.MAXPRT)GO TO 23
IFINAL=IFINAL+1
IF(LTRTXT(IFINAL).EQ.LTRSPA)GO TO 20
IFINAL=IFINAL-1
GO TO 13
21 WRITE(IDISK,22)LTRTXT(MINPRT)
22 FORMAT(1X,1A1)
23 CONTINUE
24 CONTINUE
WRITE(IDISK,25)
25 FORMAT(1H=)
RETURN
END
SUBROUTINE YESNO(IFORCE,KNDYES,ITTY)
C RENBR(/GET YES OR NO RESPONSE FROM USER)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C IFORCE = 0, RETURN KNDYES=1 FOR EMPTY RESPONSE.
C NO NOT GENERATE A WARNING.
C = 1, RETURN KNDYES=2 FOR EMPTY RESPONSE.
C THE USER IS TOLD TO RESPOND WITH YES OR NO.
C KNDYES = 1, NOTHING TYPED (AND IFORCE=0)
C = 2, ERROR, REISSUE PROMPT
C = 3, YES ANSWERED
C = 4, NO ANSWERED
C = 5, QUESTION MARK TYPED
DIMENSION LTRBFR(20),LTRYES(5),LNGYES(2)
DATA LMTBFR/20/
DATA LTRYES/1HY,1HE,1HS,1HN,1HO/
DATA LNGYES/3,2/
DATA LMTLYN,LMTKYN/5,2/
DATA LTRSPA/1H /
C
C READ LINE OF TEXT TYPED BY USER
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 6
C
C IDENITIFY RESPONSE
LOWBFR=1
CALL DAVERB(1,LMTLYN,LTRYES,1,LMTKYN,
1LNGYES,LTRBFR,MAXBFR,LOWBFR,KIND,MATCH,LCNWRD,
2LCNKNT,LCNBFR)
GO TO(2,4,1,1,4),KIND
C
C CHECK FOR TRAILING PRINTING CHARACTER
1 IF(LOWBFR.GT.MAXBFR)GO TO 7
IF(LTRBFR(LOWBFR).NE.LTRSPA)GO TO 4
LOWBFR=LOWBFR+1
GO TO 1
C
C RETURN TO CALLING PROGRAM
2 IF(IFORCE.NE.0)GO TO 4
3 KNDYES=1
GO TO 8
4 WRITE(ITTY,5)
5 FORMAT(' Answer either YES or NO')
KNDYES=2
GO TO 8
6 KNDYES=5
GO TO 8
7 KNDYES=MATCH+2
8 RETURN
END
SUBROUTINE DAHEFT(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
1 LOWBFR,KIND ,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2 VALUE )
C RENBR(/FREE FORMAT NUMERIC INPUT ROUTINE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DAHEFT INTERPRETS AN ARRAY READ BY THE CALLING
C PROGRAM WITH A MULTIPLE OF AN A1 FORMAT AND RETURNS
C THE VALUES CONTAINED IN THIS ARRAY.
C
C NUMBERS INTERPRETTED BY DAHEFT 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 = 1 OR GREATER, ITEM IN IBUFFR ARRAY IS
C FLOATING POINT. IF POSSIBLE, THE FLOATING
C POINT NUMBER WILL BE ACCUMULATED AS AN
C INTEGER, THEN BE CONVERTED TO FLOATING POINT
C AND SHIFTED IF NECESSARY. KONTRL IS THEN
C THE MAXIMUM NUMBER OF DIGITS IN THE INTEGER.
C THE VALUE IS OUTPUT AS THE ARGUMENT VALUE.
C IF THE ITEM HAS MORE THAN KONTRL DIGITS,
C THEN THE ENTIRE EVALUATION IS DONE IN
C FLOATING POINT. THE ADVANTAGE OF
C CALCULATING THE FLOATING POINT VALUES IN
C INTEGER AS LONG AS THE PRECISION OF THE
C COMPUTER IS NOT OVERFLOWED IS THAT THE
C CALCULATION OF THE PORTION OF THE NUMBER
C RIGHT OF THE DECIMAL POINT IS MORE EXACT.
C AS AN EXAMPLE, IF KONTRL IS GREATER THAN OR
C EQUAL TO 4, THEN THE NUMBER 33.33 CAN BE
C STORED AS THE INTEGER 3333, THEN BE
C CONVERTED TO FLOATING POINT VALUE 3333.0 AND
C DIVIDED BY 100.0 TO OBTAIN THE FINAL
C ANSWER. IF IT MAKES NO DIFFERENCE WHETHER
C THE NUMBER TYPED AS 33.33 HAS VALUE 33.33 OR
C 33.32999... THEN KONTRL CAN BE GIVEN THE
C VALUE 1.
C = 0, ITEM IN IBUFFR ARRAY IS INTEGER DECIMAL.
C THE NUMBER CAN BE TYPED WITH A DECIMAL POINT
C (FOR EXAMPLE 1.23K OR 1.23E3 EQUALS 1230),
C BUT IS STORED AS AN INTEGER IN DAHEFT, 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 KONTRL IS LESS THAN
C OR EQUAL TO ZERO. NOTE THAT IF KONTRL IS
C LESS THAN OR EQUAL TO ZERO, THEN ORIGINAL
C CONTENT OF IVALUE IS ALWAYS DESTROYED. IN
C PARTICULAR, IF KONTRL IS LESS THAN OR EQUAL
C TO ZERO AND IF KIND IS RETURNED CONTAINING
C EITHER 1 OR 2, THEN IVALUE WILL BE ZEROED.
C VALUE = RETURNED WITH VALUE IF KONTRL IS GREATER
C THAN ZERO. NOTE THAT IF KONTRL IS GREATER
C THAN ZERO, THEN THE ORIGINAL CONTENT OF
C VALUE IS ALWAYS DESTROYED. IN PARTICULAR,
C IF KONTRL IS GREATER THAN ZERO AND IF KIND
C IS RETURNED CONTAINING EITHER 1 OR 2, THEN
C VALUE 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 ,"045004020100/
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
IF(KONTRL.GT.0)VALUE=0.0
IF(KONTRL.LE.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
NUMVAL=0
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 25
NOWLTR=IBUFFR(LOWBFR)
IF(NMBEXP.GE.0)GO TO 20
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 40
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 26
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 19
C
C LOOK FOR LEADING OR EMBEDDED PERIOD
10 IF(LTRAIL.GE.3)GO TO 24
IF(NUMPNT.GE.0)GO TO 11
IF(NOWLTR.NE.IDOT)GO TO 11
DECML=0.1
IF(ISIGN.EQ.0)NUMKNT=-1
GO TO 18
C
C LOOK FOR DIGIT OTHER THAN IN EXPONENT FIELD
11 DO 16 I=1,IRADIX
IF(NOWLTR.NE.IDIGIT(I))GO TO 16
IF(NUMKNT.GT.0)GO TO 12
NUMKNT=0
IF(I.EQ.1)GO TO 13
12 NUMKNT=NUMKNT+1
13 IF(KONTRL.LE.0)GO TO 15
IF(NUMKNT.LE.KONTRL)NUMVAL=(10*NUMVAL)+I-1
IF(NUMPNT.GE.0)GO TO 14
VALUE=(10.0*VALUE)+FLOAT(I-1)
GO TO 19
14 VALUE=VALUE+(DECML*FLOAT(I-1))
DECML=DECML/10.0
GO TO 18
C FOLLOWING ALLOWS LARGEST NEGATIVE NUMBER FOR
C WHICH THERE IS NOT CORRESPONDING POSITIVE VALUE
15 IF(NUMKNT.EQ.1)IVALUE=I-2
IF(NUMKNT.GT.1)IVALUE=(IRADIX*IVALUE)+I+IADD
GO TO 17
16 CONTINUE
GO TO 24
C
C DIGIT, E OR . FOUND SO MARK AS BEING IN NUMBER
17 IF(NUMPNT.LT.0)GO TO 19
18 NUMPNT=NUMPNT+1
19 IF(ISIGN.EQ.0)ISIGN=1
GO TO 1
C
C LOOK FOR SIGN IN EXPONENT FIELD
20 IF(JSIGN.NE.0)GO TO 22
IF(NOWLTR.EQ.IPLUS)GO TO 21
IF(NOWLTR.NE.IMINUS)GO TO 22
JSIGN=-1
ISHIFT=-3
GO TO 1
21 JSIGN=1
ISHIFT=-2
GO TO 1
C
C LOOK FOR DIGITS IN EXPONENT FIELD
22 DO 23 I=1,10
IF(NOWLTR.NE.IDIGIT(I))GO TO 23
IPOWER=(10*IPOWER)+I-1
NMBEXP=1
ISHIFT=-1
IF(JSIGN.EQ.0)JSIGN=1
GO TO 1
23 CONTINUE
GO TO 26
C
C DECIDE WHAT TO DO IF NO MATCH FOUND
24 IF(ISIGN.NE.0)GO TO 26
GO TO 40
C
C *******************************
C * NUMBER HAS BEEN EVALUATED *
C *******************************
C
25 IF(ISIGN.EQ.0)GO TO 39
26 KIND=3
C
C ADJUST EXPONENT SIGN
IF(NMBEXP.LT.0)GO TO 27
IF(NMBEXP.EQ.0)IPOWER=IDEFLT
IF(JSIGN.LT.0)IPOWER=-IPOWER
C
C SHIFT FLOATING POINT NUMBER ACCORDING TO EXPONENT
27 JSHIFT=IPOWER
KSHIFT=IPOWER
IF(NUMPNT.GT.0)KSHIFT=KSHIFT-NUMPNT
LSHIFT=NUMKNT
IF(NUMPNT.LT.0)NUMPNT=0
IF(ITRAIL.GT.5)IPOWER=NUMPNT
IPOWER=IPOWER+IEXTRA
IF(KONTRL.LE.0)GO TO 31
IF(NUMKNT.GT.KONTRL)GO TO 28
IF(NUMKNT.LT.0)NUMVAL=IDEFLT
IF(ISIGN.LT.0)NUMVAL=-NUMVAL
VALUE=FLOAT(NUMVAL)
IPOWER=IPOWER-NUMPNT
GO TO 29
28 IF(NUMKNT.LT.0)VALUE=IDEFLT
IF(ISIGN.LT.0)VALUE=-VALUE
29 IF(IPOWER.EQ.0)GO TO 41
IF(IPOWER.GT.0)GO TO 30
IPOWER=-IPOWER
VALUE=VALUE/(10.0**IPOWER)
GO TO 41
30 VALUE=VALUE*(10.0**IPOWER)
GO TO 41
C
C SHIFT AN INTEGER ACCORDING TO EXPONENT
31 IF(NUMKNT.LT.0)IVALUE=IDEFLT
IPOWER=IPOWER-NUMPNT
IF(ISIGN.GE.0)GO TO 32
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 33
32 IF(NUMKNT.GT.0)IVALUE=IVALUE+1
33 IF(IPOWER.LE.0)GO TO 37
IPOWER=IPOWER-1
KVALUE=IVALUE
IVALUE=IRADIX*IVALUE
IF(ISIGN.GE.0)GO TO 34
IF(IVALUE.GE.KVALUE)GO TO 36
GO TO 35
34 IF(IVALUE.LE.KVALUE)GO TO 36
35 IF((IVALUE/IRADIX).EQ.KVALUE)GO TO 33
36 IVALUE=KVALUE
37 IF(IPOWER.GE.0)GO TO 41
IPOWER=IPOWER+1
KVALUE=IVALUE
IVALUE=IVALUE/IRADIX
IF(ISIGN.GE.0)GO TO 38
IF((IRADIX*IVALUE).LT.KVALUE)IVALUE=IVALUE+1
38 IF(IVALUE.NE.0)GO TO 37
GO TO 41
C
C NUMBER NOT FOUND
39 KIND=1
GO TO 41
40 KIND=2
C
C RETURN TO CALLING PROGRAM
41 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.
C204733708764%KME
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 ,"045004020100/
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
END
SUBROUTINE GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
C RENBR(/GET NEXT LINE TYPED BY USER)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C MAXBFR = -1 RETURNED IF ? ONLY WAS TYPED
C = 0 OR GREATER, RETURNED WITH NUMBER OF CHARACTERS
C TYPED BY THE USER
DIMENSION LTRBFR(LMTBFR)
DATA LTRSPA/1H /
MAXBFR=0
READ(ITTY,1,END=8)LTRBFR
1 FORMAT(3000A1)
INDEX0=0
INDEX1=0
2 IF(INDEX0.GE.LMTBFR)GO TO 9
INDEX0=INDEX0+1
LTRNOW=LTRBFR(INDEX0)
IF(LTRNOW.EQ.LTRSPA)GO TO 7
C NEXT 2 LINES DISCARD CONTROL CHARACTERS ON DECSYSTEM 20
IF(LTRNOW.LE.0)GO TO 3
IF(LTRNOW.GT.LTRSPA)GO TO 3
IF(INDEX1.GT.0)INDEX1=INDEX1-1
IF(MAXBFR.GT.INDEX1)MAXBFR=INDEX1
GO TO 2
3 IF(MAXBFR.NE.0)GO TO 6
IF(LTRNOW.NE.1H?)GO TO 6
I=INDEX1
4 IF(I.LE.0)GO TO 5
IF(LTRBFR(I).NE.LTRSPA)GO TO 6
I=I-1
GO TO 4
5 MAXBFR=-1
GO TO 7
6 MAXBFR=INDEX1+1
7 INDEX1=INDEX1+1
LTRBFR(INDEX1)=LTRNOW
GO TO 2
C ON DECSYSTEM20 THE TERMINAL MUST BE CLOSED AFTER AN
C END-OF-FILE TO PREVENT GETTING SAME END-OF-FILE AGAIN
8 CLOSE(UNIT=ITTY)
9 RETURN
END