Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0174/rsmlib.for
There is 1 other file named rsmlib.for in the archive. Click here to see a list.
SUBROUTINE RSMMSG(LTRBFR,LWRBFR,LMTBFR,LNGCRT,
1 NUMWHO, IYEAR, ITTY, IDISK)
C RENBR(/DISPLAY MESSAGES FOR THIS CLASS)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
DIMENSION LTRBFR(LMTBFR),LWRBFR(LMTBFR)
C
DATA LTRSPA/1H /
C
C OPEN THE MSSAGE FILE
CALL RSMOPN(12,NUMWHO,IYEAR,ITTY,IDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 13
C
C GET NEXT LINE OF MESSAGE
ISHOWN=3
1 JSHOWN=ISHOWN
2 READ(IDISK,3,END=11)LWRBFR
3 FORMAT(80A1)
NOWBFR=LMTBFR
4 IF(LWRBFR(NOWBFR).NE.LTRSPA)GO TO 5
NOWBFR=NOWBFR-1
IF(NOWBFR.GT.0)GO TO 4
IF(ISHOWN.EQ.JSHOWN)GO TO 2
NOWBFR=1
5 CONTINUE
C
C PAUSE IF PAGE IS FULL
IF(ISHOWN.LT.LNGCRT)GO TO 9
ISHOWN=0
JSHOWN=0
6 WRITE(ITTY,7)
7 FORMAT(1X/' (press RETURN to continue)',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.EQ.0)GO TO 9
IF(MAXBFR.GT.0)GO TO 11
WRITE(ITTY,8)
8 FORMAT(
1' Press the RETURN key to see the rest of the message'/
2' or type anything else to suppress the rest of message')
GO TO 6
C
C WRITE THE LINE
9 ISHOWN=ISHOWN+1
WRITE(ITTY,10)(LWRBFR(I),I=1,NOWBFR)
10 FORMAT(1X,80A1)
GO TO 2
C
C RETURN TO CALLING PROGRAM
11 CALL RSMCLS(12,NUMWHO,IYEAR,ITTY,IDISK,IFCLOS)
WRITE(ITTY,12)
12 FORMAT(1X)
13 RETURN
END
SUBROUTINE RSMNAM(LTRBFR,LMTBFR,LINE,LTRTXT,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MAXSEC,LMTSEC,MARKER,ITTY,
2IVIDEO,JVIDEO,LTRTTL,LMTLTT,MAXLTT,KNTTTL)
C RENBR(/CONSTRUCT NAME AND ADDRESS SECTIONS)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN),LNGSEC(LMTSEC),
1LTRBFR(LMTBFR),MARKER(LMTLIN),LTRTTL(LMTLTT),
2KNTTTL(LMTSEC),LTRPRE(18),LNGPRE(3)
DATA LTRSPA/1H /
C
C PREDEFIND SECTION NAMES
DATA LTRPRE/
1 1HN,1HA,1HM,1HE,
2 1HL,1HO,1HC,1HA,1HL,
3 1HP,1HE,1HR,1HM,1HA,1HN,1HE,1HN,1HT/
DATA LNGPRE/4,5,9/
C
C ASK FOR NAME
ISECTN=1
IPASS=1
IVIDEO=JVIDEO
CALL RSMHLP(ITTY,45,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
IVIDEO=0
1 WRITE(ITTY,2)
2 FORMAT(' Type your name as it is to appear at top of resume')
3 WRITE(ITTY,4)
4 FORMAT(' ? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.EQ.0)GO TO 8
IF(MAXBFR.LT.0)GO TO 6
LOWBFR=0
5 LOWBFR=LOWBFR+1
IF(LOWBFR.GT.MAXBFR)GO TO 10
IF(LTRBFR(LOWBFR).EQ.LTRSPA)GO TO 5
GO TO 10
6 WRITE(ITTY,7)
7 FORMAT(
1' Your name will appear exactly as you type it')
GO TO 1
8 WRITE(ITTY,9)
9 FORMAT(
1' You must supply your name')
GO TO 1
C
C START A NEW SECTION
10 IF(ISECTN.EQ.0)GO TO 14
IF(MAXSEC.GE.LMTSEC)GO TO 47
IF(KNTLIN.GE.LMTLIN)GO TO 47
MAXSEC=MAXSEC+1
LNGSEC(MAXSEC)=1
KNTTTL(MAXSEC)=0
KNTLIN=KNTLIN+1
LNGLIN(KNTLIN)=0
MARKER(KNTLIN)=0
J=0
DO 11 K=1,ISECTN
I=J+1
J=J+LNGPRE(K)
11 CONTINUE
DO 12 K=I,J
IF(MAXLTT.GE.LMTLTT)GO TO 13
MAXLTT=MAXLTT+1
KNTTTL(MAXSEC)=KNTTTL(MAXSEC)+1
LTRTTL(MAXLTT)=LTRPRE(K)
12 CONTINUE
13 ISECTN=0
C
C STORE THE LINE TYPED BY THE USER
14 I=0
IF(KNTLIN.LE.0)GO TO 16
DO 15 J=1,KNTLIN
IF(I.LT.MARKER(J))I=MARKER(J)
15 CONTINUE
16 KNTLIN=KNTLIN+1
MARKER(KNTLIN)=I+1
LNGLIN(KNTLIN)=MAXBFR-LOWBFR+1
LNGSEC(MAXSEC)=LNGSEC(MAXSEC)+1
17 DO 18 I=LOWBFR,MAXBFR
KNTTXT=KNTTXT+1
LTRTXT(KNTTXT)=LTRBFR(I)
18 CONTINUE
19 GO TO(20,22,22,22,22),IPASS
C
C GET ADDRESS
20 IPASS=2
ISECTN=2
WRITE(ITTY,21)
21 FORMAT(
1' Type your local address as it is to appear at top of resume.'/
2' Type a blank line when you have completed typing your address'/
31X)
22 GO TO(23,23,26,23,26),IPASS
23 IF(NEWPAS.EQ.0)WRITE(ITTY,24)
IF(NEWPAS.NE.0)WRITE(ITTY,25)
24 FORMAT(' First line of address? ',$)
25 FORMAT(' Next line of address? ',$)
GO TO 29
26 IF(NEWPAS.EQ.0)WRITE(ITTY,27)
27 FORMAT(' First phone number? ',$)
IF(NEWPAS.NE.0)WRITE(ITTY,28)
28 FORMAT(' Next phone number? ',$)
29 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 31
IF(MAXBFR.LE.0)GO TO 33
LOWBFR=0
30 LOWBFR=LOWBFR+1
IF(LOWBFR.GT.MAXBFR)GO TO 32
IF(LTRBFR(LOWBFR).EQ.LTRSPA)GO TO 30
GO TO 32
31 KNDMSG=28+IPASS+(4*NEWPAS)
CALL RSMHLP(ITTY,KNDMSG,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
GO TO 22
32 NEWPAS=1
GO TO 10
C
C PREPARE FOR ENTRY OF NEXT ITEM
33 IF(IPASS.EQ.2)WRITE(ITTY,34)
IF(IPASS.EQ.4)WRITE(ITTY,35)
34 FORMAT(' Have you finished your local address? ',$)
35 FORMAT(' Have you finished your permanent address? ',$)
IF(IPASS.EQ.3)WRITE(ITTY,36)
IF(IPASS.EQ.5)WRITE(ITTY,36)
36 FORMAT(' Have you finished supplying phone numbers? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(33,33,40,22,37),KNDYES
37 IF(IPASS.EQ.2)WRITE(ITTY,38)
IF(IPASS.EQ.4)WRITE(ITTY,38)
38 FORMAT(' Answer'/
1' YES if you do not want to add more lines to this address'/
2' NO if you typed a blank line by accident')
IF(IPASS.EQ.3)WRITE(ITTY,39)
IF(IPASS.EQ.5)WRITE(ITTY,39)
39 FORMAT(' Answer'/
1' YES if you do not want to add more phone numbers to the list'/
2' NO if you typed a blank line by accident')
GO TO 33
40 IPASS=IPASS+1
NEWPAS=0
GO TO(22,22,22,41,22,47),IPASS
C
C ASK USER IF A SECOND ADDRESS IS NEEDED
41 WRITE(ITTY,42)
42 FORMAT(
1' Do you want to include your permanent second address? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(41,41,45,46,43),KNDYES
43 WRITE(ITTY,44)
44 FORMAT(' Answer'/
1' YES to have your permanent address appear to the ',
2'right of your local address'/
3' NO if you do not want a include your permanent address')
GO TO 41
45 IPASS=4
ISECTN=3
GO TO 22
46 CONTINUE
C
C DONE WITH SECOND ADDRESS
47 RETURN
END
SUBROUTINE RSMTTL(KREATE,KNDTTL,NOWSEC,LMTLTT,MAXLTT,LTRTTL,
1LMTSEC,MAXSEC,KNTTTL,IDISK,ITTY,LMTBFR,LTRBFR,LWRBFR,LOWBFR,
2MAXBFR,LNGSEC,MARKER,LNGLIN,LMTLIN,KNTLIN,KNTTXT,IVIDEO)
C RENBR(/RECOGNIZE AND CREATE SECTION TITLES)
C
C DONALD BARTH, YALE SCHOOL OF MANAGMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C KREATE = 0, SELECT OLD TITLE
C = 1, CREATE NEW TITLE
C KNDTTL = 1, NONE TYPED
C = 2, PREVIOUSLY KNOWN TITLE TYPED
C = 3, NEW TITLE TYPED
C = 4, QUESTION MARK TYPED
C = 5, ERROR OR ANOTHER PROMPT NEEDED
C = 6, OVERFLOW OF STORAGE
C
C
C UPPER CASE A-Z, LOWER CASE A-Z AND DIGITS 0-9
COMMON/RSMFIV/LTRABC(26),LWRABC(26),LTRDGT(10)
C
DIMENSION LTRBFR(LMTBFR),
1LTRYES(5),LNGYES(2),LTRTTL(LMTLTT),KNTTTL(LMTSEC),LNGSEC(LMTSEC),
2MARKER(LMTLIN),LNGLIN(LMTLIN),
3LWRBFR(LMTBFR)
C LTRTTL = LETTERS OF THE SECTION TITLES
C KNTTTL = LENGTHS OF THE SECTION TITLES
C LMTLTT = DIMENSION OF LTRTTL ARRAY
C LMTSEC = DIMENSION OF KNTTTL ARRAY
C MAXLTT = NUMBER OF CHARACTERS IN LTRTTL ARRAY
C MAXSEC = NUMBER OF LENGTHS IN KNTTTL ARRAY
DATA LTRYES/1HY,1HE,1HS,1HN,1HO/
DATA LNGYES/3,2/
DATA LTRSPA,LTRQUE,LTRSTA,LTRUPA,LTRUND/
1 1H ,1H?,1H*,1H^,1H_/
C
C REMOVE ANY ZERO LENGTH SECTIONS
IRTSEC=0
ISECTN=0
MAXLTT=0
KUTSEC=MAXSEC
MAXSEC=0
KNTLIN=0
KPYLIN=0
1 ISECTN=ISECTN+1
IF(ISECTN.GT.KUTSEC)GO TO 4
KPYSEC=IRTSEC
IRTSEC=IRTSEC+KNTTTL(ISECTN)
INILIN=KPYLIN+1
KPYLIN=KPYLIN+LNGSEC(ISECTN)
IF(LNGSEC(ISECTN).LE.1)GO TO 1
DO 2 NOWLIN=INILIN,KPYLIN
KNTLIN=KNTLIN+1
MARKER(KNTLIN)=MARKER(NOWLIN)
LNGLIN(KNTLIN)=LNGLIN(NOWLIN)
2 CONTINUE
MAXSEC=MAXSEC+1
KNTTTL(MAXSEC)=KNTTTL(ISECTN)
LNGSEC(MAXSEC)=LNGSEC(ISECTN)
3 IF(KPYSEC.GE.IRTSEC)GO TO 1
KPYSEC=KPYSEC+1
MAXLTT=MAXLTT+1
LTRTTL(MAXLTT)=LTRTTL(KPYSEC)
GO TO 3
4 IF(MAXSEC.GT.0)GO TO 5
MAXLTT=0
MAXSEC=0
KNTLIN=0
KNTTXT=0
MAXSEC=MAXSEC+1
KNTTTL(MAXSEC)=0
LNGSEC(MAXSEC)=1
KNTLIN=KNTLIN+1
LNGLIN(KNTLIN)=0
MARKER(KNTLIN)=0
5 CONTINUE
C
C IF NOT CREATING SECTION, CHECK THAT THERE IS AT LEAST ONE
IF(KREATE.NE.0)GO TO 6
IF(MAXSEC.LE.1)GO TO 32
6 CONTINUE
C
C COMPACT OUT THE SPACES
I=LOWBFR-1
J=0
K=MAXBFR
MAXBFR=0
7 IF(I.GE.K)GO TO 10
I=I+1
LTRNOW=LTRBFR(I)
IF(LTRNOW.EQ.LTRSTA)GO TO 7
IF(LTRNOW.EQ.LTRUPA)GO TO 7
IF(LTRNOW.EQ.LTRUND)GO TO 7
IF(LTRNOW.NE.LTRSPA)GO TO 8
IF(MAXBFR.GT.0)J=1
GO TO 7
8 IF(J.EQ.0)GO TO 9
J=0
MAXBFR=MAXBFR+1
LTRBFR(MAXBFR)=LTRSPA
9 MAXBFR=MAXBFR+1
LTRBFR(MAXBFR)=LTRBFR(I)
GO TO 7
10 IF(MAXBFR.LE.0)GO TO 44
C
C CHECK FOR QUESTION MARK
IF(MAXBFR.NE.1)GO TO 11
IF(LTRBFR(1).EQ.LTRQUE)GO TO 36
11 CONTINUE
C
C GET ALTERNATE CASE OF ALPHABETIC LETTERS
DO 14 I=1,MAXBFR
LTRNOW=LTRBFR(I)
LWRBFR(I)=LTRNOW
IF(LTRNOW.EQ.LTRSPA)GO TO 14
DO 13 J=1,26
IF(LTRNOW.NE.LTRABC(J))GO TO 12
LWRBFR(I)=LWRABC(J)
GO TO 14
12 IF(LTRNOW.NE.LWRABC(J))GO TO 13
LWRBFR(I)=LTRABC(J)
GO TO 14
13 CONTINUE
14 CONTINUE
C
C CHECK FOR MATCH IN CURRENT DICTIONARY OF SECTION NAMES
INDEX=0
MATCH=0
15 LONGER=0
16 MATCH=MATCH+1
IF(MATCH.GT.MAXSEC)GO TO 20
I=INDEX
INDEX=INDEX+KNTTTL(MATCH)
J=0
17 I=I+1
J=J+1
IF(I.GT.INDEX)GO TO 19
IF(J.GT.MAXBFR)GO TO 18
IF(LTRBFR(J).EQ.LTRTTL(I))GO TO 17
IF(LWRBFR(J).EQ.LTRTTL(I))GO TO 17
GO TO 16
18 IF(LONGER.GT.MAXBFR)GO TO 16
IF(LONGER.EQ.MAXBFR)GO TO 15
LONGER=MAXBFR
LSTMCH=MATCH
LSTNDX=INDEX
GO TO 16
19 IF(J.LE.MAXBFR)GO TO 16
IF(KREATE.NE.0)GO TO 34
GO TO 45
20 IF(KREATE.NE.0)GO TO 22
IF(LONGER.EQ.0)GO TO 24
MATCH=LSTMCH
J=LSTNDX-KNTTTL(LSTMCH)+1
WRITE(ITTY,21)(LTRTTL(I),I=J,LSTNDX)
21 FORMAT(' Taken as abbreviation of section name: ',100A1)
GO TO 45
C
C ADD NEW SECTION
22 IF(MAXSEC.GE.LMTSEC)GO TO 26
IF((MAXLTT+MAXBFR).GT.LMTLTT)GO TO 30
IF(KNTLIN.GE.LMTLIN)GO TO 28
MAXSEC=MAXSEC+1
KNTTTL(MAXSEC)=0
DO 23 I=1,MAXBFR
MAXLTT=MAXLTT+1
LTRTTL(MAXLTT)=LTRBFR(I)
KNTTTL(MAXSEC)=KNTTTL(MAXSEC)+1
23 CONTINUE
LNGSEC(MAXSEC)=1
KNTLIN=KNTLIN+1
LNGLIN(KNTLIN)=0
MARKER(KNTLIN)=0
GO TO 46
C
C ERROR MESSAGES
24 WRITE(ITTY,25)
25 FORMAT(' Unknown section name')
GO TO 48
26 WRITE(ITTY,27)LMTSEC
27 FORMAT(' Limit of',1I4,' section names already in use')
GO TO 49
28 WRITE(ITTY,29)LMTLIN
29 FORMAT(' Limit of',1I4,' lines already in use')
GO TO 49
30 WRITE(ITTY,31)LMTLTT
31 FORMAT(' Limit of',1I4,' characters already in section names')
GO TO 49
32 WRITE(ITTY,33)
33 FORMAT(' No sections have been defined')
GO TO 49
34 WRITE(ITTY,35)
35 FORMAT(' This section already exists')
GO TO 48
C
C HELP MESSAGE
36 IF(KREATE.NE.0)GO TO 41
IF(MAXSEC.EQ.2)WRITE(ITTY,37)
37 FORMAT(' Type the following section name')
IF(MAXSEC.GT.2)WRITE(ITTY,38)
38 FORMAT(' Type one of the following section names')
J=0
DO 40 I=1,MAXSEC
K=J+1
J=J+KNTTTL(I)
IF(K.GT.J)GO TO 40
WRITE(ITTY,39)(LTRTTL(L),L=K,J)
39 FORMAT(1X,3X,100A1)
40 CONTINUE
GO TO 42
41 CALL RSMHLP(ITTY,47,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
42 WRITE(ITTY,43)
43 FORMAT(
1' or merely press the RETURN key to select another option')
GO TO 47
C
C RETURN TO CALLING PROGRAM
44 KNDTTL=1
GO TO 50
45 NOWSEC=MATCH
KNDTTL=2
GO TO 50
46 NOWSEC=MAXSEC
KNDTTL=3
GO TO 50
47 KNDTTL=4
GO TO 50
48 KNDTTL=5
GO TO 50
49 KNDTTL=6
50 RETURN
END
SUBROUTINE RSMTYP(ITTY,LMTTXT,LTRTXT,LMTLIN,LNGLIN,
1IFIRST,IFINAL,IUNDER,JFIRST,JFINAL)
C RENBR(/TYPE A SINGLE LINE OF RESUME)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN)
DATA LTRSPA,LTRMCH/1H ,1H+/
KFINAL=IFIRST-1
1 KFIRST=KFINAL+1
2 KFINAL=KFINAL+80
IF(KFINAL.GE.IFINAL)GO TO 5
MIDDLE=KFINAL+1
3 IF(MIDDLE.LE.KFIRST)GO TO 6
IF(LTRTXT(MIDDLE).EQ.1H )GO TO 4
MIDDLE=MIDDLE-1
GO TO 3
4 KFINAL=MIDDLE-1
GO TO 6
5 KFINAL=IFINAL
6 CONTINUE
WRITE(ITTY,7)(LTRTXT(I),I=KFIRST,KFINAL)
7 FORMAT(1X,80A1)
IF(IUNDER.EQ.0)GO TO 8
LFIRST=JFIRST
LFINAL=JFINAL
IF(LFIRST.LT.KFIRST)LFIRST=KFIRST
IF(LFINAL.GT.KFINAL)LFINAL=KFINAL
IF(LFIRST.GT.LFINAL)GO TO 8
J=LFIRST-KFIRST
K=LFINAL-LFIRST+1
IF(J.EQ.0)WRITE(ITTY,7)(LTRMCH,I=1,K)
IF(J.GT.0)WRITE(ITTY,7)(LTRSPA,I=1,J),(LTRMCH,I=1,K)
8 IF(KFINAL.GE.IFINAL)GO TO 9
KFINAL=KFINAL+1
IF(LTRTXT(KFINAL).EQ.1H )GO TO 8
KFINAL=KFINAL-1
GO TO 1
9 RETURN
END
SUBROUTINE RSMRNM(ITTY,NOWSEC,LMTLTT,MAXLTT,LTRTTL,
1LMTSEC,MAXSEC,KNTTTL,LMTBFR,LTRBFR,LWRBFR)
C RENBR(/RENAME AN EXISTING SECTION)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C UPPER CASE A-Z, LOWER CASE A-Z AND DIGITS 0-9
COMMON/RSMFIV/LTRABC(26),LWRABC(26),LTRDGT(10)
C
DIMENSION LTRBFR(LMTBFR),
1LTRYES(5),LNGYES(2),LTRTTL(LMTLTT),KNTTTL(LMTSEC),LWRBFR(LMTBFR)
C
C LTRTTL = LETTERS OF THE SECTION TITLES
C KNTTTL = LENGTHS OF THE SECTION TITLES
C LMTLTT = DIMENSION OF LTRTTL ARRAY
C LMTSEC = DIMENSION OF KNTTTL ARRAY
C MAXLTT = NUMBER OF CHARACTERS IN LTRTTL ARRAY
C MAXSEC = NUMBER OF LENGTHS IN KNTTTL ARRAY
DATA LTRYES/1HY,1HE,1HS,1HN,1HO/
DATA LNGYES/3,2/
DATA LTRSPA,LTRUPA,LTRSTA,LTRUND/1H ,1H^,1H*,1H_/
C
C GET SECTION NAME
1 WRITE(ITTY,2)
2 FORMAT(' Change section name to? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 21
IF(MAXBFR.EQ.0)GO TO 23
C
C COMPACT OUT THE SPACES
I=0
J=0
K=MAXBFR
MAXBFR=0
3 IF(I.GE.K)GO TO 6
I=I+1
LTRNOW=LTRBFR(I)
IF(LTRNOW.EQ.LTRSTA)GO TO 3
IF(LTRNOW.EQ.LTRUPA)GO TO 3
IF(LTRNOW.EQ.LTRUND)GO TO 3
IF(LTRNOW.NE.LTRSPA)GO TO 4
IF(MAXBFR.GT.0)J=1
GO TO 3
4 IF(J.EQ.0)GO TO 5
J=0
MAXBFR=MAXBFR+1
LTRBFR(MAXBFR)=LTRSPA
5 MAXBFR=MAXBFR+1
LTRBFR(MAXBFR)=LTRBFR(I)
GO TO 3
6 IF(MAXBFR.LE.0)GO TO 23
C
C CHECK FOR QUESTION MARK
7 CONTINUE
C
C GET ALTERNATE CASE OF ALPHABETIC LETTERS
DO 10 I=1,MAXBFR
LTRNOW=LTRBFR(I)
LWRBFR(I)=LTRNOW
DO 9 J=1,26
IF(LTRNOW.NE.LTRABC(J))GO TO 8
LWRBFR(I)=LWRABC(J)
GO TO 10
8 IF(LTRNOW.NE.LWRABC(J))GO TO 9
LWRBFR(I)=LTRABC(J)
GO TO 10
9 CONTINUE
10 CONTINUE
C
C CHECK FOR DUPLICATE NAME
NEWSEC=0
LOCSEC=0
11 NEWSEC=NEWSEC+1
INISEC=LOCSEC+1
LOCSEC=LOCSEC+KNTTTL(NEWSEC)
IF(INISEC.GT.LOCSEC)GO TO 14
IF(NEWSEC.EQ.NOWSEC)GO TO 14
IF(MAXBFR.NE.KNTTTL(NEWSEC))GO TO 14
J=0
DO 12 I=INISEC,LOCSEC
J=J+1
IF(LTRBFR(J).EQ.LTRTTL(I))GO TO 12
IF(LWRBFR(J).EQ.LTRTTL(I))GO TO 12
GO TO 14
12 CONTINUE
WRITE(ITTY,13)
13 FORMAT(' RENAME cancelled, name already in use')
GO TO 25
14 IF(NEWSEC.LT.LMTSEC)GO TO 11
C
C FIND OLD NAME
NEWSEC=0
LOCSEC=0
15 NEWSEC=NEWSEC+1
INISEC=LOCSEC
LOCSEC=LOCSEC+KNTTTL(NEWSEC)
IF(NEWSEC.LT.NOWSEC)GO TO 15
MAXLTT=MAXLTT-KNTTTL(NOWSEC)
C
C REMOVE OLD NAME
I=INISEC
16 IF(I.GE.MAXLTT)GO TO 17
I=I+1
LOCSEC=LOCSEC+1
LTRTTL(I)=LTRTTL(LOCSEC)
GO TO 16
C
C MAKE ROOM FOR NEW NAME
17 MAXLTT=MAXLTT+MAXBFR
J=MAXLTT
18 IF(I.LE.INISEC)GO TO 19
LTRTTL(J)=LTRTTL(I)
I=I-1
J=J-1
GO TO 18
C
C INSERT NEW NAME
19 DO 20 I=1,MAXBFR
INISEC=INISEC+1
LTRTTL(INISEC)=LTRBFR(I)
20 CONTINUE
KNTTTL(NEWSEC)=MAXBFR
GO TO 25
C
C HELP MESSAGE
21 WRITE(ITTY,22)
22 FORMAT(' Type the name which is to replace the old name'/
1' or merely hit the carriage return to retain the old name')
GO TO 1
23 WRITE(ITTY,24)
24 FORMAT(' Original name retained')
GO TO 25
C
C RETURN TO CALLING PROGRAM
25 RETURN
END
SUBROUTINE RSMRAW(NOWSEC,ITTY,LTRTXT,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL,
3MAXBFR,LMTBFR,LTRBFR,IVIDEO,LNGCRT)
C RENBR(/DISPLAY LINES OF RESUME AS ENTERED BY STUDENT)
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(LMTBFR)
DATA LTRSPA/1H /
MAXBFR=0
ISHOWN=0
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
IF(NOWSEC.EQ.0)GO TO 1
IF(NEWSEC.LT.NOWSEC)GO TO 23
IF(NEWSEC.GT.NOWSEC)GO TO 24
1 IF(LEGEND.NE.0)GO TO 9
LEGEND=1
IF(INISEC.GT.MRKSEC)GO TO 9
IF(IVIDEO.LT.0)GO TO 6
IF(ISHOWN.LT.LNGCRT)GO TO 6
2 WRITE(ITTY,3)
3 FORMAT(1X/' (press RETURN to continue)',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.EQ.0)GO TO 5
IF(MAXBFR.GT.0)GO TO 26
WRITE(ITTY,4)
4 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 2
5 ISHOWN=0
6 IF(ISHOWN.NE.0)GO TO 7
IF(IVIDEO.GT.0)CALL RSMWIP(ITTY)
7 ISHOWN=ISHOWN+1
WRITE(ITTY,8)(LTRTTL(I),I=INISEC,MRKSEC)
8 FORMAT(1X,100A1)
C
C WRITE OUT THE LINE
9 IFIRST=MINPRT
10 IFINAL=IFIRST+76
IF(IFINAL.GT.MAXPRT)GO TO 14
11 IF(IFINAL.LE.IFIRST)GO TO 13
IF(LTRTXT(IFINAL).EQ.1H )GO TO 12
IFINAL=IFINAL-1
GO TO 11
12 IFINAL=IFINAL-1
IF(IFINAL.GE.IFIRST)GO TO 15
13 IFINAL=IFIRST+76-1
GO TO 15
14 IFINAL=MAXPRT
15 IF(IVIDEO.LT.0)GO TO 18
IF(ISHOWN.LT.LNGCRT)GO TO 18
16 WRITE(ITTY,3)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.EQ.0)GO TO 17
IF(MAXBFR.GT.0)GO TO 26
WRITE(ITTY,4)
GO TO 16
17 ISHOWN=0
18 IF(ISHOWN.NE.0)GO TO 19
IF(IVIDEO.GT.0)CALL RSMWIP(ITTY)
19 ISHOWN=ISHOWN+1
IF(IFIRST.EQ.MINPRT)WRITE(ITTY,20)MARKER(NOWLIN),
1(LTRTXT(I),I=IFIRST,IFINAL)
20 FORMAT(1X,1I3,1X,100A1)
IF(IFIRST.GT.MINPRT)WRITE(ITTY,21)(LTRTXT(I),I=IFIRST,IFINAL)
21 FORMAT(1X,4X,100A1)
KNTPRT=KNTPRT+1
IF(IFINAL.GE.MAXPRT)GO TO 23
IFIRST=IFINAL
IFINAL=MAXPRT
22 IFIRST=IFIRST+1
IF(IFIRST.GT.MAXPRT)GO TO 23
IF(LTRTXT(IFIRST).EQ.1H )GO TO 22
GO TO 10
23 CONTINUE
24 CONTINUE
WRITE(ITTY,25)
25 FORMAT(1X)
GO TO 26
C
C RETURN TO CALLING PROGRAM
26 RETURN
END
SUBROUTINE RSMMOV(NOWSEC,MOVSEC,LTRTXT,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL)
C RENBR(/MOVE SECTION IN 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)
C
C FIND LOCATION OF LETTERS IN SECTION TO BE MOVED
IFIRST=1
IFINAL=0
KFIRST=1
KFINAL=0
NEWSEC=1
1 IF(NEWSEC.GT.MOVSEC)GO TO 4
IF(LNGSEC(NEWSEC).LE.0)GO TO 3
IFIRST=IFINAL+1
KFIRST=KFINAL+1
KFINAL=KFINAL+LNGSEC(NEWSEC)
DO 2 NEWLIN=KFIRST,KFINAL
IFINAL=IFINAL+LNGLIN(NEWLIN)
2 CONTINUE
3 NEWSEC=NEWSEC+1
GO TO 1
C
C FIND LOCATION OF LETTERS IN SECTION TO BE KEPT IN PLACE
4 JFIRST=1
JFINAL=0
LFIRST=1
LFINAL=0
NEWSEC=1
5 IF(NEWSEC.GT.NOWSEC)GO TO 8
IF(LNGSEC(NEWSEC).LE.0)GO TO 7
JFIRST=JFINAL+1
LFIRST=LFINAL+1
LFINAL=LFINAL+LNGSEC(NEWSEC)
DO 6 NEWLIN=LFIRST,LFINAL
JFINAL=JFINAL+LNGLIN(NEWLIN)
6 CONTINUE
7 NEWSEC=NEWSEC+1
GO TO 5
C
C PERFORM THE SWAP OF CHARACTERS
8 MIN=IFIRST
MID=IFINAL
MAX=JFIRST-1
IF(IFIRST.LT.JFINAL)GO TO 9
MIN=JFIRST
MID=IFIRST-1
MAX=IFINAL
9 CALL DASWAP(LTRTXT,MIN,MID,MAX)
C
C PERFORM THE SWAP OF LINE LENGTHS AND LINE NUMBERS
MIN=KFIRST
MID=KFINAL
MAX=LFIRST-1
IF(KFIRST.LT.LFINAL)GO TO 10
MIN=LFIRST
MID=KFIRST-1
MAX=KFINAL
10 CALL DASWAP(LNGLIN,MIN,MID,MAX)
CALL DASWAP(MARKER,MIN,MID,MAX)
C
C PERFORM THE SWAP OF SECTION LENGTHS
C
C FIND LOCATION OF NAME OF SECTION TO BE MOVED
11 IFIRST=1
IFINAL=0
NEWSEC=1
12 IF(NEWSEC.GT.MOVSEC)GO TO 13
IFIRST=IFINAL+1
IFINAL=IFINAL+KNTTTL(NEWSEC)
NEWSEC=NEWSEC+1
GO TO 12
C
C FIND LOCATION OF NAME OF SECTION TO BE KEPT IN PLACE
13 JFIRST=1
JFINAL=0
NEWSEC=1
14 IF(NEWSEC.GT.NOWSEC)GO TO 15
JFIRST=JFINAL+1
JFINAL=JFINAL+KNTTTL(NEWSEC)
NEWSEC=NEWSEC+1
GO TO 14
C
C PERFORM THE SWAP OF NAMES
15 MIN=IFIRST
MID=IFINAL
MAX=JFIRST-1
IF(IFIRST.LT.JFINAL)GO TO 16
MIN=JFIRST
MID=IFIRST-1
MAX=IFINAL
16 CALL DASWAP(LTRTTL,MIN,MID,MAX)
C
C SWAP SECTION NAME LENTHS AND SECTION LINE LENGTHS
MIN=MOVSEC
MID=MOVSEC
MAX=NOWSEC-1
IF(MOVSEC.LT.NOWSEC)GO TO 17
MIN=NOWSEC
MID=MOVSEC-1
MAX=MOVSEC
17 CALL DASWAP(KNTTTL,MIN,MID,MAX)
CALL DASWAP(LNGSEC,MIN,MID,MAX)
RETURN
END
SUBROUTINE RSMPUT(LTRBFR,LMTBFR,LINE,LTRTXT,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MAXSEC,LMTSEC,MARKER,ITTY,IFTELL)
C RENBR(/INSERT NEW LINE OF TEXT INTO 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),
1LTRBFR(LMTBFR),MARKER(LMTLIN)
C
C FIND EXTENT OF LINE
LOCLIN=LINE+1
MAXBFR=LMTBFR
1 IF(MAXBFR.LE.0)GO TO 2
IF(LTRBFR(MAXBFR).NE.1H )GO TO 2
MAXBFR=MAXBFR-1
GO TO 1
2 CONTINUE
IFINAL=0
3 IFIRST=IFINAL+1
4 IFINAL=IFINAL+76
IF(IFINAL.GE.MAXBFR)GO TO 7
MIDDLE=IFINAL+1
5 IF(MIDDLE.LE.IFIRST)GO TO 8
IF(LTRBFR(MIDDLE).EQ.1H )GO TO 6
MIDDLE=MIDDLE-1
GO TO 5
6 IFINAL=MIDDLE-1
GO TO 8
7 IFINAL=MAXBFR
8 CONTINUE
IF(LINE.LT.KNTLIN)GO TO 10
IF(LINE.GE.LMTLIN)GO TO 25
C
C NEW LINE IS ABOVE CURRENT STORAGE
LNGSEC(MAXSEC)=LNGSEC(MAXSEC)+LINE-KNTLIN+1
INDEX0=KNTLIN
KNTLIN=LINE+1
9 INDEX0=INDEX0+1
LNGLIN(INDEX0)=0
MARKER(INDEX0)=0
IF(INDEX0.GT.LINE)GO TO 14
GO TO 9
C
C DETERMINE WHETHER MUST EXPAND LINE STORAGE
10 IF(KNTLIN.GE.LMTLIN)GO TO 25
KNTLIN=KNTLIN+1
INDEX0=KNTLIN
11 IF(INDEX0.LE.LINE)GO TO 12
LNGLIN(INDEX0)=LNGLIN(INDEX0-1)
MARKER(INDEX0)=MARKER(INDEX0-1)
INDEX0=INDEX0-1
GO TO 11
12 LNGLIN(LINE+1)=0
MARKER(LINE+1)=0
INDEX0=0
DO 13 I=1,MAXSEC
INDEX0=INDEX0+LNGSEC(I)
IF(INDEX0.LT.LINE)GO TO 13
LNGSEC(I)=LNGSEC(I)+1
GO TO 14
13 CONTINUE
LNGSEC(MAXSEC)=LNGSEC(MAXSEC)+1
C
C INSERT NEW LINE
14 IF(IFIRST.GT.IFINAL)GO TO 25
IF((IFINAL-IFIRST+1).GT.(LMTTXT-KNTTXT))GO TO 25
LNGLIN(LINE+1)=IFINAL-IFIRST+1
MARKER(LINE+1)=0
INDEX0=0
DO 15 I=1,KNTLIN
IF(MARKER(I).GT.INDEX0)INDEX0=MARKER(I)
15 CONTINUE
MARKER(LINE+1)=INDEX0+1
INDEX0=0
INDEX2=1
16 IF(INDEX2.GE.LINE+1)GO TO 17
INDEX0=INDEX0+LNGLIN(INDEX2)
INDEX2=INDEX2+1
GO TO 16
17 INDEX1=KNTTXT
KNTTXT=KNTTXT+IFINAL-IFIRST+1
INDEX2=KNTTXT
18 IF(INDEX1.LE.INDEX0)GO TO 19
LTRTXT(INDEX2)=LTRTXT(INDEX1)
INDEX1=INDEX1-1
INDEX2=INDEX2-1
GO TO 18
19 DO 20 I=IFIRST,IFINAL
INDEX0=INDEX0+1
LTRTXT(INDEX0)=LTRBFR(I)
20 CONTINUE
C
C CHECK IF ANOTHER LINE MUST BE ADDED
21 IF(IFINAL.GE.MAXBFR)GO TO 22
IFINAL=IFINAL+1
IF(LTRBFR(IFINAL).EQ.1H )GO TO 21
IFINAL=IFINAL-1
LINE=LINE+1
GO TO 3
22 IF(IFTELL.EQ.0)GO TO 25
I=LINE+1
IF(LOCLIN.EQ.I)WRITE(ITTY,23)MARKER(I)
IF(LOCLIN.LT.I)WRITE(ITTY,24)MARKER(LOCLIN),MARKER(I)
23 FORMAT(' Inserting line',1I5)
24 FORMAT(' Inserting lines',1I5,' through',1I5)
C
C RETURN TO CALLING PROGRAM
25 RETURN
END
SUBROUTINE RSMRUL(LTRBFR,LMTBFR,LINE,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL)
C RENBR(/SPLIT SECTION INTO TWO SECTIONS)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
DIMENSION LTRBFR(LMTBFR),LNGLIN(LMTLIN),LNGSEC(LMTSEC),
1MARKER(LMTLIN),LTRTTL(LMTLTT),KNTTTL(LMTSEC)
C
C IDENTIFY THE SECTION CONTAINING THE SPECIFIED LINE
KUTSEC=0
MSTSEC=0
1 KUTSEC=KUTSEC+1
MSTSEC=MSTSEC+LNGSEC(KUTSEC)
IF(LINE.GT.MSTSEC)GO TO 1
KUTSEC=KUTSEC+1
C
C MOVE THE NAME TO INSIDE OF LIST
IF(KUTSEC.EQ.MAXSEC)GO TO 10
I=0
J=0
2 I=I+1
IF(I.GE.KUTSEC)GO TO 3
J=J+KNTTTL(I)
GO TO 2
3 K=J
4 IF(I.GE.MAXSEC)GO TO 5
K=K+KNTTTL(I)
I=I+1
GO TO 4
5 L=J+KNTTTL(MAXSEC)
M=K
N=KNTTTL(MAXSEC)
DO 6 I=1,N
M=M+1
LTRBFR(I)=LTRTTL(M)
6 CONTINUE
7 LTRTTL(M)=LTRTTL(K)
M=M-1
K=K-1
IF(K.GT.J)GO TO 7
8 LTRTTL(M)=LTRBFR(N)
M=M-1
N=N-1
IF(M.GT.J)GO TO 8
N=KNTTTL(MAXSEC)
M=MAXSEC
9 KNTTTL(M)=KNTTTL(M-1)
LNGSEC(M)=LNGSEC(M-1)
M=M-1
IF(M.GT.KUTSEC)GO TO 9
KNTTTL(KUTSEC)=N
10 LNGSEC(KUTSEC-1)=LNGSEC(KUTSEC-1)-MSTSEC+LINE-1
LNGSEC(KUTSEC)=MSTSEC-LINE+2
C
C INSERT AN EMPTY LINE AT START OF NEW SECTION
KNTLIN=KNTLIN+1
M=KNTLIN
11 IF(M.LE.LINE)GO TO 12
LNGLIN(M)=LNGLIN(M-1)
MARKER(M)=MARKER(M-1)
M=M-1
GO TO 11
12 LNGLIN(LINE)=0
MARKER(LINE)=0
RETURN
END
SUBROUTINE RSMMRG(LTRBFR,LMTBFR,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL,NOWSEC)
C RENBR(/MERGE TWO SECTIONS INTO ONE)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
DIMENSION LTRBFR(LMTBFR),LNGLIN(LMTLIN),LNGSEC(LMTSEC),
1MARKER(LMTLIN),LTRTTL(LMTLTT),KNTTTL(LMTSEC)
C
C LOCATE THE LINE NUMBER AT START OF SECTION
LINE=0
I=0
1 I=I+1
IF(I.GE.NOWSEC)GO TO 2
LINE=LINE+LNGSEC(I)
GO TO 1
2 CONTINUE
C
C REMOVE THE BLANK LINE AT START OF SECTION
3 LINE=LINE+1
IF(LINE.GE.KNTLIN)GO TO 4
LNGLIN(LINE)=LNGLIN(LINE+1)
MARKER(LINE)=MARKER(LINE+1)
GO TO 3
4 KNTLIN=KNTLIN-1
C
C LOCATE THE SECTION NAME
J=0
I=0
5 I=I+1
IF(I.GE.NOWSEC)GO TO 6
J=J+KNTTTL(I)
GO TO 5
6 K=J+KNTTTL(I)
7 J=J+1
K=K+1
IF(K.GT.MAXLTT)GO TO 8
LTRTTL(J)=LTRTTL(K)
GO TO 7
8 MAXLTT=MAXLTT-KNTTTL(NOWSEC)
C
C REMOVE THE SECTION NAME
LNGSEC(NOWSEC-1)=LNGSEC(NOWSEC-1)+LNGSEC(NOWSEC)-1
I=NOWSEC
9 IF(I.GE.MAXSEC)GO TO 10
KNTTTL(I)=KNTTTL(I+1)
LNGSEC(I)=LNGSEC(I+1)
I=I+1
GO TO 9
10 MAXSEC=MAXSEC-1
NOWSEC=0
RETURN
END
SUBROUTINE RSMEDT(LINE,LTRTXT,LNGLIN,LNGSEC,LMTSEC,MAXSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,ITTY,IERROR,LTRWID,LMTWID,MARKER,
2IXYZZY,IVIDEO,JVIDEO,KNTATO)
C RENBR(/EDIT A LINE IN RESUME)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C IERROR = 0, RETURNED IF SUCCESS
C = 1, DELETE LINE
C
C UPPER CASE A-Z, LOWER CASE A-Z AND DIGITS 0-9
COMMON/RSMFIV/LTRABC(26),LWRABC(26),LTRDGT(10)
C
DIMENSION LTREDT(104),KNTEDT(19),KNDEDT(19),
1LTRBFR(80),LWRBFR(80)
DIMENSION LTRATT(17),KNTATT(2)
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN),LTRWID(LMTWID),
1LNGSEC(LMTSEC),MARKER(LMTLIN)
DATA LTREDT/
11HB,1HE,1HF,1HO,1HR,1HE,
21HA,1HF,1HT,1HE,1HR,
31HD,1HE,1HL,1HE,1HT,1HE,
41HC,1HH,1HA,1HN,1HG,1HE,
51HP,1HR,1HE,1HF,1HI,1HX,
61HS,1HU,1HF,1HF,1HI,1HX,
71HN,1HE,1HX,1HT,
81HH,1HE,1HA,1HD,
91HT,1HA,1HI,1HL,
11HR,1HE,1HP,1HL,1HA,1HC,1HE,
21HS,1HP,1HA,1HC,1HE,
31HB,1HR,1HE,1HA,1HK,
41HB,1HU,1HL,1HL,1HE,1HT,
51HB,1HO,1HL,1HD,
61HU,1HN,1HD,1HE,1HR,1HL,1HI,1HN,1HE,
71HN,1HO,1HR,1HM,1HA,1HL,
81HU,1HP,1HP,1HE,1HR,
91HL,1HO,1HW,1HE,1HR,
11HM,1HI,1HX,1HE,1HD/
DATA KNTEDT/6,5,6,6,6,6,4,4,4,7,5,5,6,4,9,6,5,5,5/
DATA KNDEDT/1,1,0,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0/
DATA LMTLED,LMTKED/104,19/
DATA LTRSPA,LTRSTA,LTRUPA,LTRUND,LTRMIN/
1 1H ,1H*,1H^,1H_,1H-/
DATA LMTBFR/80/
DATA LTRATT/
11HA,1HT,1HT,1HA,1HC,1HH,1HE,1HD,
21HS,1HE,1HP,1HA,1HR,1HA,1HT,1HE,1HD/
DATA KNTATT/8,9/
DATA LMTLAT,LMTKAT/17,2/
C
IERROR=0
IF(LINE.GT.KNTLIN)GO TO 140
IF(LNGLIN(LINE).LE.0)GO TO 140
C
C LOCATE THE LINE
IFINAL=0
INDEX0=1
1 IF(INDEX0.GT.LINE)GO TO 3
IFIRST=IFINAL+1
IFINAL=IFINAL+LNGLIN(INDEX0)
INDEX0=INDEX0+1
GO TO 1
C
C REDISPLAY LINE AFTER GIVING NULL TARGET
2 CALL RSMTYP(ITTY,LMTTXT,LTRTXT,LMTLIN,LNGLIN,
1IFIRST,IFINAL,0,JFIRST,JFINAL)
C
C FIND WHAT IS TO BE SEARCHED FOR
3 INITAL=IFIRST
WRITE(ITTY,4)
4 FORMAT(' Search for? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 8
5 MAXTGT=MAXBFR
6 LOWBFR=0
7 LOWBFR=LOWBFR+1
IF(LOWBFR.GT.MAXBFR)GO TO 9
IF(LTRBFR(LOWBFR).EQ.LTRSPA)GO TO 7
GO TO 9
8 IVIDEO=JVIDEO
CALL RSMHLP(ITTY,7,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
IVIDEO=0
IF(MAXBFR.LE.0)GO TO 2
GO TO 5
9 IF(MAXBFR.LE.0)GO TO 133
DO 12 I=1,MAXBFR
LTRNOW=LTRBFR(I)
LWRBFR(I)=LTRNOW
DO 11 J=1,26
IF(LTRNOW.EQ.LTRABC(J))GO TO 10
IF(LTRNOW.EQ.LWRABC(J))GO TO 10
GO TO 11
10 LTRBFR(I)=LTRABC(J)
LWRBFR(I)=LWRABC(J)
GO TO 12
11 CONTINUE
12 CONTINUE
C
C SEARCH FOR THE ITEM IN LINE
IF(INITAL.GT.IFINAL)GO TO 133
DO 21 INDEX1=INITAL,IFINAL
JFINAL=INDEX1
INDEX0=LOWBFR
13 IF(LTRTXT(JFINAL).NE.LTRSPA)GO TO 16
IF(LTRBFR(INDEX0).NE.LTRSPA)GO TO 21
14 IF(JFINAL.GE.IFINAL)GO TO 21
JFINAL=JFINAL+1
IF(LTRTXT(JFINAL).EQ.LTRSPA)GO TO 14
15 IF(INDEX0.GE.MAXBFR)GO TO 21
INDEX0=INDEX0+1
IF(LTRBFR(INDEX0).EQ.LTRSPA)GO TO 15
GO TO 18
16 IF(LTRTXT(JFINAL).EQ.LTRUPA)GO TO 17
IF(LTRTXT(JFINAL).EQ.LTRUND)GO TO 17
IF(LTRBFR(INDEX0).EQ.LTRSPA)GO TO 21
GO TO 18
17 IF(LTRBFR(INDEX0).EQ.LTRSPA)GO TO 19
18 IF(LTRTXT(JFINAL).EQ.LTRBFR(INDEX0))GO TO 20
IF(LTRTXT(JFINAL).EQ.LWRBFR(INDEX0))GO TO 20
IF(LTRTXT(JFINAL).EQ.LTRUPA)GO TO 19
IF(LTRTXT(JFINAL).EQ.LTRUND)GO TO 19
GO TO 21
19 IF(INDEX0.EQ.LOWBFR)GO TO 21
INDEX0=INDEX0-1
20 IF(INDEX0.GE.MAXBFR)GO TO 23
IF(JFINAL.GE.IFINAL)GO TO 21
JFINAL=JFINAL+1
INDEX0=INDEX0+1
GO TO 13
21 CONTINUE
WRITE(ITTY,22)
22 FORMAT(' No match found')
GO TO 3
C
C REVERSE DIRECTION OF SEARCH TO TRIM OF EXTRA LEADING
C FLAG CHARACTERS AT START OF ITEM FOUND.
23 JFIRST=JFINAL
24 IF(LTRTXT(JFIRST).NE.LTRSPA)GO TO 27
25 JFIRST=JFIRST-1
IF(LTRTXT(JFIRST).EQ.LTRSPA)GO TO 25
26 INDEX0=INDEX0-1
IF(LTRBFR(INDEX0).EQ.LTRSPA)GO TO 26
GO TO 29
27 IF(LTRTXT(JFIRST).EQ.LTRUPA)GO TO 28
IF(LTRTXT(JFIRST).EQ.LTRUND)GO TO 28
GO TO 29
28 IF(LTRBFR(INDEX0).EQ.LTRSPA)GO TO 30
29 IF(LTRTXT(JFIRST).EQ.LTRBFR(INDEX0))GO TO 31
IF(LTRTXT(JFIRST).EQ.LWRBFR(INDEX0))GO TO 31
30 INDEX0=INDEX0+1
31 IF(INDEX0.LE.LOWBFR)GO TO 32
JFIRST=JFIRST-1
INDEX0=INDEX0-1
GO TO 24
C
C DISPLAY THE MATCHED CHARACTERS IN CONTEXT
32 CALL RSMTYP(ITTY,LMTTXT,LTRTXT,LMTLIN,LNGLIN,
1IFIRST,IFINAL,1,JFIRST,JFINAL)
C
C GET NEXT OPTION
GO TO 34
33 IF(MAXBFR.GT.0)GO TO 36
34 WRITE(ITTY,35)
35 FORMAT(' Edit how? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
36 IF(MAXBFR.LT.0)GO TO 106
IF(MAXBFR.EQ.0)GO TO 40
LOWBFR=1
CALL DAVERB(1,LMTLED,LTREDT,1,LMTKED,
1KNTEDT,LTRBFR,LMTBFR,LOWBFR,KIND,MATCH,LCNWRD,
2LCNKNT,LCNBFR)
GO TO(133,38,37,37,38),KIND
37 IF(LOWBFR.GT.LMTBFR)GO TO 42
IF(LTRBFR(LOWBFR).NE.LTRSPA)GO TO 38
LOWBFR=LOWBFR+1
GO TO 37
38 WRITE(ITTY,39)
39 FORMAT(' Type ? for help')
GO TO 34
40 WRITE(ITTY,41)
41 FORMAT(' No changes have been made')
GO TO 133
42 IF(KNDEDT(MATCH).EQ.0)GO TO 63
C
C ASK IF INSERTION IS ATTACHED OR NOT
IF(MATCH.EQ.1)GO TO 43
IF(MATCH.EQ.2)GO TO 43
GO TO 52
43 WRITE(ITTY,44)
44 FORMAT(' Attached or Separate? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 48
IF(MAXBFR.EQ.0)GO TO 49
LOWBFR=1
CALL DAVERB(1,LMTLAT,LTRATT,1,LMTKAT,
1KNTATT,LTRBFR,LMTBFR,LOWBFR,KIND,IREFIN,LCNWRD,
2LCNKNT,LCNBFR)
GO TO(133,46,45,45,46),KIND
45 IF(LOWBFR.GT.LMTBFR)GO TO 51
IF(LTRBFR(LOWBFR).NE.LTRSPA)GO TO 46
LOWBFR=LOWBFR+1
GO TO 45
46 WRITE(ITTY,47)
47 FORMAT(' Type ? for help')
GO TO 43
48 CALL RSMHLP(ITTY,63,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
GO TO 43
49 WRITE(ITTY,50)
50 FORMAT(' No changes have been made')
GO TO 133
51 IF(IREFIN.EQ.2)GO TO 52
IF(MATCH.EQ.1)MATCH=5
IF(MATCH.EQ.2)MATCH=6
52 CONTINUE
C
C TEXT TO BE INSERTED
IF(MATCH.EQ.1)WRITE(ITTY,53)
53 FORMAT(' Insert what before')
IF(MATCH.EQ.2)WRITE(ITTY,54)
54 FORMAT(' Insert what after')
IF(MATCH.EQ.4)WRITE(ITTY,55)
55 FORMAT(' Change to what')
IF(MATCH.EQ.5)WRITE(ITTY,56)
56 FORMAT(' Attach what as prefix')
IF(MATCH.EQ.6)WRITE(ITTY,57)
57 FORMAT(' Attach what as suffix')
IF(MATCH.EQ.10)WRITE(ITTY,58)
58 FORMAT(' Replace by what')
59 WRITE(ITTY,60)
60 FORMAT(' ?',$)
CALL GETLIN(ITTY,LTRWID,LMTWID,MAXBFR)
IF(MAXBFR.LT.0)GO TO 62
LOWBFR=0
61 LOWBFR=LOWBFR+1
IF(LOWBFR.GT.MAXBFR)GO TO 133
IF(LTRWID(LOWBFR).EQ.LTRSPA)GO TO 61
GO TO 63
62 IHELP=MATCH+7
CALL RSMHLP(ITTY,IHELP,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
GO TO 59
C
C PERFORM OPERATION
C GO TO(AFT,BEF,CHA,DEL,NEX,PRE,SUF,?
63 GO TO(121,122,109,111,123,124,107,93,94,111,
1120,115,116,64,64,64,76,76,76),MATCH
C
C BOLD OR UNDERLINE OR NORMAL
64 LOWBFR=1
MAXBFR=0
65 IF(JFIRST.LE.IFIRST)GO TO 69
LTRNOW=LTRTXT(JFIRST-1)
IF(LTRNOW.EQ.LTRSPA)GO TO 66
IF(LTRNOW.EQ.LTRUPA)GO TO 66
IF(LTRNOW.EQ.LTRUND)GO TO 66
GO TO 67
66 JFIRST=JFIRST-1
GO TO 65
67 IPRINT=1
DO 68 I=1,26
IF(LTRNOW.EQ.LTRABC(I))GO TO 70
IF(LTRNOW.EQ.LWRABC(I))GO TO 70
68 CONTINUE
69 IPRINT=0
70 KFIRST=JFIRST
71 IF(KFIRST.GT.JFINAL)GO TO 75
LTRNOW=LTRTXT(KFIRST)
IF(LTRNOW.EQ.LTRSPA)GO TO 72
IF(LTRNOW.EQ.LTRUPA)GO TO 74
IF(LTRNOW.EQ.LTRUND)GO TO 74
IF(IPRINT.NE.0)GO TO 73
IF(MAXBFR.GE.LMTWID)GO TO 75
IPRINT=1
IF(MATCH.EQ.16)GO TO 73
MAXBFR=MAXBFR+1
IF(MATCH.EQ.14)LTRWID(MAXBFR)=LTRUPA
IF(MATCH.EQ.15)LTRWID(MAXBFR)=LTRUND
GO TO 73
72 IPRINT=0
73 IF(MAXBFR.GE.LMTWID)GO TO 75
MAXBFR=MAXBFR+1
LTRWID(MAXBFR)=LTRNOW
74 KFIRST=KFIRST+1
GO TO 71
75 GO TO 111
C
C UPPER OR LOWER OR MIXED
76 LOWBFR=1
MAXBFR=0
77 IF(JFIRST.LE.IFIRST)GO TO 81
LTRNOW=LTRTXT(JFIRST-1)
IF(LTRNOW.EQ.LTRSPA)GO TO 78
IF(LTRNOW.EQ.LTRUPA)GO TO 78
IF(LTRNOW.EQ.LTRUND)GO TO 78
GO TO 79
78 JFIRST=JFIRST-1
GO TO 77
79 IPRINT=1
DO 80 I=1,26
IF(LTRNOW.EQ.LTRABC(I))GO TO 82
IF(LTRNOW.EQ.LWRABC(I))GO TO 82
80 CONTINUE
81 IPRINT=0
82 KFIRST=JFIRST
83 IF(KFIRST.GT.JFINAL)GO TO 91
LTRNOW=LTRTXT(KFIRST)
IF(LTRNOW.EQ.LTRSPA)GO TO 88
IF(LTRNOW.EQ.LTRUPA)GO TO 89
IF(LTRNOW.EQ.LTRUND)GO TO 89
LETTER=0
84 LETTER=LETTER+1
IF(LETTER.GT.26)GO TO 89
IF(LTRNOW.EQ.LTRABC(LETTER))GO TO 85
IF(LTRNOW.EQ.LWRABC(LETTER))GO TO 85
GO TO 84
85 IF(MATCH.EQ.17)GO TO 86
IF(MATCH.EQ.18)GO TO 87
IF(IPRINT.NE.0)GO TO 87
IPRINT=1
86 LTRNOW=LTRABC(LETTER)
GO TO 89
87 LTRNOW=LWRABC(LETTER)
GO TO 89
88 IPRINT=0
89 IF(MAXBFR.GE.LMTWID)GO TO 91
MAXBFR=MAXBFR+1
LTRWID(MAXBFR)=LTRNOW
90 KFIRST=KFIRST+1
GO TO 83
91 GO TO 111
C
C HEAD
92 MATCH=8
JFIRST=JFIRST-1
93 IF(JFIRST.LE.IFIRST)GO TO 95
JFIRST=JFIRST-1
GO TO 97
C
C TAIL
94 IF(JFINAL.GE.IFINAL)GO TO 95
JFIRST=JFINAL
GO TO 97
95 WRITE(ITTY,96)
96 FORMAT(' Line is already split at this point')
GO TO 133
C
C SPLIT THE LINE INTO 2 LINES
97 IF(KNTLIN.GE.LMTLIN)GO TO 104
KNTLIN=KNTLIN+1
INDEX0=KNTLIN
98 IF(INDEX0.LE.LINE)GO TO 99
LNGLIN(INDEX0)=LNGLIN(INDEX0-1)
MARKER(INDEX0)=MARKER(INDEX0-1)
INDEX0=INDEX0-1
GO TO 98
99 LNGLIN(LINE)=JFIRST-IFIRST+1
LNGLIN(LINE+1)=IFINAL-JFIRST
INDEX0=0
INDEX1=0
100 IF(INDEX1.GE.LINE)GO TO 101
INDEX0=INDEX0+1
INDEX1=INDEX1+LNGSEC(INDEX0)
GO TO 100
101 LNGSEC(INDEX0)=LNGSEC(INDEX0)+1
INDEX0=0
DO 102 I=1,KNTLIN
IF(INDEX0.LT.MARKER(I))INDEX0=MARKER(I)
102 CONTINUE
INDEX0=INDEX0+1
MARKER(LINE+1)=INDEX0
WRITE(ITTY,103)INDEX0
103 FORMAT(' Right part of line is now line',1I5)
GO TO 140
104 WRITE(ITTY,105)
105 FORMAT(' Insufficient line storage')
GO TO 140
C
C HELP MESSAGE
106 IVIDEO=JVIDEO
CALL RSMHLP(ITTY,6,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
IVIDEO=0
GO TO 33
C
C SEARCH FOR ANOTHER WORD LATER IN SAME LINE
107 DO 108 I=1,MAXTGT
LTRBFR(I)=LWRBFR(I)
108 CONTINUE
INITAL=JFIRST+1
MAXBFR=MAXTGT
GO TO 6
C
C DELETE
109 IF(JFIRST.LE.IFIRST)GO TO 110
IF(JFINAL.GE.IFINAL)GO TO 110
IF(LTRTXT(JFIRST-1).NE.LTRSPA)GO TO 110
IF(LTRTXT(JFINAL+1).NE.LTRSPA)GO TO 110
JFIRST=JFIRST-1
110 IF(JFIRST.GT.IFIRST)GO TO 112
IF(JFINAL.LT.IFINAL)GO TO 112
IERROR=1
GO TO 140
C
C CHANGE
111 I=LNGLIN(LINE)
I=I-JFINAL+JFIRST-1
I=I+MAXBFR-LOWBFR+1
C
C REMOVE THE OLD PHRASE
112 INDEX1=JFIRST
JFINAL=JFINAL+1
113 IF(JFINAL.GT.KNTTXT)GO TO 114
LTRTXT(INDEX1)=LTRTXT(JFINAL)
JFINAL=JFINAL+1
INDEX1=INDEX1+1
GO TO 113
114 KNTTXT=KNTTXT-JFINAL+INDEX1
IFINAL=IFINAL-JFINAL+INDEX1
LNGLIN(LINE)=LNGLIN(LINE)-JFINAL+INDEX1
IF(MATCH.EQ.3)GO TO 132
GO TO 125
C
C BREAK
115 LOWBFR=1
MAXBFR=1
LTRWID(1)=LTRSTA
GO TO 117
C
C BULLET
116 LOWBFR=1
MAXBFR=1
LTRWID(1)=LTRMIN
GO TO 117
C
C LOOK FOR UP-ARROW OR UNDERSCORE TO LEFT
117 IF(JFIRST.LE.IFIRST)GO TO 119
LTRNOW=LTRTXT(JFIRST-1)
IF(LTRNOW.EQ.LTRUPA)GO TO 118
IF(LTRNOW.EQ.LTRUND)GO TO 118
GO TO 119
118 JFIRST=JFIRST-1
GO TO 117
119 CONTINUE
GO TO 125
C
C SPACE (BEFORE)
120 LOWBFR=1
MAXBFR=0
MATCH=1
GO TO 125
C
C BEFORE
121 GO TO 125
C
C AFTER
122 JFIRST=JFINAL+1
GO TO 125
C
C PREFIX
123 GO TO 125
C
C SUFFIX
124 JFIRST=JFINAL+1
GO TO 125
C
C INSERT THE NEW PHRASE
125 INDEX0=KNTTXT
KNTTXT=KNTTXT+MAXBFR-LOWBFR+1
IF(MATCH.EQ.1)KNTTXT=KNTTXT+1
IF(MATCH.EQ.2)KNTTXT=KNTTXT+1
IFINAL=IFINAL+KNTTXT-INDEX0
LNGLIN(LINE)=LNGLIN(LINE)+KNTTXT-INDEX0
INDEX1=KNTTXT
126 IF(INDEX0.LT.JFIRST)GO TO 127
LTRTXT(INDEX1)=LTRTXT(INDEX0)
INDEX0=INDEX0-1
INDEX1=INDEX1-1
GO TO 126
127 IF(MATCH.NE.2)GO TO 128
LTRTXT(JFIRST)=LTRSPA
JFIRST=JFIRST+1
128 IF(LOWBFR.GT.MAXBFR)GO TO 130
DO 129 I=LOWBFR,MAXBFR
LTRTXT(JFIRST)=LTRWID(I)
JFIRST=JFIRST+1
129 CONTINUE
130 IF(MATCH.NE.1)GO TO 131
LTRTXT(JFIRST)=LTRSPA
JFIRST=JFIRST+1
131 IF(MATCH.EQ.12)GO TO 92
IF(MATCH.EQ.13)GO TO 92
C
C DISPLAY THE NEW CONTENTS OF THE LINE
132 CALL RSMTYP(ITTY,LMTTXT,LTRTXT,LMTLIN,LNGLIN,
1IFIRST,IFINAL,0,JFIRST,JFINAL)
IF(INITAL.GT.IFINAL)GO TO 133
C
C ASK IF USER IS DONE EDITING THIS LINE
133 IF(IXYZZY.NE.0)GO TO 139
KNTATO=KNTATO+1
134 WRITE(ITTY,135)
135 FORMAT(' Are you done editing this line? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(134,134,139,138,136),KNDYES
136 WRITE(ITTY,137)
137 FORMAT(' Answer'/
1' YES to specify another option'/
2' NO if more changes are to be made to this line')
GO TO 134
138 GO TO 2
139 CONTINUE
C
C RETURN TO CALLING PROGRAM
140 RETURN
END
SUBROUTINE RSMKIL(LINE,LTRTXT,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,LMTSEC,MARKER)
C RENBR(/KILL A LINE IN 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)
IF(LINE.GT.KNTLIN)GO TO 8
INDEX5=0
INDEX6=0
1 INDEX6=INDEX6+1
INDEX5=INDEX5+LNGSEC(INDEX6)
IF(INDEX5.LT.LINE)GO TO 1
C
C REMOVE CHARACTERS IN LINE
INDEX0=0
INDEX2=1
2 IF(INDEX2.GE.LINE)GO TO 3
INDEX0=INDEX0+LNGLIN(INDEX2)
INDEX2=INDEX2+1
GO TO 2
3 INDEX1=INDEX0+LNGLIN(LINE)
4 IF(INDEX1.GE.KNTTXT)GO TO 5
INDEX0=INDEX0+1
INDEX1=INDEX1+1
LTRTXT(INDEX0)=LTRTXT(INDEX1)
GO TO 4
5 KNTTXT=INDEX0
LNGLIN(LINE)=0
MARKER(LINE)=0
IF(LNGSEC(INDEX6).LE.1)GO TO 8
LNGSEC(INDEX6)=LNGSEC(INDEX6)-1
INDEX2=LINE
6 INDEX2=INDEX2+1
IF(INDEX2.GT.KNTLIN)GO TO 7
LNGLIN(INDEX2-1)=LNGLIN(INDEX2)
MARKER(INDEX2-1)=MARKER(INDEX2)
GO TO 6
7 KNTLIN=KNTLIN-1
C
C RETURN TO CALLING PROGRAM
8 RETURN
END
SUBROUTINE RSMCUT(LINE,LTRTXT,LNGLIN,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,IERROR,IBULLT)
C RENBR(/INSERT * OR - AT START OF LINE)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C IERROR = 0, RETURNED IF NO ERROR
C = 1, LINE ALREADY CONTAINS ASTERISK
C = 2, NO ROOM IN STORAGE FOR ASTERISK
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN)
DATA LTRSTA,LTRMIN/1H*,1H-/
IERROR=0
IF(LINE.GT.KNTLIN)GO TO 9
IF(LNGLIN(LINE).EQ.0)GO TO 9
IF(KNTTXT.GE.LMTTXT)GO TO 8
C
C LOCATE THE LINE
INDEX0=0
INDEX2=1
1 IF(INDEX2.GE.LINE)GO TO 2
INDEX0=INDEX0+LNGLIN(INDEX2)
INDEX2=INDEX2+1
GO TO 1
2 INDEX1=INDEX0+LNGLIN(LINE)
INDEX0=INDEX0+1
C
C INSURE LINE DOES NOT ALREADY CONTAIN ASTERISK
I=INDEX0
3 IF(LTRTXT(I).NE.LTRSTA)GO TO 4
I=I+1
IF(I.GT.INDEX1)GO TO 7
IF(LTRTXT(I).NE.LTRSTA)GO TO 7
4 I=I+1
IF(I.LE.INDEX1)GO TO 3
C
C INSERT THE ASTERISK
KNTTXT=KNTTXT+1
INDEX1=KNTTXT
5 IF(INDEX1.LE.INDEX0)GO TO 6
LTRTXT(INDEX1)=LTRTXT(INDEX1-1)
INDEX1=INDEX1-1
GO TO 5
6 IF(IBULLT.EQ.0)LTRTXT(INDEX0)=LTRSTA
IF(IBULLT.EQ.1)LTRTXT(INDEX0)=LTRMIN
LNGLIN(LINE)=LNGLIN(LINE)+1
GO TO 9
C
C ERRORS
7 IERROR=1
GO TO 9
8 IERROR=2
GO TO 9
C
C RETURN TO CALLING PROGRAM
9 RETURN
END
SUBROUTINE RSMGLU(LINE,LTRTXT,LNGLIN,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,IERROR)
C RENBR(/REMOVE ASTERISK OR BULLET AT START OF LINE)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C IERROR = 0, UNMARKING SUCCEDED
C = 1, NO ASTERISK IN LINE BEFORE
C = 2, ONLY * IN LINE BEFORE, USE DELETE OPTION
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN)
DATA LTRSTA/1H*/
IERROR=0
IF(LINE.GT.KNTLIN)GO TO 10
C
C LOCATE THE LINE
INDEX0=0
INDEX2=1
1 IF(INDEX2.GE.LINE)GO TO 2
INDEX0=INDEX0+LNGLIN(INDEX2)
INDEX2=INDEX2+1
GO TO 1
2 INDEX1=INDEX0+LNGLIN(LINE)
INDEX0=INDEX0+1
C
C INSURE LINE STARTS WITH ASTERISK
INDEX2=INDEX0
3 IF(INDEX2.GT.INDEX1)GO TO 9
IF(LTRTXT(INDEX2).EQ.1H )GO TO 4
IF(LTRTXT(INDEX2).EQ.1H*)GO TO 4
IF(LTRTXT(INDEX2).EQ.1H-)GO TO 4
GO TO 5
4 LTRTXT(INDEX2)=' '
INDEX2=INDEX2+1
GO TO 3
5 IF(INDEX2.EQ.INDEX0)GO TO 8
C
C REMOVE THE ASTERISK
6 IF(INDEX2.GT.KNTTXT)GO TO 7
LTRTXT(INDEX0)=LTRTXT(INDEX2)
INDEX2=INDEX2+1
INDEX0=INDEX0+1
GO TO 6
7 KNTTXT=KNTTXT-INDEX2+INDEX0
LNGLIN(LINE)=LNGLIN(LINE)-INDEX2+INDEX0
GO TO 10
C
C RETURN TO CALLING PROGRAM
8 IERROR=1
GO TO 10
9 IERROR=2
10 RETURN
END
SUBROUTINE RSMDBG(LMTBFR,LNGLIN,LNGSEC,LTRTXT,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL,ITTY,
3NUMWHO,IYEAR)
C RENBR(/DISPLAY RESUME DATA STRUCTURE)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
DIMENSION LNGLIN(LMTLIN),LNGSEC(LMTSEC),
1MARKER(LMTLIN),LTRTTL(LMTLTT),KNTTTL(LMTSEC),LTRTXT(LMTTXT)
DATA LTRSPA/1H /
C
C CALCULATE THE USED PORTIONS OF ARRAYS
IRTSEC=0
MSTLIN=0
IRTCOL=0
ISECTN=0
1 ISECTN=ISECTN+1
IF(ISECTN.GT.MAXSEC)GO TO 3
IRTSEC=IRTSEC+KNTTTL(ISECTN)
LINE=MSTLIN
MSTLIN=MSTLIN+LNGSEC(ISECTN)
2 LINE=LINE+1
IF(LINE.GT.MSTLIN)GO TO 1
IRTCOL=IRTCOL+LNGLIN(LINE)
GO TO 2
3 CONTINUE
C
WRITE(ITTY,4)NUMWHO,IYEAR
4 FORMAT(' STUDENT NUMBER:',1I7,' CLASS NUMBER:',1I4)
WRITE(ITTY,5)MAXSEC,LMTSEC
5 FORMAT(' (NUMBER OF SECTIONS) MAXSEC',16X,
1' ACTUAL:',1I5,' LIMIT:',1I5)
WRITE(ITTY,6)MAXLTT,IRTSEC,LMTLTT
6 FORMAT(' (TEXT IN NAMES) MAXLTT EXPECTED:',1I5,
1', ACTUAL:',1I5,' LIMIT:',1I5)
WRITE(ITTY,7)KNTLIN,MSTLIN,LMTLIN
7 FORMAT(' (NUMBER OF LINES) KNTLIN EXPECTED:',1I5,
1', ACTUAL:',1I5,' LIMIT:',1I5)
WRITE(ITTY,8)KNTTXT,IRTCOL,LMTTXT
8 FORMAT(' (TEXT IN LINES) KNTTXT EXPECTED:',1I5,
1', ACTUAL:',1I5,' LIMIT:',1I5)
C
C INITIAL COUNTS
ISHOWN=5
IRTSEC=0
MSTLIN=0
IRTCOL=0
C
C START OF SECTION LOOP
ISECTN=0
9 ISECTN=ISECTN+1
IF(ISECTN.GT.MAXSEC)GO TO 22
LFTSEC=IRTSEC+1
IRTSEC=IRTSEC+KNTTTL(ISECTN)
JSHOWN=1
IF(LFTSEC.LE.IRTSEC)JSHOWN=JSHOWN+1
IRETRN=1
IF((ISHOWN+JSHOWN).GT.22)GO TO 23
10 IF(LFTSEC.GT.IRTSEC)WRITE(ITTY,11)ISECTN,LNGSEC(ISECTN),
1ISECTN,KNTTTL(ISECTN)
IF(LFTSEC.LE.IRTSEC)WRITE(ITTY,12)ISECTN,LNGSEC(ISECTN),
1ISECTN,KNTTTL(ISECTN),LFTSEC,IRTSEC
ISHOWN=ISHOWN+1
IF(LFTSEC.LE.IRTSEC)WRITE(ITTY,13)
1(LTRTTL(I),I=LFTSEC,IRTSEC)
IF(LFTSEC.LE.IRTSEC)ISHOWN=ISHOWN+1
11 FORMAT(1X,10X,'LNGSEC(',1I5,')',1I5,', KNTTTL(',1I5,')',1I5,
1', EMPTY TITLE')
12 FORMAT(1X,10X,'LNGSEC(',1I5,')',1I5,', KNTTTL(',1I5,')',1I5,
1', LTRTTL(',1I5,'/',1I5,')')
13 FORMAT(1X,80A1)
INILIN=MSTLIN+1
MSTLIN=MSTLIN+LNGSEC(ISECTN)
C
C LINE LOOP
LINE=INILIN-1
14 LINE=LINE+1
IF(LINE.GT.MSTLIN)GO TO 20
LFTCOL=IRTCOL+1
IRTCOL=IRTCOL+LNGLIN(LINE)
JSHOWN=1
IF(LFTCOL.LE.IRTCOL)JSHOWN=JSHOWN+1
IRETRN=2
IF((ISHOWN+JSHOWN).GT.22)GO TO 23
15 IF(LFTCOL.GT.IRTCOL)WRITE(ITTY,16)LINE,MARKER(LINE),
1LINE,LNGLIN(LINE)
IF(LFTCOL.LE.IRTCOL)WRITE(ITTY,17)LINE,MARKER(LINE),
1LINE,LNGLIN(LINE),LFTCOL,IRTCOL
ISHOWN=ISHOWN+1
IF(LFTCOL.LE.IRTCOL)WRITE(ITTY,18)
1(LTRTXT(I),I=LFTCOL,IRTCOL)
IF(LFTCOL.LE.IRTCOL)ISHOWN=ISHOWN+1
16 FORMAT(1X,10X,'MARKER(',1I5,')',1I5,', LNGLIN(',1I5,')',1I5,
1', EMPTY LINE')
17 FORMAT(1X,10X,'MARKER(',1I5,')',1I5,', LNGLIN(',1I5,')',1I5,
1', LTRTXT(',1I5,'/',1I5,')')
18 FORMAT(1X,80A1)
19 GO TO 14
20 CONTINUE
21 GO TO 9
22 CONTINUE
GO TO 26
C
C STOP AT BOTTOM OF EACH PAGE DISPLAY
23 ISHOWN=0
WRITE(ITTY,24)
24 FORMAT(1X/' (press RETURN to continue)',$)
READ(ITTY,25,END=26)LTRNOW
IF(LTRNOW.NE.LTRSPA)GO TO 26
25 FORMAT(1A1)
GO TO(10,15),IRETRN
C
C RETURN TO CALLING PROGRAM
26 RETURN
END
SUBROUTINE RSMRNG(NOWSEC,IFIRST,IFINAL,LNGSEC,LMTSEC)
C RENBR(/GET RANGE OF LINES IN A SECTION)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
DIMENSION LNGSEC(LMTSEC)
INDEX1=1
INDEX2=1
1 IF(INDEX2.GT.NOWSEC)GO TO 2
INDEX0=INDEX1
INDEX1=INDEX1+LNGSEC(INDEX2)
INDEX2=INDEX2+1
GO TO 1
2 IFIRST=INDEX0
IFINAL=INDEX1-1
RETURN
END
SUBROUTINE DASWAP(IARRAY,LOW,MID,MAX)
C RENBR(/SWAP ADJACENT SECTIONS OF ARRAY)
C
C DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C ROUTINE TO SWAP ADJACENT SECTIONS OF SINGLE ARRAY
C
C IARRAY = ARRAY CONTAINING SECTIONS TO BE SWAPPED
C LOW = SUBSCRIPT OF LOWEST LOCATION IN LOW SECTION
C MID = SUBSCRIPT OF HIGHEST LOCATION IN LOW SECTION
C MAX = SUBSCRIPT OF HIGHEST LOCATION IN HIGH
C SECTION
C
C SWAP IS PERFORMED BY MOVING VALUES DIRECTLY TO
C LOCATIONS THEY ARE TO OCCUPY IN THE RESULT.
C
C FOR EXAMPLE, TO SWAP ABCD AND 123 IN THE
C FOLLOWING EXAMPLE, 3 IS MOVED TO LOCATION HOLDING C
C WHICH IS MOVED TO LOCATION HOLDING 2 AND SO ON.
C
C A B C D 1 2 3
C . . I-----------I
C . . I--------I .
C . I-----------I .
C . I--------I . .
C I-----------I . .
C I--------I . . .
C . . . I--------I
C
C IARRAY ARRAY AND NEW AND KEEP VARIABLES SHOULD BE
C MADE FLOATING POINT TO SWAP A FLOATING POINT ARRAY.
C
DIMENSION IARRAY(MAX)
IF(LOW.GT.MID)GO TO 5
IF(MID.GE.MAX)GO TO 5
KOUNT=LOW-MAX-1
LAST=MAX
LONGLO=LOW-MID-1
LONGHI=MAX-MID
1 INDEX=LAST+LONGLO
KEEP=IARRAY(LAST)
2 KOUNT=KOUNT+1
NEW=IARRAY(INDEX)
IARRAY(INDEX)=KEEP
KEEP=NEW
IF(INDEX.GT.MID)GO TO 3
INDEX=INDEX+LONGHI
GO TO 2
3 IF(INDEX.EQ.LAST)GO TO 4
INDEX=INDEX+LONGLO
GO TO 2
4 IF(KOUNT.EQ.0)GO TO 5
LAST=LAST-1
GO TO 1
5 RETURN
C107401072377
END
SUBROUTINE RSMCUL(NOWSEC,ITTY,LTRTXT,LNGLIN,LNGSEC,
1LMTTXT,LMTLIN,KNTTXT,KNTLIN,MARKER,
2LMTLTT,MAXLTT,LTRTTL,LMTSEC,MAXSEC,KNTTTL,IERROR)
C RENBR(/CHECK FOR CHARACTERS NOT IN DIABLO TYPE FACE)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C THIS IS A MACHINE DEPENDENT ROUTINE
C
C THIS VERSION IS FOR THE DECSYSTEM10 AND DECSYSTEM20
C
DIMENSION LTRTXT(LMTTXT),LNGLIN(LMTLIN),LNGSEC(LMTSEC),
1MARKER(LMTLIN),LTRTTL(LMTLTT),KNTTTL(LMTSEC),LTRNOT(10),
2LTRBFR(80)
DATA LTRSPA/1H /
DATA LTRNOT/1H~,1H`,1H\,1H|,1H[,1H],1H{,1H},1H<,1H>/
DATA MAXNOT/10/
DATA LMTBFR/80/
IERROR=0
ISHOWN=0
MAXPRT=0
NOWLIN=0
KNTPRT=0
MRKSEC=0
DO 30 NEWSEC=1,MAXSEC
LEGEND=0
INISEC=MRKSEC+1
MRKSEC=MRKSEC+KNTTTL(NEWSEC)
MAXLIN=LNGSEC(NEWSEC)
IF(MAXLIN.LE.0)GO TO 30
DO 29 NEWLIN=1,MAXLIN
NOWLIN=NOWLIN+1
MINPRT=MAXPRT+1
MAXPRT=MAXPRT+LNGLIN(NOWLIN)
IF(MINPRT.GT.MAXPRT)GO TO 29
IF(NOWSEC.LE.1)GO TO 1
IF(NEWSEC.LT.NOWSEC)GO TO 29
IF(NEWSEC.GT.NOWSEC)GO TO 30
1 IF(LEGEND.NE.0)GO TO 11
LEGEND=1
IF(INISEC.GT.MRKSEC)GO TO 11
MAXBFR=0
MAXSHO=0
JERROR=0
DO 4 I=INISEC,MRKSEC
LTRNOW=LTRTTL(I)
MAXBFR=MAXBFR+1
IF(MAXBFR.LE.LMTBFR)LTRBFR(MAXBFR)=' '
2 DO 3 J=1,MAXNOT
IF(LTRNOW.NE.LTRNOT(J))GO TO 3
JERROR=1
IF(MAXBFR.GT.LMTBFR)GO TO 4
MAXSHO=MAXBFR
LTRBFR(MAXSHO)='^'
GO TO 4
3 CONTINUE
4 CONTINUE
IF(JERROR.EQ.0)GO TO 11
IF(IERROR.NE.0)GO TO 6
ISHOWN=ISHOWN+1
WRITE(ITTY,5)
5 FORMAT(' Following lines contain characters not ',
1'available on letter quality typewriter')
6 IERROR=1
IF((ISHOWN+1).LT.22)GO TO 9
WRITE(ITTY,7)
7 FORMAT(1X/' (press RETURN to continue)',$)
READ(ITTY,8,END=31)LTRNOW
IF(LTRNOW.NE.LTRSPA)GO TO 31
8 FORMAT(1A1)
ISHOWN=0
9 ISHOWN=ISHOWN+1
WRITE(ITTY,10)(LTRTTL(I),I=INISEC,MRKSEC)
IF(MAXSHO.EQ.0)WRITE(ITTY,10)
IF(MAXSHO.GT.0)WRITE(ITTY,10)(LTRBFR(I),I=1,MAXSHO)
10 FORMAT(1X,100A1)
C
C WRITE OUT THE LINE
11 IFIRST=MINPRT
DO 13 I=MINPRT,MAXPRT
LTRNOW=LTRTXT(I)
DO 12 J=1,MAXNOT
IF(LTRNOW.EQ.LTRNOT(J))GO TO 14
12 CONTINUE
13 CONTINUE
GO TO 29
14 IFINAL=IFIRST+76
IF(IFINAL.GT.MAXPRT)GO TO 18
15 IF(IFINAL.LE.IFIRST)GO TO 17
IF(LTRTXT(IFINAL).EQ.1H )GO TO 16
IFINAL=IFINAL-1
GO TO 15
16 IFINAL=IFINAL-1
IF(IFINAL.GE.IFIRST)GO TO 19
17 IFINAL=IFIRST+76-1
GO TO 19
18 IFINAL=MAXPRT
19 CONTINUE
MAXBFR=0
MAXSHO=0
JERROR=0
DO 22 I=IFIRST,IFINAL
LTRNOW=LTRTXT(I)
MAXBFR=MAXBFR+1
IF(MAXBFR.LE.LMTBFR)LTRBFR(MAXBFR)=' '
20 DO 21 J=1,MAXNOT
IF(LTRNOW.NE.LTRNOT(J))GO TO 21
JERROR=1
IF(MAXBFR.GT.LMTBFR)GO TO 22
MAXSHO=MAXBFR
LTRBFR(MAXSHO)='^'
GO TO 22
21 CONTINUE
22 CONTINUE
IF(IERROR.NE.0)GO TO 23
ISHOWN=ISHOWN+1
WRITE(ITTY,5)
23 IERROR=1
IF((ISHOWN+1).LT.22)GO TO 24
WRITE(ITTY,7)
READ(ITTY,8,END=31)LTRNOW
IF(LTRNOW.NE.LTRSPA)GO TO 31
ISHOWN=0
24 ISHOWN=ISHOWN+1
IF(IFIRST.EQ.MINPRT)WRITE(ITTY,25)MARKER(NOWLIN),
1(LTRTXT(I),I=IFIRST,IFINAL)
25 FORMAT(1X,1I3,1X,100A1)
IF(IFIRST.GT.MINPRT)WRITE(ITTY,26)(LTRTXT(I),I=IFIRST,IFINAL)
IF(JERROR.EQ.0)GO TO 27
IF(MAXSHO.EQ.0)WRITE(ITTY,26)
IF(MAXSHO.GT.0)WRITE(ITTY,26)(LTRBFR(I),I=1,MAXSHO)
26 FORMAT(1X,4X,100A1)
27 KNTPRT=KNTPRT+1
IF(IFINAL.GE.MAXPRT)GO TO 29
IFIRST=IFINAL
IFINAL=MAXPRT
28 IFIRST=IFIRST+1
IF(IFIRST.GT.MAXPRT)GO TO 29
IF(LTRTXT(IFIRST).EQ.1H )GO TO 28
GO TO 14
29 CONTINUE
30 CONTINUE
GO TO 32
C
C CLOSE TERMINAL UNIT IF END-OF-FILE ON IT TO PREVENT
C INFINITE LOOP
31 CLOSE(UNIT=ITTY)
GO TO 32
C
C RETURN TO CALLING PROGRAM
32 RETURN
END
SUBROUTINE PASLST(IVIDEO,JVIDEO,IYEAR,IDISK,ITTY,
1LMTPSW,LTRPSW,LTRCHK,LNGPSW,NUMWHO,LTRBFR,LMTBFR)
C RENBR(/GET PASSWORD FROM PREDEFINED LIST)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C INPUT ARGUMENTS
C JVIDEO = 0, DO NOT FORM FEED BEFORE HELP MESSAGES
C = 1, ISSUE FORM FEED BEFORE HELP MESSAGES
C IYEAR = CLASS NUMBER
C IDISK = UNIT FROM WHICH READ
C ITTY = UNIT ON WHICH MESSAGE ARE WRITTEN, PASSWORD READ
C LMTPSW = DIMENSION OF LTRPSW
C
C OUTPUT ARGUMENTS
C LTRPSW = ARRAY RETURNED WITH UPPER CASE PASSWORD
C LTRCHK = ARRAY RETURNED WITH LOWER CASE PASSWORD. THIS
C IS SCRATH ARRAY NOT NEEDED BY CALLING PROGRAM
C LNGPSW = RETURNED WITH NUMBER OF CHARACTERS IN PASSWORD
C NUMWHO = RETURNED WITH NUMBER READ AS START OF PASSWORD
C
C SCRATCH ARRAY
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),LTRCHK(LMTPSW)
C
DATA LTRSPA,LTRZER,LTREQU,LTREXC /1H ,1H0,1H=,1H!/
C
C ASK USER FOR NUMBER
KNTPSW=0
1 WRITE(ITTY,2)
2 FORMAT(' Number and password? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 43
IF(MAXBFR.EQ.0)GO TO 41
MINBFR=0
3 MINBFR=MINBFR+1
IF(LTRBFR(MINBFR).EQ.LTRSPA)GO TO 3
KOMPAR=-1
4 LTRNOW=LTRBFR(MINBFR)
IF(LTRNOW.EQ.LTRSPA)GO TO 9
DO 5 IDIGIT=1,10
IF(LTRNOW.NE.LTRDGT(IDIGIT))GO TO 5
IF(KOMPAR.LT.0)KOMPAR=0
KOMPAR=(10*KOMPAR)+IDIGIT-1
GO TO 6
5 CONTINUE
IF(KOMPAR.LT.0)GO TO 41
GO TO 9
6 MINBFR=MINBFR+1
IF(MINBFR.LE.MAXBFR)GO TO 4
C
C ASK USER FOR PASSWORD
7 WRITE(ITTY,8)
8 FORMAT(' Password? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 46
IF(MAXBFR.EQ.0)GO TO 44
C
C CONVERT PASWORD TO UPPER CASE AND REMOVE EXTRA SPACES
MINBFR=1
9 LNGPSW=0
IBLANK=-1
DO 17 IOUTER=MINBFR,MAXBFR
LTRNOW=LTRBFR(IOUTER)
LWRNOW=LTRNOW
IF(LTRNOW.EQ.LTRSPA)GO TO 16
C
C CHECK FOR UPPER CASE LETTERS
DO 10 INNER=1,26
IF(LTRNOW.NE.LTRABC(INNER))GO TO 10
LWRNOW=LWRABC(INNER)
GO TO 12
10 CONTINUE
C
C CHECK FOR LOWER CASE LETTERS
DO 11 INNER=1,26
IF(LTRNOW.NE.LWRABC(INNER))GO TO 11
LTRNOW=LTRABC(INNER)
GO TO 12
11 CONTINUE
C
C PACK THE PRINTING CHARACTER INTO PASSWORD
12 IF(IBLANK.GT.0)GO TO 14
13 IBLANK=0
14 IF(LNGPSW.GE.LMTPSW)GO TO 38
IF(IBLANK.EQ.0)GO TO 15
LNGPSW=LNGPSW+1
LTRPSW(LNGPSW)=LTRSPA
GO TO 13
15 LNGPSW=LNGPSW+1
LTRPSW(LNGPSW)=LTRNOW
LTRCHK(LNGPSW)=LWRNOW
GO TO 17
C
C BLANK FOUND
16 IF(IBLANK.EQ.0)IBLANK=1
17 CONTINUE
C
C FILL REST OF ARRAY WITH SPACES
I=LNGPSW
18 I=I+1
IF(I.GT.LMTPSW)GO TO 19
LTRPSW(I)=LTRSPA
LTRCHK(I)=LTRSPA
GO TO 18
19 CONTINUE
C
C OPEN THE PASSWORD FILE
CALL RSMOPN(2,NUMWHO,IYEAR,ITTY,IDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 47
20 READ(IDISK,21,END=37)LTRBFR
21 FORMAT(80A1)
C
C SKIP OVER LEADING NUMBER ON LINE
MINNUM=0
22 MINNUM=MINNUM+1
IF(MINNUM.GT.LMTBFR)GO TO 20
IF(LTRBFR(MINNUM).EQ.LTRSPA)GO TO 22
MAXNUM=MINNUM
23 MAXNUM=MAXNUM+1
IF(MAXNUM.GT.LMTBFR)GO TO 20
IF(LTRBFR(MAXNUM).NE.LTRSPA)GO TO 23
IF(LTRBFR(MINNUM).EQ.LTREQU)GO TO 37
C
C EVALUATE NUMBER AT START OF LINE
NUMWHO=0
GO TO 25
24 MINNUM=MINNUM+1
IF(MINNUM.GE.MAXNUM)GO TO 27
25 LTRNOW=LTRBFR(MINNUM)
DO 26 IDIGIT=1,10
IF(LTRNOW.NE.LTRDGT(IDIGIT))GO TO 26
NUMWHO=(10*NUMWHO)+IDIGIT-1
GO TO 24
26 CONTINUE
GO TO 20
27 IF(NUMWHO.NE.KOMPAR)GO TO 20
C
C COMPARE PASSWORD TYPED BY USER AND READ FROM FILE
IFIRST=MAXNUM-1
JFIRST=0
C
C NOTE THAT THIS IS A GENERAL PROCEDURE FOR COMPARING
C ANY 2 STRINGS THAT CAN CONTAIN SPACES AND THAT CAN,
C BUT ARE NOT REQUIRED TO, BEGIN AND END WITH SPACES.
C BOTH STRINGS MUST HAVE THE PRINTING CHARACTERS SPLIT
C INTO THE SAME NUMBER OF WORDS, BUT THE ACTUAL NUMBER
C OF SPACES BETWEEN THE WORDS IS IGNORED IN BOTH ARRAYS.
C
C LTRBFR = ARRAY CONTAINING LINE READ FROM FILE
C LMTBFR = NUMBER OF CHARACTERS IN LTRBFR ARRAY
C IFIRST = LOCATION TO LEFT OF FIRST LOCATION TO TEST
C IN LTRBFR ARRAY.
C LTRPSW = UPPER CASE PASSWORD TYPED BY USER
C LTRCHK = LOWER CASE VERSION OF PASSWORD TYPED BY USER
C LMTPSW = NUMBER OF CHARACTERS IN LTRPSW ARRAY
C JFIRST = LOCATION TO LEFT OF FIRST LOCATION TO TEST
C IN LTRPSW ARRAY.
C
IBLANK=-1
GO TO 29
28 IBLANK=0
29 IFIRST=IFIRST+1
IF(IFIRST.GT.LMTBFR)GO TO 34
LTRNOW=LTRBFR(IFIRST)
IF(LTRNOW.EQ.LTRSPA)GO TO 31
IF(LTRNOW.EQ.LTREXC)GO TO 33
30 JFIRST=JFIRST+1
IF(JFIRST.GT.LMTPSW)GO TO 35
IF(LTRPSW(JFIRST).EQ.LTRSPA)GO TO 32
IF(IBLANK.GT.0)GO TO 36
IF(LTRNOW.EQ.LTRPSW(JFIRST))GO TO 28
IF(LTRNOW.EQ.LTRCHK(JFIRST))GO TO 28
GO TO 36
31 IF(IBLANK.EQ.0)IBLANK=1
GO TO 29
32 IF(IBLANK.EQ.0)GO TO 36
IBLANK=-1
GO TO 30
33 IFIRST=LMTBFR+1
34 IBLANK=1
GO TO 30
35 IF(IFIRST.LE.LMTBFR)GO TO 36
C
C MATCH
KNTPSW=-1
GO TO 37
C
C NO MATCH
36 GO TO 37
C
C ALL DONE READING FILE
37 CALL RSMCLS(2,NUMWHO,IYEAR,ITTY,IDISK,IFCLOS)
IF(KNTPSW.LT.0)GO TO 50
38 WRITE(ITTY,39)
39 FORMAT(' Unknown password')
KNTPSW=KNTPSW+1
IF(KNTPSW.LT.3)GO TO 1
WRITE(ITTY,40)
40 FORMAT(' Only 3 tries are allowed')
GO TO 49
C
C ERROR MESSAGE AND HELP MESSAGE
41 WRITE(ITTY,42)
42 FORMAT(' Number must be supplied. Type ? for help.')
GO TO 1
43 CALL RSMHLP(ITTY,44,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
GO TO 1
44 WRITE(ITTY,45)
45 FORMAT(' Password must be supplied. Type ? for help.')
GO TO 7
46 CALL RSMHLP(ITTY,40,LTRBFR,LMTBFR,MAXBFR,IVIDEO)
GO TO 7
47 WRITE(ITTY,48)
48 FORMAT(' Cannot read password file')
GO TO 49
C
C RETURN TO CALLING PROGRAM
49 LNGPSW=0
50 RETURN
END