Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50546/jobslo.for
There is 1 other file named jobslo.for in the archive. Click here to see a list.
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