Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50546/jobsch.for
There is 1 other file named jobsch.for in the archive. Click here to see a list.
C RENBR(JOBSCH/JOBS - STUDENT SCHEDULE PROGRAM)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS PROGRAM IS PART OF THE JOB INTERVIEW REQUEST SYSTEM
C
C ARRAYS WHICH STORE INFORMATION ABOUT REQUESTS BY 1 STUDENT
DIMENSION NUMVOT(100),KLOCK(100),MTIME(100),MDATE(100),
1MRECRT(100),KLOSED(100),JRANK(100)
C
C ARRAYS WHICH STORE INFORMATION ABOUT ALL FIRMS RECRUITING
DIMENSION LTRINC(40,200),LTRDPT(30,200),LTRADR(30,200),
1NUMBER(200),KNTOPN(200)
DIMENSION LTRTIM(15),IDUMMY(12),JDUMMY(13),KDUMMY(7),LDUMMY(3)
C
C IDENTIFICATION OF THIS USER
C LTRWHO = THE NAME OF THE ACCOUNT
C LTRNAM = THE PERSON'S NAME
C LTRPSW = THE PASSWORD USED BY THE STUDENT
DIMENSION LTRWHO(40),LTRNAM(30),LTRPSW(20)
C
C LTRBFR = INPUT/OUTPUT BUFFER
DIMENSION LTRBFR(80)
C
C LTRWEK = NAMES OF DAYS OF WEEK
DIMENSION LTRWEK(21)
C
C ODD LETTERS
DATA LTRSPA,LTRCOM,LTRMIN/1H ,1H,,1H-/
C
C UNIT NUMBERS FOR TERMINAL AND FILES
DATA ITTY,IDISK,JDISK,KDISK,LDISK/5,1,20,21,22/
C
C ARRAY SIZES
DATA LMTINC,LMTDPT,LMTADR,LMTBFR,LMTNAM,LMTSIN,LMTPRF,
1LMTFRM/
240,30,30,80,30,100,13,200/
C
C NAMES OF DAYS OF WEEK
DATA LTRWEK/
1 1HS,1Hu,1Hn,
2 1HM,1Ho,1Hn,
3 1HT,1Hu,1He,
4 1HW,1He,1Hd,
5 1HT,1Hh,1Hu,
6 1HF,1Hr,1Hi,
7 1HS,1Ha,1Ht/
C
C TELL USER WHAT PROGRAM THIS IS
WRITE(ITTY,1)
1 FORMAT(' LIST'/
1' Lists interviews scheduled for each student'/
2' The scheduling must already have been done'/
3' ')
C
C GET CURRENT DATE AND TIME
CALL TSTAMP(LTRTIM)
C
C ***************************************************
C * *
C * ASK FOR USER TO IDENTIFY THE FILES TO BE READ *
C * *
C ***************************************************
C
C LOCATE THE ADMINISTRATOR FIRM FILE
WRITE(ITTY,2)
2 FORMAT(' ***** Input files *****')
CALL LCLOPN( 5,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
CALL LCLCLS( 5,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C LOCATE THE STUDENT DECISION FILE
CALL LCLOPN( 8,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
CALL LCLCLS( 8,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C ASK FOR NAME OF LISTING FILE
WRITE(ITTY,3)
3 FORMAT(' ***** Output files *****')
CALL LCLOPN(10,1,2,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C **************************************
C * *
C * READ THE ADMINISTRATOR FIRM FILE *
C * *
C **************************************
C
C OPEN THE FIRM FILE
CALL LCLOPN( 5,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C READ FIRST LINE OF FIRM FILE
READ(IDISK,4)IAUTHR,ICLASS,JMOVE,JPASS,IVERSN,NUMWHO
4 FORMAT(6I)
READ(IDISK,5)KNTINC,MAXNUM,MANNER,MAXSTG,MAXRND,
1 MAXALL,MAXBID,MAXPAY
5 FORMAT(8I)
IF(KNTINC.GT.LMTFRM)GO TO 99
C
C GET NAME, DEPARTMENT, ADDRESS, NUMBER FOR EACH FIRM
NOWINC=0
6 NOWINC=NOWINC+1
IF(NOWINC.GT.KNTINC)GO TO 14
READ(IDISK,7)(LTRINC(I,NOWINC),I=1,LMTINC)
READ(IDISK,8)(LTRDPT(I,NOWINC),I=1,LMTDPT)
READ(IDISK,9)(LTRADR(I,NOWINC),I=1,LMTADR)
READ(IDISK,10)KDUMMY
7 FORMAT(40A1)
8 FORMAT(30A1)
9 FORMAT(30A1)
10 FORMAT(7I)
NUMBER(NOWINC)=KDUMMY(1)
KNTOPN(NOWINC)=KDUMMY(3)
LIMIT=KDUMMY(4)
IF(LIMIT.LE.0)GO TO 13
DO 12 I=1,LIMIT
READ(IDISK,11)LDUMMY
11 FORMAT(3I)
12 CONTINUE
13 GO TO 6
14 CALL LCLCLS( 5,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
IF(KNTINC.EQ.0)GO TO 101
C
C ***********************************
C * *
C * READ THE STUDENT REQUEST FILE *
C * *
C ***********************************
C
CALL LCLOPN( 8,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C READ THE STUDENTS DECISION FILE
KNTSTD=0
15 KNTSTD=KNTSTD+1
READ(IDISK,16,END=90)IAUTHR,ICLASS,IMOVE,IPASS,
1 IVERSN,NUMWHO,LTRPSW
READ(IDISK,17)ISUBMT,IUSED,KNTSIN,LOCKUP,MANNER,KNTALL,IGVBAK
16 FORMAT(6I,20A1)
17 FORMAT(7I)
READ(IDISK,18)LTRWHO
18 FORMAT(40A1)
READ(IDISK,19)LTRNAM
19 FORMAT(30A1)
IF(KNTSIN.LE.0)GO TO 23
IF(KNTSIN.GT.LMTSIN)GO TO 97
DO 22 KOMPNY=1,KNTSIN
READ(IDISK,20)IDUMMY
20 FORMAT(12I)
NUMVOT(KOMPNY)=IDUMMY(1)
KLOSED(KOMPNY)=IDUMMY(5)
JRANK(KOMPNY)=IDUMMY(7)
KLOCK(KOMPNY)=IDUMMY(8)
MTIME(KOMPNY)=IDUMMY(9)
MDATE(KOMPNY)=IDUMMY(10)
MRECRT(KOMPNY)=IDUMMY(11)
LIMIT=IDUMMY(3)
IF(LIMIT.GT.0)READ(IDISK,21)(JDUMMY(I),I=1,LIMIT)
21 FORMAT(13I)
22 CONTINUE
23 READ(IDISK,24)LTREND
24 FORMAT(1A1)
IF(LTREND.NE.LTRMIN)GO TO 95
IF(IMOVE.NE.JMOVE)GO TO 15
IF(ISUBMT.EQ.4)GO TO 15
C
C ***********************************
C * *
C * DESCRIBE SCHEDULED INTERVIEWS *
C * *
C ***********************************
C
C SEARCH FOR NEXT LOWEST ITEM IN SCHEDULE
KNTLIN=0
KNTPAG=0
IFANY=0
KFANY=0
IF(KNTSIN.EQ.0)GO TO 54
IRETRN=1
IOUTER=1
25 IF(MRECRT(IOUTER).LE.0)GO TO 36
IF(KLOSED(IOUTER).NE.0)GO TO 36
JFANY=0
DO 28 INNER=1,KNTSIN
IF(MRECRT(INNER).LE.0)GO TO 28
IF(KLOSED(INNER).NE.0)GO TO 28
IF(IFANY.EQ.0)GO TO 26
IF(KLOWST.GT.MDATE(INNER))GO TO 28
IF(KLOWST.LT.MDATE(INNER))GO TO 26
IF(LLOWST.GT.MTIME(INNER))GO TO 28
IF(LLOWST.LT.MTIME(INNER))GO TO 26
GO TO 28
26 IF(JFANY.EQ.0)GO TO 27
IF(KMINMM.GT.MDATE(INNER))GO TO 27
IF(KMINMM.LT.MDATE(INNER))GO TO 28
IF(LMINMM.GT.MTIME(INNER))GO TO 27
IF(LMINMM.LT.MTIME(INNER))GO TO 28
GO TO 28
27 KMINMM=MDATE(INNER)
LMINMM=MTIME(INNER)
JFANY=1
LOCATN=INNER
28 CONTINUE
DO 29 I=1,KNTINC
IF(NUMBER(I).NE.NUMVOT(LOCATN))GO TO 29
IFIRM=I
GO TO 30
29 CONTINUE
GO TO 93
30 KLOWST=KMINMM
LLOWST=LMINMM
C
C CHECK IF NEED BOTTOM OF PREVIOUS PAGE OR TOP OF NEXT PAGE
GO TO 59
31 CONTINUE
C
C PRINT LINE CONTAINING NUMBER, NAME, DIVISION, ADDRESS
GO TO 78
32 CONTINUE
C
C REPRESENT THE DATE
LOWBFR=0
ISMITH=KLOWST
CALL DAWEEK(-1,ISMITH,JDAY,JMONTH,JYEAR,IWEEK)
JWEEK=3*IWEEK
IWEEK=JWEEK-2
DO 33 I=IWEEK,JWEEK
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRWEK(I)
33 CONTINUE
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRSPA
CALL DAWHEN(ISMITH,JDAY,JMONTH,JYEAR,LTRBFR,LOWBFR,LMTBFR)
C
C REPRESENT THE STARTING TIME
JTIME=LLOWST
JTIME=40*(JTIME/60) + JTIME
CALL DAHOUR(JTIME,1,0,1,LTRBFR,LMTBFR,LOWBFR,IERROR)
C
C REPRESENT THE ENDING TIME
JTIME=LLOWST+KLOCK(LOCATN)
JTIME=40*(JTIME/60) + JTIME
CALL DAHOUR(JTIME,1,0,1,LTRBFR,LMTBFR,LOWBFR,IERROR)
WRITE(JDISK,34)(LTRBFR(I),I=1,29),
1MRECRT(LOCATN)
34 FORMAT(1X,6X,4A1,9A1,2X,8A1,' to ',8A1,
12X,'Schedule:',1I3)
WRITE(JDISK,35)
35 FORMAT(1X)
C
C END OF THE SCHEDULED INTERVIEW LOOP
36 IOUTER=IOUTER+1
IF(IOUTER.LE.KNTSIN)GO TO 25
C
C **********************************************
C * *
C * DESCRIBE INTERVIEWS WHICH CANNOT BE HELD *
C * *
C **********************************************
C
C CHECK FOR ANY INTERVIEWS FOR WHICH THERE WERE CONFLICTS
IRETRN=2
LOCATN=1
37 IF(KLOCK(LOCATN).EQ.0)GO TO 45
IF(MRECRT(LOCATN).GT.0)GO TO 45
IF(KLOSED(LOCATN).NE.0)GO TO 45
DO 38 I=1,KNTINC
IF(NUMBER(I).NE.NUMVOT(LOCATN))GO TO 38
IFIRM=I
GO TO 39
38 CONTINUE
GO TO 93
39 CONTINUE
C
C CHECK IF NEED BOTTOM OF PREVIOUS PAGE OR TOP OF NEXT PAGE
GO TO 59
40 CONTINUE
C
C PRINT LINE CONTAINING NUMBER, NAME, DIVISION, ADDRESS
GO TO 78
41 CONTINUE
C
C DESCRIBE WHY INTERVIEW CANNOT BE SCHEDULED
IF(MRECRT(LOCATN).EQ.0)WRITE(JDISK,42)
IF(MRECRT(LOCATN).LT.0)WRITE(JDISK,43)
42 FORMAT(1X,6X,'Contact placement office to resolve tim',
1'e conflict')
43 FORMAT(1X,6X,'Interview previously scheduled has been',
1' cancelled')
C
C BLANK LINE BEFORE NEXT ITEM
WRITE(JDISK,44)
44 FORMAT(1X)
45 LOCATN=LOCATN+1
IF(LOCATN.LE.KNTSIN)GO TO 37
C
C ************************************
C * *
C * LIST POSITIONS ON WAITING LIST *
C * *
C ************************************
C
C CHECK FOR ANY INTERVIEWS FOR WHICH THERE WERE CONFLICTS
IRETRN=3
LOCATN=1
46 IF(KLOCK(LOCATN).NE.0)GO TO 53
IF(KLOSED(LOCATN).NE.0)GO TO 53
DO 47 I=1,KNTINC
IF(NUMBER(I).NE.NUMVOT(LOCATN))GO TO 47
IFIRM=I
GO TO 48
47 CONTINUE
GO TO 93
48 CONTINUE
C
C CHECK IF NEED BOTTOM OF PREVIOUS PAGE OR TOP OF NEXT PAGE
GO TO 59
49 CONTINUE
C
C PRINT LINE CONTAINING NUMBER, NAME, DIVISION, ADDRESS
GO TO 78
50 CONTINUE
C
C DESCRIBE WHY INTERVIEW CANNOT BE SCHEDULED
IPOSTN=JRANK(LOCATN)-KNTOPN(IFIRM)
WRITE(JDISK,51)IPOSTN
51 FORMAT(1X,6X,'Position',1I5,
1' on waiting list')
C
C BLANK LINE BEFORE NEXT ITEM
WRITE(JDISK,52)
52 FORMAT(1X)
53 LOCATN=LOCATN+1
IF(LOCATN.LE.KNTSIN)GO TO 46
C
C **************************
C * *
C * BOTTOM OF FINAL PAGE *
C * *
C **************************
C
IF(IFANY.NE.0)GO TO 56
54 KNTPAG=KNTPAG+1
WRITE(JDISK,72)LTRNAM,KNTPAG
WRITE(JDISK,55)
55 FORMAT(1X/' No interviews were requested by this student')
KNTLIN=62
C REDUCE FOR TOP OF PAGE
KNTLIN=KNTLIN-1
C REDUCE FOR BOTTOM OF PAGE
KNTLIN=KNTLIN-2
C REDUCE FOR "NO INTERVIEWS" MESSAGE
KNTLIN=KNTLIN-2
C
C SPACE DOWN TO BOTTOM OF PAGE
56 IF(KNTLIN.LE.0)GO TO 58
KNTLIN=KNTLIN-1
WRITE(JDISK,57)
57 FORMAT(1X)
GO TO 56
58 WRITE(JDISK,70)ICLASS,JMOVE,JPASS,LTRTIM
GO TO 15
C
C *************************************************
C * *
C * INTERNAL ROUTINE FOR HEADER AND TITLE LINES *
C * *
C *************************************************
C
C FIND LENGTH OF FIRM NAME, DIVISION, ADDRESS
59 MAXINC=LMTINC
60 IF(LTRINC(MAXINC,IFIRM).NE.1H )GO TO 61
MAXINC=MAXINC-1
IF(MAXINC.GT.1)GO TO 60
61 MAXDPT=LMTDPT
62 IF(LTRDPT(MAXDPT,IFIRM).NE.1H )GO TO 63
MAXDPT=MAXDPT-1
IF(MAXDPT.GT.0)GO TO 62
63 MAXADR=LMTADR
64 IF(LTRADR(MAXADR,IFIRM).NE.1H )GO TO 65
MAXADR=MAXADR-1
IF(MAXADR.GT.0)GO TO 64
65 CONTINUE
LNGLIN=MAXINC
IF(MAXDPT.GT.0)LNGLIN=LNGLIN+MAXDPT+2
IF(MAXADR.GT.0)LNGLIN=LNGLIN+MAXADR+2
NEWLIN=1
IF(LNGLIN.GT.73)NEWLIN=2
C
C CHECK IF NEED BOTTOM OF PREVIOUS PAGE OR TOP OF NEXT PAGE
INIKNT=KNTLIN
KNTLIN=KNTLIN-2-NEWLIN
IF(KNTLIN.LT.0)GO TO 66
IF(IFANY.EQ.IRETRN)GO TO 77
C REDUCE FOR NEW TITLE LINE
KNTLIN=KNTLIN-3
IF(KNTLIN.LT.0)GO TO 66
GO TO 73
C
C PRODUCE BOTTOM OF PREVIOUS PAGE
66 IF(KFANY.EQ.0)GO TO 71
67 IF(INIKNT.LE.0)GO TO 69
INIKNT=INIKNT-1
WRITE(JDISK,68)
68 FORMAT(1X)
GO TO 67
C
C PRODUCE NEW TOP OF PAGE
69 WRITE(JDISK,70)ICLASS,JMOVE,JPASS,LTRTIM
70 FORMAT(1X/' Class',1I5,
1', Round',1I3,', Stage',1I3,' (printed ',15A1,')')
71 KFANY=1
KNTPAG=KNTPAG+1
WRITE(JDISK,72)LTRNAM,KNTPAG
72 FORMAT('1',30A1,33X,'Page',1I3)
C FULL NUMBER OF LINES ON PAGE
KNTLIN=62
C REDUCE FOR TOP OF PAGE
KNTLIN=KNTLIN-1
C REDUCE FOR NEW TITLE LINE
C (SUCH AS OPEN SCHED, COULD NOT SCHED, WAITING LIST, ETC)
KNTLIN=KNTLIN-3
C REDUCE FOR TRAILER
KNTLIN=KNTLIN-2
C REDUCE FOR THE NEW FIRM
KNTLIN=KNTLIN-2-NEWLIN
C
C NEW TITLE LINE
73 IF(IRETRN.EQ.1)WRITE(JDISK,74)
74 FORMAT(1X/
1' The following open interviews have been scheduled'/
21X)
IF(IRETRN.EQ.2)WRITE(JDISK,75)
75 FORMAT(1X/
1' The following interviews could not be scheduled'/
21X)
IF(IRETRN.EQ.3)WRITE(JDISK,76)
76 FORMAT(1X/
1' The following requests are on the waiting lists'/
21X)
IFANY=IRETRN
77 CONTINUE
GO TO(31,40,49),IRETRN
C
C ******************************************************
C * *
C * INTERNAL ROUTINE TO LIST FIRM, DIVISION, ADDRESS *
C * *
C ******************************************************
C
C DETERMINE THE COMBINATION OF NAME, DEPARTMENT, ADDRESS
78 LOWBFR=0
KONTNU=0
DO 79 I=1,MAXINC
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRINC(I,IFIRM)
79 CONTINUE
IF(MAXDPT.EQ.0)GO TO 83
IF((LOWBFR+MAXDPT+2).LE.73)GO TO 80
WRITE(JDISK,84)NUMBER(IFIRM),(LTRBFR(I),I=1,LOWBFR)
KONTNU=1
LOWBFR=0
GO TO 81
80 LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRCOM
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRSPA
81 DO 82 I=1,MAXDPT
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRDPT(I,IFIRM)
82 CONTINUE
83 IF(MAXADR.EQ.0)GO TO 89
IF((LOWBFR+MAXADR+2).LE.73)GO TO 86
IF(KONTNU.EQ.0)WRITE(JDISK,84)NUMBER(IFIRM),
1(LTRBFR(I),I=1,LOWBFR)
IF(KONTNU.NE.0)WRITE(JDISK,85)(LTRBFR(I),I=1,LOWBFR)
84 FORMAT(1X,1I4,2X,100A1)
85 FORMAT(1X,6X,100A1)
KONTNU=1
LOWBFR=0
GO TO 87
86 LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRCOM
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRSPA
87 DO 88 I=1,MAXADR
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRADR(I,IFIRM)
88 CONTINUE
89 IF(KONTNU.EQ.0)WRITE(JDISK,84)NUMBER(IFIRM),
1(LTRBFR(I),I=1,LOWBFR)
IF(KONTNU.NE.0)WRITE(JDISK,85)(LTRBFR(I),I=1,LOWBFR)
GO TO(32,41,50)IRETRN
C
C ***********************
C * *
C * LISTING COMPLETED *
C * *
C ***********************
C
90 WRITE(JDISK,91)
91 FORMAT(1H1,'End')
CALL LCLCLS( 8,0,1,ITTY,IDISK,JDISK,KDISK,LDISK)
CALL LCLCLS(10,1,2,ITTY,IDISK,JDISK,KDISK,LDISK)
KNTSTD=KNTSTD-1
WRITE(ITTY,92)KNTSTD
92 FORMAT(' Schedules produced for',1I5,' students')
GO TO 103
C
C VARIOUS ERROR MESSAGES
93 WRITE(ITTY,94)NUMVOT(LOCATN)
94 FORMAT(' Student file refers to unknown firm',1I5)
GO TO 103
95 WRITE(ITTY,96)
96 FORMAT(' Student information does not end in -')
GO TO 103
97 WRITE(ITTY,98)LMTSIN
98 FORMAT(' More than',1I5,' requests by one student')
GO TO 103
99 WRITE(ITTY,100)LMTFRM
100 FORMAT(' More than',1I5,' firms in schedule file')
GO TO 103
101 WRITE(ITTY,102)
102 FORMAT(' No firms are recruiting')
103 STOP
END