Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0174/rsmmix.for
There is 1 other file named rsmmix.for in the archive. Click here to see a list.
C RENBR(RSMMIX/CONVERT CAPITALIZED WORDS TO MIXED CASE)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS PROGRAM IS PART OF THE STUDENT RESUME SYSTEM
C
C THIS PROGRAM CONVERTS THE SECOND AND SUBSEQUENT
C LETTERS IN ALL UPPER CASE WORDS TO LOWER CASE.
C LOWER CASE LETTERS ARE NOT CHANGED.
C IN A NAME LIKE MCDONALD, IF THE C IS ORIGINALLY
C IN LOWER CASE AND THE REST IS CAPITALIZED, THEN
C IN THE RESULT BOTH THE M AND THE FIRST D WILL BE
C CAPITALIZED AND THE REST WILL BE IN LOWER CASE.
C
C THIS VERSION IS MEANT FOR CONVERSION OF THE STUDENT
C RESUME COLLECTION AND COPIES THE FIRST LINE INTACT.
C
C A FILE OF RESERVED WORDS IS ALSO READ. THIS FILE
C SHOULD CONTAIN 1 UPPER CASE WORD PER LINE, THESE
C BEING WORDS WHICH ARE TO BE LEFT IN UPPER CASE.
C IF A WORD IS TO BE CONVERTED ENTIRELY TO LOWER
C CASE, THEN IT SHOULD APPEAR TWICE ON THE LINE,
C FIRST IN ITS UPPER CASE FORM, THEN IN ITS ALL LOWER
C CASE FORM. THIS FILE CAN END WITH A LINE CONTAINING
C A SINGLE EQUAL SIGN.
C
DIMENSION LTROLD(5000),LTRNEW(5000),LNGWRD(1000),
1LTRINP(150),LWRBFR(150),LTRABC(26),LWRABC(26),
2NYEAR(10),LTRWHO(40),LWRWHO(40),LTRBFR(80)
C
C UNIT NUMBERS
DATA ITTY,IDISK,JDISK,KDISK/5,1,20,21/
C
C LMTINP = DIMENSION OF LTRINP ARRAY. NUMBER OF
C CHARACTERS READ IN EACH LINE.
C LMTWRD = DIMENSION OF LNGWRD ARRAY, TOTAL NUMBER OF
C WORDS WHICH HAVE RESERVED CAPITALIZATION.
C LMTLTR = DIMENSION OF LTROLD AND LTRNEW ARRAYS.
C TOTAL NUMBER OF LETTERS IN WORDS HAVING
C RESERVED CAPITALIZATION.
C LMTCLS = DIMENSION OF NYEAR ARRAY. THIS ARRAY IN THE
C HOLDS LIST OF DESIRED CLASS NUMBERS
DATA LMTINP,LMTWRD,LMTLTR,LMTCLS,LMTBFR,LMTWHO/
1 150,1000,5000,10,80,40/
C
C LETTERS OF THE ALPHABET
DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
2 1HX,1HY,1HZ/
DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
2 1Hx,1Hy,1Hz/
C
C VARIOUS CHARACTERS
DATA LTRSPA,LTREQU/1H ,1H=/
C
C TELL USER WHAT PROGRAM THIS IS
WRITE(ITTY,1)
1 FORMAT(' RSMMIX'/
1' Converts capitalized words in resumes to mixed cases')
C
C IDENTIFY CURRENT USER
CALL RSMWHO(LTRWHO,IPRJCT,IPRGRM,NUMWHO)
C
C DETERMINE IF CURRENT USER IS ENABLED AS ADMINISTRATOR
CALL RSMCHK(LTRWHO,LWRWHO,LMTWHO,IPRJCT,IPRGRM, IDISK,
1 IYEAR,ICHECK,IPRINT,JVIDEO,LTRBFR,LMTBFR,ITTY,NUMWHO)
MINCLS=ICHECK
MAXCLS=IPRINT
IXYZZY=IYEAR
IF(IXYZZY.NE.-3)GO TO 2
IF(MINCLS.GT.MAXCLS)GO TO 4
GO TO 6
2 WRITE(ITTY,3)
3 FORMAT(1X/' You are not validated as the administrator'/1X)
GO TO 67
4 WRITE(ITTY,5)
5 FORMAT(' Year range excludes all resumes'/1X)
GO TO 67
6 CONTINUE
C
C ASK USER WHICH YEAR CLASS IS TO BE PROCESSED
WRITE(ITTY,7)MINCLS,MAXCLS
7 FORMAT(' You can process students in years',1I4,' to',1I4)
8 WRITE(ITTY,9)
9 FORMAT(' Process which years (-1=all): ',$)
READ(ITTY,10)NYEAR
10 FORMAT(10I)
KNTCLS=LMTCLS
11 IF(NYEAR(KNTCLS).NE.0)GO TO 12
KNTCLS=KNTCLS-1
IF(KNTCLS.GT.1)GO TO 11
12 CONTINUE
DO 15 I=1,KNTCLS
IF(NYEAR(I).LT.0)GO TO 15
IF(NYEAR(I).LT.MINCLS)GO TO 13
IF(NYEAR(I).GT.MAXCLS)GO TO 13
GO TO 15
13 WRITE(ITTY,14)NYEAR(I)
14 FORMAT(' You are not allowed to process class',1I6)
GO TO 8
15 CONTINUE
LYEAR=NYEAR(1)
C
C OPEN FILE DESCRIBING RESERVED CAPITALIZATIONS
KNTWRD=0
KNTLTR=0
CALL RSMOPN(11,JOBUSR,LYEAR,ITTY,IDISK,IFOPEN)
IF(IFOPEN.NE.0)GO TO 17
WRITE(ITTY,16)
16 FORMAT(' No file of specially capitalized words')
GO TO 38
17 CONTINUE
C
C READ THE LIST OF RESERVED WORDS
18 READ(IDISK,19,END=36)LTRINP
19 FORMAT(150A1)
MAXBFR=LMTINP
20 IF(LTRINP(MAXBFR).NE.LTRSPA)GO TO 21
MAXBFR=MAXBFR-1
IF(MAXBFR.GT.0)GO TO 20
GO TO 18
21 CONTINUE
MINLFT=0
22 MINLFT=MINLFT+1
IF(LTRINP(MINLFT).EQ.LTRSPA)GO TO 22
MAXLFT=MINLFT
23 MAXLFT=MAXLFT+1
IF(MAXLFT.GT.MAXBFR)GO TO 27
IF(LTRINP(MAXLFT).NE.LTRSPA)GO TO 23
MAXLFT=MAXLFT-1
MINRIT=MAXLFT
24 MINRIT=MINRIT+1
IF(LTRINP(MINRIT).EQ.LTRSPA)GO TO 24
MAXRIT=MINRIT
25 MAXRIT=MAXRIT+1
IF(MAXRIT.GT.MAXBFR)GO TO 26
IF(LTRINP(MAXRIT).NE.LTRSPA)GO TO 25
26 MAXRIT=MAXRIT-1
GO TO 29
27 IF(MINLFT.NE.MAXBFR)GO TO 28
IF(LTRINP(MINLFT).EQ.LTREQU)GO TO 36
28 MAXLFT=MAXBFR
MINRIT=MINLFT
MAXRIT=MAXLFT
GO TO 29
29 IF((MAXLFT-MINLFT).NE.(MAXRIT-MINRIT))GO TO 32
IF(KNTWRD.GE.LMTWRD)GO TO 34
IF((KNTLTR+MAXLFT-MINLFT+1).GT.LMTLTR)GO TO 34
KNTWRD=KNTWRD+1
LNGWRD(KNTWRD)=MAXLFT-MINLFT+1
INILTR=KNTLTR
DO 30 KOLUMN=MINLFT,MAXLFT
KNTLTR=KNTLTR+1
LTROLD(KNTLTR)=LTRINP(KOLUMN)
30 CONTINUE
DO 31 KOLUMN=MINRIT,MAXRIT
INILTR=INILTR+1
LTRNEW(INILTR)=LTRINP(KOLUMN)
31 CONTINUE
GO TO 18
32 WRITE(ITTY,33)(LTRINP(I),I=MINLFT,MAXRIT)
33 FORMAT(' Words of different length ignored in following line'/
11X,150A1)
GO TO 18
34 WRITE(ITTY,35)(LTRINP(I),I=MINLFT,MAXRIT)
35 FORMAT(' Following line overflows storage of reserved words'/
11X,150A1)
36 CALL RSMCLS(11,JOBUSR,LYEAR,ITTY,IDISK,IFOPEN)
WRITE(ITTY,37)KNTWRD
37 FORMAT(1X,1I4,' reserved words')
38 CONTINUE
C
C INDICATE THAT HAVE NOT PROCESSED ANY FILES YET
KNTFIL=0
KNTMOD=0
C
C IDENTIFY NEXT RESUME FILE IN STORAGE AREA
39 CALL RSMDIR(JDISK ,KNTFIL,JOBUSR,LYEAR ,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 65
C
C CHECK IF NEXT RESUME FILE IS IN PROPER YEAR
IF(LYEAR.LT.MINCLS)GO TO 39
IF(LYEAR.GT.MAXCLS)GO TO 39
DO 40 I=1,KNTCLS
IF(NYEAR(I).LT.0)GO TO 41
IF(NYEAR(I).EQ.LYEAR)GO TO 41
40 CONTINUE
GO TO 39
C
C OPEN NEXT RESUME FILE
41 CALL RSMOPN(3,JOBUSR,LYEAR,ITTY,IDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 39
WRITE(ITTY,42)JOBUSR,LYEAR
42 FORMAT(' Processing resume',1I7,1I4)
CALL RSMOPN(5,JOBUSR,LYEAR,ITTY,KDISK,IFOPEN)
KNTMOD=KNTMOD+1
C
C GET NEXT LINE IN RESUME
KNTLIN=0
43 READ(IDISK,19,END=64)LTRINP
MAXBFR=LMTINP
44 IF(LTRINP(MAXBFR).NE.LTRSPA)GO TO 45
MAXBFR=MAXBFR-1
IF(MAXBFR.GT.0)GO TO 44
GO TO 43
45 DO 46 KOLUMN=1,MAXBFR
LWRBFR(KOLUMN)=LTRINP(KOLUMN)
46 CONTINUE
KNTLIN=KNTLIN+1
IF(KNTLIN.EQ.1)GO TO 63
C
C CONVERT ALL UPPER CASE WORDS TO MIXED CASES
IBLANK=0
DO 50 KOLUMN=1,MAXBFR
LTRNOW=LTRINP(KOLUMN)
IF(LTRNOW.EQ.LTRSPA)GO TO 49
DO 47 LETTER=1,26
IF(LTRNOW.EQ.LWRABC(LETTER))GO TO 49
47 CONTINUE
IBLANK=IBLANK+1
DO 48 LETTER=1,26
IF(LTRNOW.NE.LTRABC(LETTER))GO TO 48
IF(IBLANK.EQ.1)GO TO 50
LWRBFR(KOLUMN)=LWRABC(LETTER)
GO TO 50
48 CONTINUE
GO TO 49
49 IBLANK=0
GO TO 50
50 CONTINUE
C
C LOOK FOR RESERVED WORDS
IF(KNTWRD.EQ.0)GO TO 62
MAXWRD=0
51 MINWRD=MAXWRD
52 MINWRD=MINWRD+1
IF(MINWRD.GT.MAXBFR)GO TO 62
LTRNOW=LTRINP(MINWRD)
DO 53 I=1,26
IF(LTRNOW.EQ.LTRABC(I))GO TO 54
IF(LTRNOW.EQ.LWRABC(I))GO TO 54
53 CONTINUE
GO TO 52
54 MAXWRD=MINWRD
55 MAXWRD=MAXWRD+1
IF(MAXWRD.GT.MAXBFR)GO TO 57
LTRNOW=LTRINP(MAXWRD)
DO 56 I=1,26
IF(LTRNOW.EQ.LTRABC(I))GO TO 55
IF(LTRNOW.EQ.LWRABC(I))GO TO 55
56 CONTINUE
57 MAXWRD=MAXWRD-1
KTEST=0
DO 60 NOWWRD=1,KNTWRD
LTEST=KTEST+1
KTEST=KTEST+LNGWRD(NOWWRD)
IF(LNGWRD(NOWWRD).NE.(MAXWRD-MINWRD+1))GO TO 60
JTEST=MINWRD
DO 58 ITEST=LTEST,KTEST
IF(LTRINP(JTEST).NE.LTROLD(ITEST))GO TO 60
JTEST=JTEST+1
58 CONTINUE
JTEST=MINWRD
DO 59 ITEST=LTEST,KTEST
LWRBFR(JTEST)=LTRNEW(ITEST)
JTEST=JTEST+1
59 CONTINUE
GO TO 61
60 CONTINUE
61 GO TO 51
62 CONTINUE
C
C WRITE OUT THE CONVERTED LINE
63 WRITE(KDISK,19)(LWRBFR(I),I=1,MAXBFR)
GO TO 43
64 CALL RSMCLS(3,JOBUSR,LYEAR,ITTY,IDISK,IFCLOS)
CALL RSMCLS(5,JOBUSR,LYEAR,ITTY,KDISK,IFCLOS)
GO TO 39
65 WRITE(ITTY,66)KNTMOD,KNTFIL
66 FORMAT(' Processed',1I5,' resumes out of a total of',1I5)
67 STOP
END