Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C     RENBR(RSMSRT/SORT LIST OF RESUMES BY STUDENT NAME)/R)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THIS PROGRAM IS PART OF THE STUDENT RESUME SYSTEM
C
C     THIS PROGRAM SORTS THE LIST OF RESUMES PRODUCED BY
C     THE RESUME ADMINISTRATOR PROGRAM ALPHABETICALLY BY
C     THE STUDENT'S NAME.  THIS LIST CAN THEN BE READ BY
C     THE RESUME ADMINISTRATOR PROGRAM TO PROCESS THE
C     RESUMES IN THE NEW ORDER.
C
C     A RIGHTMOST ABBREVIATION OR WORD APPEARING TO RIGHT
C     OF A COMMA IS IGNORED FOR PURPOSES OF SORTING.
C
C     THE ENTIRE LIST OF STUDENT NAMES AND NUMBERS IS READ
C     INTO CORE, SORTED AND WRITTEN OUT.  THE ARRAYS ARE
C     DIMENSIONED LARGE ENOUGH TO SORT 400 STUDENT NAMES.
C
      DIMENSION LTRNAM(400,30),LTRABC(26),LTRSUF(10),LNGSUF(5),
     1LWRABC(26),LTRDGT(10),LOCBGN(400),LNGNAM(400),LTRNUM(400,9),
     2LTRPRE(2),LNGPRE(1),LTRPAS(400,20)
C
C     LMTNUM = NUMBER OF CHARACTERS IN NUMERIC FIELDS
C     LMTPAS = LENGTH OF SINGLE PASSWORD
C     LMTLNG = LENGTH OF SINGLE NAME
C     LMTNAM = MAXIMUM NUMBER OF NAMES
      DATA LMTNUM,LMTPAS,LMTLNG,LMTNAM/9,20,30,400/
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
      DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C     PREFIXES TO BE CONSIDERED PART OF THE LAST NAME
C     LTRPRE = LETTERS IN PREFIXES
C     LNGPRE = LENGTHS OF PREFIXES
C     KNTPRE = NUMBER OF PREFIXES
      DATA LTRPRE/
     11HD,1HU/
      DATA LNGPRE/2/
      DATA KNTPRE/1/
C
C     SUFFIXES TO BE DISCARDED FOR PURPOSES SORTING
C     LTRSUF = LETTERS IN SUFFIXES
C     LNGSUF = LENGTHS OF SUFFIXES
C     KNTSUF = NUMBER OF SUFFIXES
      DATA LTRSUF/
     11HI,
     21HI,1HI,
     31HI,1HI,1HI,
     41HI,1HV,
     51HJ,1HR/
      DATA LNGSUF/1,2,3,2,2/
      DATA KNTSUF/5/
C
C     VARIOUS OTHER CHARACTERS
C     LTRSPA = THE SPACE CHARACTER
C     LTRUPA = THE UP ARROW OR CIRCUMFLEX
C     LTRUND = THE LEFT ARROW OR UNDERSCORE
C     LTRAST = THE ASTERISK
C     LTRDOT = THE PERIOD
C     LTRCOM = THE COMMA
      DATA LTRSPA,LTRUPA,LTRUND,LTRAST,LTRDOT,LTRCOM/
     1 1H ,1H^,1H_,1H*,1H.,1H,/
C
C     UNIT NUMBERS
      DATA ITTY,IDISK/5,1/
C
C     TELL USER WHAT PROGRAM THIS IS
      WRITE(ITTY,1)
    1 FORMAT(' RSMSRT'/
     1' Sorts list of student names produced by RSMADM program')
C
C     OPEN INPUT FILE
      CALL RSMOPN(13,NUMWHO,IYEAR,ITTY,IDISK,IFOPEN)
      IF(IFOPEN.EQ.0)GO TO 72
C
C     READ STUDENT NUMBERS AND NAMES
      KNTNAM=0
    2 KNTNAM=KNTNAM+1
      IF(KNTNAM.GT.LMTNAM)GO TO 70
    3 READ(IDISK,4,END=26)(LTRNUM(KNTNAM,I),I=1,LMTNUM),
     1(LTRNAM(KNTNAM,I),I=1,LMTLNG),(LTRPAS(KNTNAM,I),I=1,LMTPAS)
    4 FORMAT(19X,6A1,1X,3A1,1X,30A1,20A1)
C
C     REJECT ANY LINE WITHOUT NUMBERS IN PROPER COLUMNS
      DO 6 I=1,LMTNUM
      LTRNOW=LTRNUM(KNTNAM,I)
      IF(LTRNOW.EQ.LTRSPA)GO TO 6
      DO 5 J=1,10
      IF(LTRNOW.EQ.LTRDGT(J))GO TO 6
    5 CONTINUE
      GO TO 3
    6 CONTINUE
C
C     CLEAN OUT THE CONTROL CHARACTERS FOR RESUME PROGRAM
      J=0
      DO 7 I=1,LMTLNG
      LTRNOW=LTRNAM(KNTNAM,I)
      IF(LTRNOW.EQ.LTRUPA)GO TO 7
      IF(LTRNOW.EQ.LTRUND)GO TO 7
      IF(LTRNOW.EQ.LTRAST)GO TO 7
      J=J+1
      IF(I.EQ.J)GO TO 7
      LTRNAM(KNTNAM,J)=LTRNOW
      LTRNAM(KNTNAM,I)=LTRSPA
    7 CONTINUE
C
C     LOOK FOR RIGHTMOST PRINTING CHARACTER, OR RIGHTMOST TO COMMA
      MAXBFR=0
      IFANY=0
      DO 9 I=1,LMTLNG
      LTRNOW=LTRNAM(KNTNAM,I)
      IF(LTRNOW.EQ.LTRSPA)GO TO 9
      IF(LTRNOW.EQ.LTRCOM)IFANY=1
      IF(IFANY.EQ.0)MAXBFR=I
      DO 8 J=1,26
      IF(LTRNOW.NE.LWRABC(J))GO TO 8
      LTRNAM(KNTNAM,I)=LTRABC(J)
      GO TO 9
    8 CONTINUE
    9 CONTINUE
C
C     EXCLUDE VARIOUS RIGHTMOST SUFFIXES
      IF(MAXBFR.LE.0)GO TO 17
      IF(KNTSUF.LE.0)GO TO 14
      MAXRJT=0
      DO 12 NOWRJT=1,KNTSUF
      MINRJT=MAXRJT+1
      MAXRJT=MAXRJT+LNGSUF(NOWRJT)
      NEWRJT=MAXBFR-LNGSUF(NOWRJT)
      IF(NEWRJT.LE.0)GO TO 12
      IF(LTRNAM(KNTNAM,NEWRJT).NE.LTRSPA)GO TO 12
      DO 10 KMPRJT=MINRJT,MAXRJT
      NEWRJT=NEWRJT+1
      IF(LTRNAM(KNTNAM,NEWRJT).NE.LTRSUF(KMPRJT))GO TO 12
   10 CONTINUE
      MAXBFR=MAXBFR-LNGSUF(NOWRJT)
   11 IF(LTRNAM(KNTNAM,MAXBFR).NE.LTRSPA)GO TO 13
      MAXBFR=MAXBFR-1
      IF(MAXBFR.GT.0)GO TO 11
      GO TO 17
   12 CONTINUE
   13 CONTINUE
C
C     EXCLUDE ANY RIGHTMOST ABBREVIATION ENDING IN PERIOD
   14 IF(MAXBFR.LE.0)GO TO 17
      IF(LTRNAM(KNTNAM,MAXBFR).NE.LTRDOT)GO TO 19
   15 MAXBFR=MAXBFR-1
      IF(MAXBFR.LE.0)GO TO 17
      IF(LTRNAM(KNTNAM,MAXBFR).NE.LTRSPA)GO TO 15
   16 MAXBFR=MAXBFR-1
      IF(MAXBFR.LE.0)GO TO 17
      IF(LTRNAM(KNTNAM,MAXBFR).EQ.LTRSPA)GO TO 16
      GO TO 19
   17 WRITE(ITTY,18)(LTRNUM(KNTNAM,I),I=1,LMTNUM),
     1(LTRNAM(KNTNAM,I),I=1,LMTLNG),(LTRPAS(KNTNAM,I),I=1,LMTPAS)
   18 FORMAT(' Following line has been rejected'/
     11X,6A1,1X,3A1,1X,30A1,20A1)
      GO TO 3
C
C     LOOK FOR LEFTMOST PRINTING CHARACTER IN LAST NAME
   19 MINBFR=MAXBFR
   20 IF(MINBFR.LE.0)GO TO 21
      IF(LTRNAM(KNTNAM,MINBFR).EQ.LTRSPA)GO TO 21
      MINBFR=MINBFR-1
      GO TO 20
   21 MINBFR=MINBFR+1
C
C     STORE THE STARTING POINT AND LENGTH OF LAST NAME
      LOCBGN(KNTNAM)=MINBFR
      LNGNAM(KNTNAM)=MAXBFR
C
C     EXCLUDE VARIOUS RIGHTMOST PREFIXES
      IF(KNTPRE.LE.0)GO TO 25
      NOWBFR=MINBFR
   22 NOWBFR=NOWBFR-1
      IF(NOWBFR.LE.0)GO TO 25
      IF(LTRNAM(KNTNAM,NOWBFR).EQ.LTRSPA)GO TO 22
      MAXRJT=0
      DO 24 NOWRJT=1,KNTPRE
      MINRJT=MAXRJT+1
      MAXRJT=MAXRJT+LNGPRE(NOWRJT)
      NEWRJT=NOWBFR-LNGPRE(NOWRJT)
      IF(NEWRJT.LE.0)GO TO 24
      IF(LTRNAM(KNTNAM,NEWRJT).NE.LTRSPA)GO TO 24
      DO 23 KMPRJT=MINRJT,MAXRJT
      NEWRJT=NEWRJT+1
      IF(LTRNAM(KNTNAM,NEWRJT).NE.LTRPRE(KMPRJT))GO TO 24
   23 CONTINUE
      NOWBFR=NOWBFR-LNGPRE(NOWRJT)
      LOCBGN(KNTNAM)=NOWBFR
      GO TO 25
   24 CONTINUE
   25 GO TO 2
C
C     REPORT THE NUMBER OF NAMES ENCOUNTERED
   26 CALL RSMCLS(13,NUMWHO,IYEAR,ITTY,IDISK,IFCLOS)
      KNTNAM=KNTNAM-1
      IF(KNTNAM.LE.0)GO TO 68
      WRITE(ITTY,27)KNTNAM
   27 FORMAT(' Number of names:',1I5)
C
C     OPEN OUTPUT FILE
      CALL RSMOPN(14,NUMWHO,IYEAR,ITTY,IDISK,IFOPEN)
      IF(IFOPEN.EQ.0)GO TO 74
C
C     PREPARE FOR SORT LOOP
C     IFANY  = 0 IF NO WORD WAS DISPLAYED ON PREVIOUS LINE
C     JFANY  = 0 IF NO MINIMUM HAS BEEN FOUND SINCE PREVIOUS LINE
C     LSTNAM = LOCATION OF NAME DISPLAYED ON PREVIOUS LINE
C     NXTNAM = LOCATION OF MINIMUM FOUND SINCE PREVIOUS LINE
C
      IFANY=0
      DO 67 IOUTER=1,KNTNAM
      JFANY=0
      DO 64 INNER=1,KNTNAM
C
C     TEST IF NEW WORD IS GREATER THAN OLD WORD
C     TRANSFER TO )64 IF NEW NAME HAS ALREADY BEEN PRINTED
C     TRANSFER TO )45 IF NEW NAME SORTS AFTER PREVIOUS NAME
C                     SO CAN TEST IF IT IS EARLIER THAN THE
C                     NEXT ONE WE HAVE READY TO BE PRINTED
      IF(IFANY.EQ.0)GO TO 45
      JTEST=LOCBGN(LSTNAM)
      KTEST=LOCBGN(INNER)
   28 IF(JTEST.GT.LNGNAM(LSTNAM))GO TO 34
      IF(KTEST.GT.LNGNAM(INNER))GO TO 34
   29 LTRNOW=LTRNAM(LSTNAM,JTEST)
      DO 30 I=1,26
      IF(LTRNOW.NE.LTRABC(I))GO TO 30
      JVALUE=I
      GO TO 31
   30 CONTINUE
      JTEST=JTEST+1
      IF(JTEST.LE.LNGNAM(LSTNAM))GO TO 29
   31 LTRNOW=LTRNAM(INNER,KTEST)
      DO 32 I=1,26
      IF(LTRNOW.NE.LTRABC(I))GO TO 32
      KVALUE=I
      GO TO 33
   32 CONTINUE
      KTEST=KTEST+1
      IF(KTEST.LE.LNGNAM(INNER))GO TO 31
   33 IF(JTEST.GT.LNGNAM(LSTNAM))GO TO 34
      IF(KTEST.GT.LNGNAM(INNER))GO TO 34
      IF(JVALUE.GT.KVALUE)GO TO 64
      IF(JVALUE.LT.KVALUE)GO TO 45
      JTEST=JTEST+1
      KTEST=KTEST+1
      GO TO 28
   34 IF(KTEST.GT.LNGNAM(INNER))GO TO 35
      IF(JTEST.GT.LNGNAM(LSTNAM))GO TO 45
      GO TO 64
   35 IF(JTEST.LE.LNGNAM(LSTNAM))GO TO 64
C
C     IF LAST NAMES MATCH, USE THE FIRST NAMES FOR SORT
      JTEST=1
      KTEST=1
      JBLANK=1
      KBLANK=1
   36 IF(JTEST.GE.LOCBGN(LSTNAM))GO TO 42
      IF(KTEST.GE.LOCBGN(INNER))GO TO 42
   37 LTRNOW=LTRNAM(LSTNAM,JTEST)
      DO 38 J=1,26
      IF(LTRNOW.NE.LTRABC(J))GO TO 38
      JVALUE=J
      GO TO 39
   38 CONTINUE
      JBLANK=1
      JTEST=JTEST+1
      IF(JTEST.LT.LOCBGN(LSTNAM))GO TO 37
   39 LTRNOW=LTRNAM(INNER,KTEST)
      DO 40 J=1,26
      IF(LTRNOW.NE.LTRABC(J))GO TO 40
      KVALUE=J
      GO TO 41
   40 CONTINUE
      KBLANK=1
      KTEST=KTEST+1
      IF(KTEST.LT.LOCBGN(INNER))GO TO 39
   41 CONTINUE
   42 IF(JTEST.GE.LOCBGN(LSTNAM))GO TO 44
      IF(KTEST.GE.LOCBGN(INNER))GO TO 64
      IF(JBLANK.EQ.KBLANK)GO TO 43
      IF(JBLANK.NE.0)GO TO 45
      GO TO 64
   43 IF(JVALUE.GT.KVALUE)GO TO 64
      IF(JVALUE.LT.KVALUE)GO TO 45
      JTEST=JTEST+1
      KTEST=KTEST+1
      JBLANK=0
      KBLANK=0
      GO TO 36
   44 IF(KTEST.LT.LOCBGN(INNER))GO TO 45
C
C     NAMES ARE EXACTLY THE SAME AS FAR AS WE CAN TELL
      IF(LSTNAM.GE.INNER)GO TO 64
C
C     TEST IF NEW WORD IS LESS THAN CURRENTLY FOUND MINIMUM
C     TRANSFER TO )64 IF NEW NAME SORTS AFTER THE NAME WHICH
C                     WE HAVE FOUND AS BEING THE NEXT TO PRINT
C     TRANSFER TO )63 IF NEW NAME SORTS BEFORE THE NAME WHICH
C                     WE HAVE FOUND AS BEING THE NEXT TO PRINT
   45 IF(JFANY.EQ.0)GO TO 63
      JTEST=LOCBGN(NXTNAM)
      KTEST=LOCBGN(INNER)
   46 IF(JTEST.GT.LNGNAM(NXTNAM))GO TO 52
      IF(KTEST.GT.LNGNAM(INNER))GO TO 52
   47 LTRNOW=LTRNAM(NXTNAM,JTEST)
      DO 48 I=1,26
      IF(LTRNOW.NE.LTRABC(I))GO TO 48
      JVALUE=I
      GO TO 49
   48 CONTINUE
      JTEST=JTEST+1
      IF(JTEST.LE.LNGNAM(NXTNAM))GO TO 47
   49 LTRNOW=LTRNAM(INNER,KTEST)
      DO 50 I=1,26
      IF(LTRNOW.NE.LTRABC(I))GO TO 50
      KVALUE=I
      GO TO 51
   50 CONTINUE
      KTEST=KTEST+1
      IF(KTEST.LE.LNGNAM(INNER))GO TO 49
   51 IF(JTEST.GT.LNGNAM(NXTNAM))GO TO 52
      IF(KTEST.GT.LNGNAM(INNER))GO TO 52
      IF(JVALUE.LT.KVALUE)GO TO 64
      IF(JVALUE.GT.KVALUE)GO TO 63
      JTEST=JTEST+1
      KTEST=KTEST+1
      GO TO 46
   52 IF(JTEST.GT.LNGNAM(NXTNAM))GO TO 53
      IF(KTEST.GT.LNGNAM(INNER))GO TO 63
      GO TO 64
   53 IF(KTEST.LE.LNGNAM(INNER))GO TO 64
C
C     IF LAST NAMES MATCH, USE THE FIRST NAMES FOR SORT
      JTEST=1
      KTEST=1
      JBLANK=1
      KBLANK=1
   54 IF(JTEST.GE.LOCBGN(NXTNAM))GO TO 60
      IF(KTEST.GE.LOCBGN(INNER))GO TO 60
   55 LTRNOW=LTRNAM(NXTNAM,JTEST)
      DO 56 J=1,26
      IF(LTRNOW.NE.LTRABC(J))GO TO 56
      JVALUE=J
      GO TO 57
   56 CONTINUE
      JBLANK=1
      JTEST=JTEST+1
      IF(JTEST.LT.LOCBGN(NXTNAM))GO TO 55
   57 LTRNOW=LTRNAM(INNER,KTEST)
      DO 58 J=1,26
      IF(LTRNOW.NE.LTRABC(J))GO TO 58
      KVALUE=J
      GO TO 59
   58 CONTINUE
      KBLANK=1
      KTEST=KTEST+1
      IF(KTEST.LT.LOCBGN(INNER))GO TO 57
   59 CONTINUE
   60 IF(KTEST.GE.LOCBGN(INNER))GO TO 62
      IF(JTEST.GE.LOCBGN(NXTNAM))GO TO 64
      IF(JBLANK.EQ.KBLANK)GO TO 61
      IF(KBLANK.NE.0)GO TO 63
      GO TO 64
   61 IF(JVALUE.LT.KVALUE)GO TO 64
      IF(JVALUE.GT.KVALUE)GO TO 63
      JTEST=JTEST+1
      KTEST=KTEST+1
      JBLANK=0
      KBLANK=0
      GO TO 54
   62 IF(JTEST.LT.LOCBGN(NXTNAM))GO TO 63
C
C     NAMES ARE EXACTLY THE SAME AS FAR AS WE CAN TELL
C     TEST IS ALWAYS TRUE IF REACH HERE
      IF(NXTNAM.LE.INNER)GO TO 64
C
C     STORE THE NEW MINIMUM
   63 JFANY=1
      NXTNAM=INNER
   64 CONTINUE
C
C     WRITE THE LOWEST NAME NOT YET WRITTEN
      IFANY=1
      LSTNAM=NXTNAM
      WRITE(IDISK,65)IOUTER,(LTRNUM(NXTNAM,I),I=1,LMTNUM),
     1(LTRNAM(NXTNAM,I),I=1,LMTLNG),(LTRPAS(NXTNAM,I),I=1,LMTPAS)
   65 FORMAT(1X,1I4,' Stdnt: ',6A1,
     1' Year: ',3A1,1X,30A1,20A1)
      WRITE(IDISK,66)
   66 FORMAT(1X)
   67 CONTINUE
      CALL RSMCLS(14,NUMWHO,IYEAR,ITTY,IDISK,IFCLOS)
      GO TO 76
C
C     ERROR MESSAGES
   68 WRITE(ITTY,69)
   69 FORMAT(' Input file is empty')
      GO TO 76
   70 WRITE(ITTY,71)LMTNAM
   71 FORMAT(' More than',1I6,' names in input file.'/
     1' Increase size of arrays and value of LMTNAM and run again.')
      GO TO 76
   72 WRITE(ITTY,73)
   73 FORMAT(' Cannot read unsorted file')
      GO TO 76
   74 WRITE(ITTY,75)
   75 FORMAT(' Cannot write sorted file')
      GO TO 76
   76 STOP
      END