C     RENBR(JOBSLO/JOBS - SMALL SLOW RANKING PROGRAM)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THIS PROGRAM IS PART OF THE JOB INTERVIEW REQUEST SYSTEM
C
C     *****************************************************
C     *                                                   *
C     *  ARRAYS LIMITING SIZE OF CASE HANDLED BY PROGRAM  *
C     *                                                   *
C     *****************************************************
C
C     DATES EACH RECRUITER IS VISITING SCHOOL
C     LMTINT=150 IS MAXIMUM NUMBER OF DAILY SCHEDULES FOR 1 FIRM
C
      DIMENSION JDATE(150),JFIRST(150)
C
C     INFORMATION FOR EVERY STUDENT WHO REQUESTED CURRENT FIRM
C     LMTONE=400 IS MAXIMUM NUMBER OF STUDENTS WHO CAN REQUEST 1 FIRM
C     LMTNAM=30 IS MAXIMUM LENGTH OF NAME OF 1 STUDENT
C
C     MJRPNT = LOCATION IN UNMOVING ARRAYS OF INFO ABOUT STUDENT
C     MJRFRM = FIRM NUMBER
C     MJRPRI = PRIORITY OF BID
C     MJRRNK = RANKING ON LIST
C     MJRCLS = IF ON CLOSED LIST
C     MJRSRC = IF REQUESTED BY STUDENT OR FIRM OR BOTH
C     MJRKLK = IF ASSIGNED INTERVIEW IN PREVIOUS STAGE
C
C     FOLLOWING 2 ARRAYS ARE NOT SORTED
C     MJRSTD = LOCATION OF STUDENT IN COMPOSITE FILE
C     LTRALL = NAMES OF THOSE STUDENTS MAKING REQUESTS
C
      DIMENSION MJRPNT(400),MJRFRM(400),MJRPRI(400),
     1MJRRNK(400),MJRCLS(400),MJRSTD(400),MJRSRC(400),
     2MJRKLK(400)
      DIMENSION LTRALL(30,400)
C
C     ************************************************************
C     *                                                          *
C     *  ARRAYS INDENPENDENT OF NUMBER OF STUDENTS OR SCHEDULES  *
C     *                                                          *
C     ************************************************************
C
C     ARRAYS WHICH STORE NAME, DEPARTMENT AND ADDRESS OF 1 FIRM
      DIMENSION LTRINC(40),LTRDPT(30),LTRADR(30)
C
C     ARRAY USED TO STORE LETTER REPRESENTATION OF CURRENT DATE
      DIMENSION LTRTIM(15)
C
C     PRIORITY NAMES A AND B
      DIMENSION LTRPRI(2)
C
C     IDENTIFICATION OF ONE STUDENT
C     LTRWHO = THE NAME OF THE ACCOUNT
C     LTRNAM = THE PERSON'S NAME
C     LTRPSW = THE PASSWORD FOR THE STUDENT
      DIMENSION LTRWHO(40),LTRNAM(30),LTRPSW(20)
C
C     LTRBFR = INPUT/OUTPUT BUFFER
      DIMENSION LTRBFR(80)
C
C     ARRAYS USED TO READY IN ENTIRE LINE WHEN COPY FILES
      DIMENSION IDUMMY(12),JDUMMY(13),KDUMMY(7),LDUMMY(4)
C
C     PRIORITY NAMES
      DATA LTRPRI/1HA,1HB/
C
C     ODD LETTERS
      DATA LTRSPA,LTRCOM,LTRQUE,LTRMIN,LTRSTA/1H ,1H,,1H?,1H-,1H*/
C
C     UNIT NUMBERS FOR TERMINAL AND FILES
C     ITTY   = UNIT NUMBER OF TERMINAL
C     IDISK  = UNIT FROM WHICH READ FILES
C     JDISK  = UNIT NUMBER TO WHICH WRITE LISTING
C     KDISK  = UNIT NUMBER TO WHICH WRITE NEW DATA FILES
      DATA ITTY,IDISK,JDISK,KDISK,LDISK/5,1,20,21,22/
C
C     DIMENSIONS OF ARRAYS CONTAINING CHARACTER INFORMATION
C     LMTINC = NUMBER OF CHARACTERS IN FIRM NAME
C     LMTDPT = NUMBER OF CHARACTERS IN DEPARTMENT NAME
C     LMTADR = NUMBER OF CHARACTERS IN ADDRESS
C     LMTBFR = NUMBER OF CHARACTERS IN LTRBFR ARRAY SCRATCH AREA
C     LMTNAM = NUMBER OF CHARACTERS IN SINGLE STUDENT NAME
      DATA LMTINC,LMTDPT,LMTADR,LMTBFR,LMTNAM/
     1 40,30,30,80,30/
C
C     DIMENSION OF ARRAYS LIMITING SIZE OF CASE HANDLED
C     LMTPRF = MAXIMUM NUMBER OF TIME PREFERENCES
C     LMTONE = MAXIMUM NUMBER OF STUDENTS REQUESTING 1 FIRM
C     LMTINT = MAXIMUM NUMBER OF SCHEDULES FOR 1 FIRM
      DATA LMTPRF,LMTONE,LMTINT/
     1 13,400,150/
C
C     TELL USER WHAT PROGRAM THIS IS
      WRITE(ITTY,1)
    1 FORMAT(' JOBSLO'/
     1' Small but slow ranking program for interview signup system'/
     21X)
C
C     **********************************
C     *                                *
C     *  ASK FOR RANDOM NUMBER KERNEL  *
C     *                                *
C     **********************************
C
C     ESTABLISH RANDOM FUNCTION KERNEL
      WRITE(ITTY,2)
    2 FORMAT(' Base random sequence upon what kernel: ',$)
      READ(ITTY,3)KERNEL
    3 FORMAT(I)
      IF(KERNEL.LT.0)WRITE(ITTY,4)
    4 FORMAT(' Negative kernel indicates verification not real run')
      IF(KERNEL.GE.0)CALL SETRAN(KERNEL)
C
C     ***************************************************
C     *                                                 *
C     *  ASK FOR USER TO IDENTIFY THE FILES TO BE READ  *
C     *                                                 *
C     ***************************************************
C
C     ORIGINAL FIRM FILE
      WRITE(ITTY,5)
    5 FORMAT(' ***** Input files *****')
      CALL LCLOPN( 1,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 1,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     STUDENT REQUEST FILE
      CALL LCLOPN( 2,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 2,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     LISTING FILE
      WRITE(ITTY,6)
    6 FORMAT(' ***** Output files *****')
      CALL LCLOPN( 4,1,2,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 4,1,2,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     ASK FOR NAME OF THE UPDATED FIRM FILE
      CALL LCLOPN( 5,1,3,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 5,1,3,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     ASK FOR NAME OF THE UPDATED STUDENT DECISION FILE TO BE WRITTEN
      CALL LCLOPN( 6,1,3,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 6,1,3,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     ASK FOR NAME OF LISTING FILE FOR STUDENT NAMES AND NUMBERS
      CALL LCLOPN( 7,1,2,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 7,1,2,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     ****************************************
C     *                                      *
C     *  PREPARE FOR FIRST TIME AROUND LOOP  *
C     *                                      *
C     ****************************************
C
C     OPEN THE LISTING FILE FOR STUDENTS BY RANK IN FIRM
      CALL LCLOPN( 4,0,2,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     GET THE CURRENT DATE AND TIME
      CALL TSTAMP(LTRTIM)
C
C     RECORD WHAT THE RANDOM NUMBER KERNEL WAS
      WRITE(JDISK,7)KERNEL
    7 FORMAT(' Kernel for random number generator',1I12)
      WRITE(JDISK,8)LTRTIM
    8 FORMAT(' (printed ',15A1,')')
C
C     ***************************************************
C     *                                                 *
C     *  ASK USER TO SPECIFY NEXT FIRM TO BE PROCESSED  *
C     *                                                 *
C     ***************************************************
C
C     INDICATE THAT HAVE NOT BEGUN UPDATE OF STUDENT FILE
      KNTCAS=0
C
C     ASK FOR NEXT COMPANY TO PROCESS
      GO TO 10
    9 IF(MFIRM.NE.0)GO TO 13
      NFIRM=NFIRM+1
      IF(NFIRM.LE.JFIRM)GO TO 14
   10 WRITE(ITTY,11)
   11 FORMAT(' First and last firm (-1 for all, 0 to exit)? ',$)
      READ(ITTY,12)NFIRM,JFIRM
   12 FORMAT(2I)
      IF(NFIRM.EQ.0)GO TO 143
      MFIRM=0
      IF(NFIRM.LT.0)MFIRM=1
      GO TO 14
   13 IF(MFIRM.GT.KNTINC)GO TO 143
   14 CONTINUE
C
C     EXPUNGE OLD SCRATCH FILES TO MAKE WAY FOR NEW
      CALL EXPUNG
C
C     **************************************
C     *                                    *
C     *  READ THE ADMINISTRATOR FIRM FILE  *
C     *                                    *
C     **************************************
C
      IF(KNTCAS.EQ.0)CALL LCLOPN( 1,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLOPN( 5,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      READ(IDISK,15)JAUTHR,JCLASS,JMOVE,JPASS,JVERSN,JWHOM
   15 FORMAT(6I)
      READ(IDISK,16)KNTINC,MAXNUM,MANNER,MAXSTG,MAXRND,
     1 MAXALL,MAXBID,MAXPAY
   16 FORMAT(8I)
      LOOKAT=0
   17 LOOKAT=LOOKAT+1
      IF(LOOKAT.GT.KNTINC)GO TO 26
      READ(IDISK,18)(LTRINC(I),I=1,LMTINC)
      READ(IDISK,19)(LTRDPT(I),I=1,LMTDPT)
      READ(IDISK,20)(LTRADR(I),I=1,LMTADR)
      READ(IDISK,21)NUMBER,LENGTH,
     1KNTOPN,INTRVW,IUSDUP,
     2INCLSD,JNCLSD
   18 FORMAT(40A1)
   19 FORMAT(30A1)
   20 FORMAT(30A1)
   21 FORMAT(7I)
      LIMIT=INTRVW
      IF(LIMIT.LE.0)GO TO 24
      DO 23 I=1,LIMIT
      READ(IDISK,22)LDUMMY
   22 FORMAT(4I)
      JDATE(I)=LDUMMY(1)
      JFIRST(I)=LDUMMY(2)
   23 CONTINUE
   24 CONTINUE
      IF(MFIRM.EQ.0)GO TO 25
      IF(LOOKAT.LT.MFIRM)GO TO 17
      NFIRM=NUMBER
      MFIRM=MFIRM+1
      GO TO 28
   25 IF(NUMBER.NE.NFIRM)GO TO 17
      GO TO 28
   26 IF(MFIRM.EQ.0)WRITE(ITTY,27)NFIRM
   27 FORMAT(' Firm',1I5,' is not active')
   28 IF(KNTCAS.EQ.0)CALL LCLCLS( 1,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLCLS( 5,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(MANNER.EQ.1)GO TO 164
      IF(KNTINC.EQ.0)GO TO 168
      IF(LOOKAT.GT.KNTINC)GO TO 9
C
C     ***********************************
C     *                                 *
C     *  READ THE STUDENT REQUEST FILE  *
C     *                                 *
C     ***********************************
C
      IF(KNTCAS.EQ.0)CALL LCLOPN( 2,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLOPN( 6,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     READ THE STUDENTS DECISION FILE
      KNTSTD=0
      KNTMJR=0
   29 KNTSTD=KNTSTD+1
      READ(IDISK,30,END=41)IAUTHR,ICLASS,IMOVE,IPASS,
     1 IVERSN,NUMWHO,LTRPSW
      READ(IDISK,31)ISUBMT,IUSED,KNTSIN,LOCKUP,IMANNR,KNTALL,IGVBAK
   30 FORMAT(6I,20A1)
   31 FORMAT(7I)
      READ(IDISK,32)LTRWHO
   32 FORMAT(40A1)
      READ(IDISK,33)LTRNAM
   33 FORMAT(30A1)
      IF(KNTSIN.LE.0)GO TO 39
      KOMPNY=1
      LOOKAT=0
   34 LOOKAT=LOOKAT+1
      IF(LOOKAT.GT.KNTSIN)GO TO 39
      READ(IDISK,35)IDUMMY
   35 FORMAT(12I)
      IF(IDUMMY(1).NE.NFIRM)GO TO 37
      IF(IMOVE.NE.JMOVE)GO TO 37
      IF(ISUBMT.EQ.4)GO TO 37
      IF(IDUMMY(5).GT.1)GO TO 37
      KNTMJR=KNTMJR+1
      IF(KNTMJR.GT.LMTONE)GO TO 37
      MJRPNT(KNTMJR)=KNTMJR
      MJRSTD(KNTMJR)=KNTSTD
      MJRFRM(KNTMJR)=NFIRM
      MJRPRI(KNTMJR)=IDUMMY(2)
      MJRRNK(KNTMJR)=IDUMMY(6)
      MJRCLS(KNTMJR)=IDUMMY(5)
      MJRSRC(KNTMJR)=IDUMMY(12)
      MJRKLK(KNTMJR)=IDUMMY(8)
      DO 36 I=1,LMTNAM
      LTRALL(I,KNTMJR)=LTRNAM(I)
   36 CONTINUE
   37 CONTINUE
      LIMIT=IDUMMY(3)
      IF(LIMIT.GT.0)READ(IDISK,38)(JDUMMY(I),I=1,LIMIT)
   38 FORMAT(13I)
      GO TO 34
   39 READ(IDISK,40)LTREND
   40 FORMAT(1A1)
      IF(LTREND.NE.LTRMIN)GO TO 162
      IF(ICLASS.NE.JCLASS)GO TO 158
      IF(IAUTHR.LT.11)GO TO 160
      IF(IAUTHR.GT.15)GO TO 160
      GO TO 29
C
C     ALL DONE READING STUDENT DECISIONS
   41 IF(KNTCAS.EQ.0)CALL LCLCLS( 2,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLCLS( 6,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      KNTSTD=KNTSTD-1
      IF(KNTMJR.GT.LMTONE)GO TO 166
      WRITE(ITTY,42)NFIRM,KNTMJR
   42 FORMAT(1X,'Firm',1I5,' requested by',1I5)
C
C     ***********************
C     *                     *
C     *  SORT THE REQUESTS  *
C     *                     *
C     ***********************
C
C     OUTER LOOP OF SORTING
      IF(KNTMJR.EQ.0)GO TO 63
      DO 49 IOUTER=1,KNTMJR
      LOWEST=IOUTER
      LOWFRM=MJRFRM(LOWEST)
      LOWRNK=MJRRNK(LOWEST)
      LOWPRI=MJRPRI(LOWEST)
      LOWSTD=MJRPNT(LOWEST)
      DO 48 INNER=IOUTER,KNTMJR
C
C     SORT BY FIRM NUMBER
      IF(LOWFRM.LT.MJRFRM(INNER))GO TO 48
      IF(LOWFRM.GT.MJRFRM(INNER))GO TO 47
C
C     SORT BY RANKING IN FIRST STAGE
C     NOTE THAT RANK ZERO SORTS ABOVE ANY POSITIVE VALUE
      IF(LOWRNK.GT.0)GO TO 43
      IF(MJRRNK(INNER).GT.0)GO TO 47
C     NEITHER REQUEST HAS BEEN RANKED
      GO TO 44
   43 IF(MJRRNK(INNER).EQ.0)GO TO 48
C     BOTH INTERVIEWS ALREADY RANKED
      IF(LOWRNK.LT.MJRRNK(INNER))GO TO 48
      IF(LOWRNK.GT.MJRRNK(INNER))GO TO 47
C
C     SORT BY PRIORITY
   44 IF(MANNER.GT.20)GO TO 45
      IF(LOWPRI.LT.MJRPRI(INNER))GO TO 48
      IF(LOWPRI.GT.MJRPRI(INNER))GO TO 47
      GO TO 46
   45 IF(LOWPRI.GT.MJRPRI(INNER))GO TO 48
      IF(LOWPRI.LT.MJRPRI(INNER))GO TO 47
      GO TO 46
C
C     SORT BY STUDENT NUMBER
   46 IF(LOWSTD.LT.MJRPNT(INNER))GO TO 48
      IF(LOWSTD.GT.MJRPNT(INNER))GO TO 47
   47 LOWEST=INNER
      LOWFRM=MJRFRM(LOWEST)
      LOWRNK=MJRRNK(LOWEST)
      LOWPRI=MJRPRI(LOWEST)
      LOWSTD=MJRPNT(LOWEST)
   48 CONTINUE
      IF(LOWEST.EQ.IOUTER)GO TO 49
C
C     EXCHANGE LOCATION IN FIXED ARRAYS
      ISAVE=MJRPNT(LOWEST)
      MJRPNT(LOWEST)=MJRPNT(IOUTER)
      MJRPNT(IOUTER)=ISAVE
C
C     EXCHANGE FIRM NUMBER
      ISAVE=MJRFRM(LOWEST)
      MJRFRM(LOWEST)=MJRFRM(IOUTER)
      MJRFRM(IOUTER)=ISAVE
C
C     EXCHANGE RANKING
      ISAVE=MJRRNK(LOWEST)
      MJRRNK(LOWEST)=MJRRNK(IOUTER)
      MJRRNK(IOUTER)=ISAVE
C
C     EXCHANGE PRIORITY
      ISAVE=MJRPRI(LOWEST)
      MJRPRI(LOWEST)=MJRPRI(IOUTER)
      MJRPRI(IOUTER)=ISAVE
C
C     EXCHANGE BEING PLACED ON CLOSED SCHEDULE
      ISAVE=MJRCLS(LOWEST)
      MJRCLS(LOWEST)=MJRCLS(IOUTER)
      MJRCLS(IOUTER)=ISAVE
C
C     EXCHANGE IF REQUESTED BY STUDENT OR FIRM OR BOTH
      ISAVE=MJRSRC(LOWEST)
      MJRSRC(LOWEST)=MJRSRC(IOUTER)
      MJRSRC(IOUTER)=ISAVE
C
C     EXCHANGE IF ASSIGNED INTERVIEW IN PREVIOUS STAGE
      ISAVE=MJRKLK(LOWEST)
      MJRKLK(LOWEST)=MJRKLK(IOUTER)
      MJRKLK(IOUTER)=ISAVE
   49 CONTINUE
C
C     *****************************************
C     *                                       *
C     *  ASSIGN RANKINGS TO THE NEW REQUESTS  *
C     *                                       *
C     *****************************************
C
C     FIND START AND END OF SAME PRIORITY VALUE
      LMTRNK=0
   50 IF(LMTRNK.GE.KNTMJR)GO TO 59
      INIPRI=LMTRNK+1
   51 LMTRNK=LMTRNK+1
      IF(LMTRNK.GT.KNTMJR)GO TO 52
      IF(MJRPRI(INIPRI).EQ.MJRPRI(LMTRNK))GO TO 51
   52 LMTRNK=LMTRNK-1
C
C     FIND START OF UNRANKED REQUESTS
      INIRNK=INIPRI
   53 IF(INIRNK.GT.LMTRNK)GO TO 54
      IF(MJRRNK(INIRNK).EQ.0)GO TO 54
      INIRNK=INIRNK+1
      GO TO 53
   54 IF(INIPRI.EQ.INIRNK)GO TO 58
C
C     FILL GAPS IN PREVIOUSLY ASSIGNED RANKS IF STUDENTS CANCELLED
      INIRNK=INIRNK-1
      DO 57 IOUTER=INIPRI,INIRNK
      IFOUND=0
      DO 56 INNER=INIPRI,INIRNK
      IF(MJRRNK(INNER).LT.IOUTER)GO TO 56
      IF(MJRRNK(INNER).EQ.IOUTER)GO TO 57
      IF(IFOUND.EQ.0)GO TO 55
      IF(MINMUM.LT.MJRRNK(INNER))GO TO 56
   55 IFOUND=1
      LOCATN=INNER
      MINMUM=MJRRNK(INNER)
   56 CONTINUE
      MJRRNK(LOCATN)=IOUTER
   57 CONTINUE
      IF(INIRNK.GE.LMTRNK)GO TO 50
      INIRNK=INIRNK+1
C
C     ASSIGN RANDOM VALUES TO THE UNRANKED REQUESTS
   58 IOFFST=INIRNK-1
      CALL RANK(KERNEL,MJRRNK,INIRNK,LMTRNK,IOFFST)
      GO TO 50
   59 CONTINUE
C
C     ***********************************
C     *                                 *
C     *  SORT THE REQUESTS BY RANKINGS  *
C     *                                 *
C     ***********************************
C
C     SORT THE REQUESTS BY RANK
      DO 62 IOUTER=1,KNTMJR
      LOWEST=IOUTER
      LOWRNK=MJRRNK(LOWEST)
      DO 61 INNER=IOUTER,KNTMJR
      IF(LOWRNK.LT.MJRRNK(INNER))GO TO 61
      IF(LOWRNK.GT.MJRRNK(INNER))GO TO 60
   60 LOWEST=INNER
      LOWFRM=MJRFRM(LOWEST)
      LOWRNK=MJRRNK(LOWEST)
      LOWPRI=MJRPRI(LOWEST)
      LOWSTD=MJRPNT(LOWEST)
   61 CONTINUE
      IF(LOWEST.EQ.IOUTER)GO TO 62
C
C     EXCHANGE LOCATION IN FIXED ARRAYS
      ISAVE=MJRPNT(LOWEST)
      MJRPNT(LOWEST)=MJRPNT(IOUTER)
      MJRPNT(IOUTER)=ISAVE
C
C     EXCHANGE FIRM NUMBER
      ISAVE=MJRFRM(LOWEST)
      MJRFRM(LOWEST)=MJRFRM(IOUTER)
      MJRFRM(IOUTER)=ISAVE
C
C     EXCHANGE RANKING
      ISAVE=MJRRNK(LOWEST)
      MJRRNK(LOWEST)=MJRRNK(IOUTER)
      MJRRNK(IOUTER)=ISAVE
C
C     EXCHANGE PRIORITY
      ISAVE=MJRPRI(LOWEST)
      MJRPRI(LOWEST)=MJRPRI(IOUTER)
      MJRPRI(IOUTER)=ISAVE
C
C     EXCHANGE BEING PLACED ON CLOSED SCHEDULE
      ISAVE=MJRCLS(LOWEST)
      MJRCLS(LOWEST)=MJRCLS(IOUTER)
      MJRCLS(IOUTER)=ISAVE
C
C     EXCHANGE IF REQUESTED BY STUDENT OR FIRM OR BOTH
      ISAVE=MJRSRC(LOWEST)
      MJRSRC(LOWEST)=MJRSRC(IOUTER)
      MJRSRC(IOUTER)=ISAVE
C
C     EXCHANGE IF ASSIGNED INTERVIEW IN PREVIOUS STAGE
      ISAVE=MJRKLK(LOWEST)
      MJRKLK(LOWEST)=MJRKLK(IOUTER)
      MJRKLK(IOUTER)=ISAVE
   62 CONTINUE
   63 CONTINUE
C
C     **********************************
C     *                                *
C     *  COUNT REQUESTS FOR EACH FIRM  *
C     *                                *
C     **********************************
C
C     NUMBER OF STUDENTS WHO REQUESTED INTERVIEWS
      IUSDUP=KNTMJR
C
C     NUMBER OF STUDENTS WHO ARE IN CLOSED SCHEDULE
      J=0
      IF(KNTMJR.EQ.0)GO TO 65
      DO 64 I=1,KNTMJR
      IF(MJRCLS(I).NE.0)J=J+1
   64 CONTINUE
   65 INCLSD=J
C
C     NUMBER OF STUDENTS ABOVE LINE WHO ARE IN CLOSED SCHEDULE
      J=0
      K=0
      IF(KNTMJR.EQ.0)GO TO 67
      DO 66 I=1,KNTMJR
      IF(K.GE.KNTOPN)GO TO 67
      IF(MJRCLS(I).EQ.0)K=K+1
      IF(MJRCLS(I).NE.0)J=J+1
   66 CONTINUE
   67 JNCLSD=J
C
C     ***********************************
C     *                                 *
C     *  LIST STUDENTS BY RANK IN FIRM  *
C     *                                 *
C     ***********************************
C
C     WRITE THE TABLE FOR CURRENT FIRM
      NOWREQ=0
      KNTLIN=-1
      LMTLIN=KNTOPN+INCLSD
      IF(LMTLIN.LT.KNTMJR)LMTLIN=KNTMJR
      LMTLIN=LMTLIN+1
      NOWLIN=0
      MRKLIN=KNTOPN+JNCLSD+1
      KANCEL=0
      ISLOT=0
      I=NOWREQ+MRKLIN
      J=NOWREQ+KNTMJR
   68 IF(I.GT.J)GO TO 70
      IF(MJRKLK(I).EQ.0)GO TO 69
      KANCEL=KANCEL+1
      MRKLIN=I-NOWREQ+1
   69 I=I+1
      GO TO 68
   70 DO 105 NEWLIN=1,LMTLIN
      IF(KNTLIN.GT.0)GO TO 86
      IF(KNTLIN.EQ.0)WRITE(JDISK,71)JCLASS,JMOVE,JPASS,LTRTIM
   71 FORMAT(1X/
     1' * by name indicates student was invited to closed schedule'/
     2' - by name indicates student was invited, but is shown',
     3' on open schedule'/
     4' Class',1I5,', Round',1I3,', Stage',1I3,
     5' (printed ',15A1,')')
      WRITE(JDISK,72)NFIRM,(LTRINC(I),I=1,LMTINC)
   72 FORMAT('1Code:',1I10,' Firm: ',40A1)
C
C     CONSTRUCT DATE IN FORM DD-MMM-YY
      LOWBFR=0
      ISMITH=0
      JSMITH=0
      IF(KNTOPN.LE.0)GO TO 75
      J=INTRVW
      DO 74 I=1,J
      IF(JDATE(I).LT.0)GO TO 74
      IF(JFIRST(I).LT.0)GO TO 74
      IF(ISMITH.EQ.0)GO TO 73
      IF(ISMITH.GT.JDATE(I))ISMITH=JDATE(I)
      IF(JSMITH.LT.JDATE(I))JSMITH=JDATE(I)
      GO TO 74
   73 ISMITH=JDATE(I)
      JSMITH=ISMITH
   74 CONTINUE
      IF(ISMITH.EQ.0)GO TO 75
      CALL DAWHEN(ISMITH,NDAY,NMONTH,NYEAR,LTRBFR,LOWBFR,LMTBFR)
      IF(ISMITH.EQ.JSMITH)GO TO 75
      CALL DAWHEN(JSMITH,NDAY,NMONTH,NYEAR,LTRBFR,LOWBFR,LMTBFR)
   75 CONTINUE
C
      IF(ISMITH.NE.JSMITH)GO TO 81
      IF(ISMITH.NE.0)GO TO 78
C
C     CANCELLED
      WRITE(JDISK,76)(LTRDPT(I),I=1,LMTDPT)
   76 FORMAT(' Date: CANCELLED Dept: ',40A1)
      WRITE(JDISK,77)(LTRADR(I),I=1,LMTADR)
   77 FORMAT(' ',15X,' Adrs: ',40A1)
      GO TO 84
C
C     SINGLE DATE
   78 WRITE(JDISK,79)(LTRBFR(I),I=1,9),(LTRDPT(I),I=1,LMTDPT)
   79 FORMAT(' Date: ',9A1,' Dept: ',40A1)
      WRITE(JDISK,80)(LTRADR(I),I=1,LMTADR)
   80 FORMAT(' ',15X,' Adrs: ',40A1)
      GO TO 84
C
C     RANGE OF DATES
   81 WRITE(JDISK,82)(LTRBFR(I),I=1,9),(LTRDPT(I),I=1,LMTDPT)
   82 FORMAT(' Date: ',9A1,' Dept: ',40A1)
      WRITE(JDISK,83)(LTRBFR(I),I=10,18),(LTRADR(I),I=1,LMTADR)
   83 FORMAT('   to: ',9A1,' Adrs: ',40A1)
   84 CONTINUE
C
C     SKIP LINE ABOVE LIST OF STUDENTS
      WRITE(JDISK,85)
   85 FORMAT(1X)
C     FULL NUMBER OF LINES ON PAGE
      KNTLIN=62
C     REDUCE FOR HEADER
      KNTLIN=KNTLIN-4
C     REDUCE FOR TRAILER
      KNTLIN=KNTLIN-4
   86 KNTLIN=KNTLIN-1
      IF(NEWLIN.EQ.MRKLIN)GO TO 102
      NOWLIN=NOWLIN+1
      NOWREQ=NOWREQ+1
      IF(NOWREQ.GT.KNTMJR)GO TO 100
      NOWSTD=MJRPNT(NOWREQ)
      NOWPRI=MJRPRI(NOWREQ)
      J=LMTNAM
   87 IF(LTRALL(J,NOWSTD).NE.LTRSPA)GO TO 88
      J=J-1
      IF(J.GT.1)GO TO 87
   88 LTRNOW=LTRSPA
      IF(MJRSRC(NOWREQ).NE.0)LTRNOW=LTRMIN
      IF(MJRCLS(NOWREQ).NE.0)LTRNOW=LTRSTA
      IF(MANNER.GT.20)GO TO 96
      IF(MANNER.GT.10)GO TO 92
C
C     PRIORITY VALUE 1.0 THROUGH N.0
      IONE=NOWPRI/10
      ITWO=NOWPRI-(10*IONE)
      IF(NEWLIN.GT.MRKLIN)GO TO 90
      IF(MJRCLS(NOWREQ).NE.0)GO TO 90
      ISLOT=ISLOT+1
      WRITE(JDISK,89)ISLOT,IONE,ITWO,LTRNOW,
     1(LTRALL(I,NOWSTD),I=1,J)
   89 FORMAT(1X,1I5,1I3,'.',1I1,1X,1A1,60A1)
      GO TO 105
   90 WRITE(JDISK,91)IONE,ITWO,LTRNOW,
     1(LTRALL(I,NOWSTD),I=1,J)
   91 FORMAT(1X,5X,1I3,'.',1I1,1X,1A1,60A1)
      GO TO 105
C
C     PRIORITY TYPES A AND B
   92 IF(NEWLIN.GT.MRKLIN)GO TO 94
      IF(MJRCLS(NOWREQ).NE.0)GO TO 94
      ISLOT=ISLOT+1
      WRITE(JDISK,93)ISLOT,LTRPRI(NOWPRI),LTRNOW,
     1(LTRALL(I,NOWSTD),I=1,J)
   93 FORMAT(1X,1I5,2X,1A1,1X,1A1,60A1)
      GO TO 105
   94 WRITE(JDISK,95)LTRPRI(NOWPRI),LTRNOW,
     1(LTRALL(I,NOWSTD),I=1,J)
   95 FORMAT(1X,5X,2X,1A1,1X,1A1,60A1)
      GO TO 105
C
C     BIDS 0 AND UP
   96 IF(NEWLIN.GT.MRKLIN)GO TO 98
      IF(MJRCLS(NOWREQ).NE.0)GO TO 98
      ISLOT=ISLOT+1
      WRITE(JDISK,97)ISLOT,NOWPRI,LTRNOW,
     1(LTRALL(I,NOWSTD),I=1,J)
   97 FORMAT(1X,1I5,1I10,1X,1A1,60A1)
      GO TO 105
   98 WRITE(JDISK,99)NOWPRI,LTRNOW,
     1(LTRALL(I,NOWSTD),I=1,J)
   99 FORMAT(1X,5X,1I10,1X,1A1,60A1)
      GO TO 105
C
C     UNUSED SLOT
  100 ISLOT=ISLOT+1
      WRITE(JDISK,101)ISLOT
  101 FORMAT(1X,1I5)
      GO TO 105
C
C     DIVIDING LINE
  102 IF(KANCEL.EQ.0)WRITE(JDISK,103)
      IF(KANCEL.GT.0)WRITE(JDISK,104)KANCEL
  103 FORMAT(' ',10X,'---------------')
  104 FORMAT(' ',10X,'---------------',1I6,' of above ar',
     1'e on cancelled schedules')
  105 CONTINUE
C
C     SPACE DOWN TO DATE AT BOTTOM OF PAGE
  106 IF(KNTLIN.LE.0)GO TO 108
      KNTLIN=KNTLIN-1
      WRITE(JDISK,107)
  107 FORMAT(1X)
      GO TO 106
  108 WRITE(JDISK,71)JCLASS,JMOVE,JPASS,LTRTIM
C
C     ***********************************
C     *                                 *
C     *  WRITE ADMINISTRATOR FIRM FILE  *
C     *                                 *
C     ***********************************
C
      IF(KNTCAS.EQ.0)CALL LCLOPN( 1,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLOPN( 5,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLOPN( 5,0,3,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     HEADER INFORMATION
      READ(IDISK,109)JAUTHR,JCLASS,JMOVE,JPASS,JVERSN,JWHOM
  109 FORMAT(6I)
      READ(IDISK,110)KNTINC,MAXNUM,MANNER,MAXSTG,MAXRND,
     1 MAXALL,MAXBID,MAXPAY
  110 FORMAT(8I)
      JAUTHR=2
      IF(KNTCAS.EQ.0)JVERSN=JVERSN+1
      WRITE(KDISK,111)JAUTHR,JCLASS,JMOVE,JPASS,JVERSN,JWHOM
  111 FORMAT(5I6,1I7)
      WRITE(KDISK,112)KNTINC,MAXNUM,MANNER,MAXSTG,MAXRND,
     1 MAXALL,MAXBID,MAXPAY
  112 FORMAT(6I6,2I10)
      IF(KNTINC.LE.0)GO TO 124
      DO 123 NOWINC=1,KNTINC
      READ(IDISK,113)(LTRINC(I),I=1,LMTINC)
      WRITE(KDISK,113)(LTRINC(I),I=1,LMTINC)
      READ(IDISK,114)(LTRDPT(I),I=1,LMTDPT)
      WRITE(KDISK,114)(LTRDPT(I),I=1,LMTDPT)
      READ(IDISK,115)(LTRADR(I),I=1,LMTADR)
      WRITE(KDISK,115)(LTRADR(I),I=1,LMTADR)
  113 FORMAT(40A1)
  114 FORMAT(30A1)
  115 FORMAT(30A1)
      READ(IDISK,116)KDUMMY
  116 FORMAT(7I)
      IF(KDUMMY(1).NE.NFIRM)GO TO 117
      KDUMMY(5)=KNTMJR
      KDUMMY(6)=INCLSD
      KDUMMY(7)=JNCLSD
  117 WRITE(KDISK,118)KDUMMY
  118 FORMAT(7I6)
      LIMIT=KDUMMY(4)
      IF(LIMIT.LE.0)GO TO 122
      DO 121 I=1,LIMIT
      READ(IDISK,119)LDUMMY
  119 FORMAT(4I)
      WRITE(KDISK,120)LDUMMY
  120 FORMAT(4I6)
  121 CONTINUE
  122 CONTINUE
  123 CONTINUE
  124 IF(KNTCAS.EQ.0)CALL LCLCLS( 1,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLCLS( 5,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 5,0,3,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     ************************************
C     *                                  *
C     *  WRITE THE STUDENT REQUEST FILE  *
C     *                                  *
C     ************************************
C
      IF(KNTCAS.EQ.0)CALL LCLOPN( 2,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLOPN( 6,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLOPN( 6,0,3,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     LOCATION OF NEXT STUDENT TO BE UPDATED
      NXTSTD=1
C
C     COPY HEADER INFORMATION FOR THIS PERSON
      NOWSTD=0
  125 NOWSTD=NOWSTD+1
      IF(NOWSTD.GT.KNTSTD)GO TO 142
      READ(IDISK,126)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN,
     1 NUMWHO,LTRPSW
      READ(IDISK,127)ISUBMT,IUSED,KNTSIN,LOCKUP,IMANNR,KNTALL,IGVBAK
  126 FORMAT(6I,20A1)
  127 FORMAT(7I)
      IAUTHR=12
      LOCKUP=KNTSIN
      IF(ISUBMT.LE.1)ISUBMT=2
      WRITE(KDISK,128)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN,
     1 NUMWHO,LTRPSW
      WRITE(KDISK,129)ISUBMT,IUSED,KNTSIN,LOCKUP,IMANNR,KNTALL,IGVBAK
  128 FORMAT(5I6,1I7,1X,20A1)
  129 FORMAT(1I6,1I10,4I6,1I10)
      READ(IDISK,130)LTRWHO
      WRITE(KDISK,130)LTRWHO
  130 FORMAT(40A1)
      READ(IDISK,131)LTRNAM
      WRITE(KDISK,131)LTRNAM
  131 FORMAT(30A1)
C
C     COPY THE REQUESTS FOR THIS STUDENT, UPDATING THEM
      IF(KNTSIN.LE.0)GO TO 140
      DO 139 KOMPNY=1,KNTSIN
      READ(IDISK,132)IDUMMY
  132 FORMAT(12I)
      IF(IMOVE.NE.JMOVE)GO TO 135
      IF(ISUBMT.EQ.4)GO TO 135
      IF(IDUMMY(5).GT.1)GO TO 135
      IF(IDUMMY(1).NE.NFIRM)GO TO 135
      IF(MJRSTD(NXTSTD).NE.NOWSTD)GO TO 135
C
C     LOCATE STUDENT RANKING FOR THIS COMPANY
      J=IDUMMY(1)
      K=0
      IDUMMY(6)=0
      IDUMMY(7)=0
      INIREQ=0
  133 INIREQ=INIREQ+1
      IF(INIREQ.GT.KNTMJR)GO TO 134
      IF(MJRCLS(INIREQ).EQ.0)K=K+1
      IF(MJRPNT(INIREQ).NE.NXTSTD)GO TO 133
      IDUMMY(6)=MJRRNK(INIREQ)
      IDUMMY(7)=K
  134 NXTSTD=NXTSTD+1
C
C     WRITE THE NEW LINE FOR THIS COMPANY
  135 WRITE(KDISK,136)IDUMMY
  136 FORMAT(1I6,1I10,10I6)
      LIMIT=IDUMMY(3)
      IF(LIMIT.LE.0)GO TO 139
      READ(IDISK,137)(JDUMMY(I),I=1,LIMIT)
  137 FORMAT(13I)
      WRITE(KDISK,138)(JDUMMY(I),I=1,LIMIT)
  138 FORMAT(13I6)
  139 CONTINUE
C
C     COPY THE - AT END OF STUDENT ENTRY
  140 READ(IDISK,141)LTREND
      WRITE(KDISK,141)LTREND
  141 FORMAT(1A1)
      GO TO 125
  142 CONTINUE
      IF(KNTCAS.EQ.0)CALL LCLCLS( 2,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLCLS( 6,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 6,0,3,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     ********************************
C     *                              *
C     *  ALL DONE WITH CURRENT FIRM  *
C     *                              *
C     ********************************
C
      KNTCAS=KNTCAS+1
      GO TO 9
C
C     *****************************
C     *                           *
C     *  ALL DONE WITH ALL FIRMS  *
C     *                           *
C     *****************************
C
C     CLOSE THE LISTING FILE
  143 WRITE(JDISK,144)
  144 FORMAT(1H1,'END')
      CALL LCLCLS( 4,1,2,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     *********************************
C     *                               *
C     *  WRITE LIST OF STUDENT NAMES  *
C     *                               *
C     *********************************
C
C     OPEN FILE USED IN THIS SECTION
      IF(KNTCAS.EQ.0)CALL LCLOPN( 2,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLOPN( 6,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLOPN( 7,0,3,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C     GET HEADER INFORMATION FOR THIS PERSON
      WRITE(KDISK,145)JCLASS,JMOVE,JPASS,LTRTIM
  145 FORMAT(' Class',1I5,', Round',1I3,', Stage',1I3,
     1' (printed ',15A1,')'/1X)
      NOWSTD=0
  146 NOWSTD=NOWSTD+1
      IF(NOWSTD.GT.KNTSTD)GO TO 157
      READ(IDISK,147)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN,
     1 NUMWHO,LTRPSW
      READ(IDISK,148)ISUBMT,IUSED,KNTSIN,LOCKUP,IMANNR,KNTALL,IGVBAK
  147 FORMAT(6I,20A1)
  148 FORMAT(7I)
      READ(IDISK,149)LTRWHO
  149 FORMAT(40A1)
      READ(IDISK,150)LTRNAM
  150 FORMAT(30A1)
      IF(ISUBMT.NE.4)WRITE(KDISK,151)NUMWHO,LTRNAM,LTRPSW
  151 FORMAT(1X,1I6,1X,30A1,20A1)
C
C     GET THE INTERVIEW REQUESTS FOR THIS STUDENT
      IF(KNTSIN.LE.0)GO TO 155
      DO 154 KOMPNY=1,KNTSIN
      READ(IDISK,152)IDUMMY
  152 FORMAT(12I)
      LIMIT=IDUMMY(3)
      IF(LIMIT.LE.0)GO TO 154
      READ(IDISK,153)(JDUMMY(I),I=1,LIMIT)
  153 FORMAT(13I)
  154 CONTINUE
C
C     READ THE - AT END OF STUDENT ENTRY
  155 READ(IDISK,156)LTREND
  156 FORMAT(1A1)
      GO TO 146
  157 CONTINUE
      IF(KNTCAS.EQ.0)CALL LCLCLS( 2,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      IF(KNTCAS.NE.0)CALL LCLCLS( 6,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
      CALL LCLCLS( 7,0,3,ITTY,IDISK,JDISK,KDISK,LDISK)
      GO TO 171
C
C     ********************
C     *                  *
C     *  ERROR MESSAGES  *
C     *                  *
C     ********************
C
  158 WRITE(ITTY,159)
  159 FORMAT(' Composite request file is for wrong class')
      GO TO 170
  160 WRITE(ITTY,161)
  161 FORMAT(' Input file is not a composite request file')
      GO TO 170
  162 WRITE(ITTY,163)KNTSTD
  163 FORMAT(' Composite request file not correctly term',
     1'inated for student',1I4)
      GO TO 170
  164 WRITE(ITTY,165)MANNER
  165 FORMAT(' Ranking method',1I3,' not supported by this version')
      GO TO 170
  166 WRITE(ITTY,167)LMTONE,KNTMJR
  167 FORMAT(
     1' Too many students requested interviews with one firm'/
     2' Increase dimension of major arrays from',1I6,' to',1I6)
      GO TO 170
  168 WRITE(ITTY,169)
  169 FORMAT(' No schedules supplied by administrator')
  170 STOP
  171 STOP
      END
