Google
 

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