Trailing-Edge
-
PDP-10 Archives
-
decuslib20-08
-
decus/20-0175/jobmod.for
There is 1 other file named jobmod.for in the archive. Click here to see a list.
C RENBR(JOBMOD/JOBS - STUDENT REQUEST MODIFICATION PROGRAM)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS PROGRAM IS PART OF THE JOB INTERVIEW REQUEST SYSTEM
C
COMMON/JOBONE/LOADED
C
C ARRAYS WHICH STORE THE CURRENTLY REQUESTED FIRMS
DIMENSION NUMVOT(100),KNDVOT(100),IRANK(100),IPREFR(13,100),
1KNTPRF(100),KLOCK(100),KLOSED(100),JRANK(100),IDATE(100),
2MTIME(100),MDATE(100),MRECRT(100),ISOURC(100)
C
C IDENTIFICATION OF THIS USER
DIMENSION LTRWHO(40),LTRNAM(30),LTRPSW(20)
C
C IALIAS = NUMBER USED INTERNALLY INSTEAD OF NUMBER TYPED BY USER
C KNDARG = NUMBER OF ARGUMENTS TAKEN BY COMMAND TYPED BY USER
C
DIMENSION KNDARG(11),IALIAS(11)
C
C IF USER TYPES 7 AS A COMMAND, IT IS CONVERTED TO
C IALIAS(7) AND TAKES ARGUMENTS SPECIFIED BY KNDARG(7)
C
C 1 2 3 4 5 6 7 8 9 10 11
DATA KNDARG/ 1, 1, 1, 1, 1, 2, 0, 0, 0, 0, 0/
DATA IALIAS/ 1, 2, 3, 4, 5, 6, 8, 9, 7,10,11/
C
C UNIT NUMBERS FOR TERMINAL AND FILES
DATA ITTY,IDISK,JDISK,KDISK/5,1,20,21/
C
C TELL USER WHAT PROGRAM THIS IS
WRITE(ITTY,1)
1 FORMAT(' JOBMOD'/' Change interview requests'/1X)
C
C TEST IF COMMON BLOCK IS LOADED
IF(LOADED.NE.1234)GO TO 119
C
C ****************************
C * *
C * ASK WHAT IS TO BE DONE *
C * *
C ****************************
C
WRITE(ITTY,2)
2 FORMAT(' You can type -1 as an answer ',
1'to return to the next higher question'/
2' Do not type ? in response to questions'/1X)
C
C ASK FOR CLASS NUMBER
3 WRITE(ITTY,4)
4 FORMAT(' Class (-1=exit)? ',$)
READ(ITTY,5)JCLASS
5 FORMAT(I)
IF(JCLASS.LT.0)GO TO 125
C
C ASK USER WHAT IS TO BE DONE
6 WRITE(ITTY,7)
7 FORMAT(
1' 1=Place request for firm on closed schedule'/
2' 2=Place on open schedule, not requested by firm'/
3' 3=Place on open schedule, requested by firm'/
4' 4=Reject request, firm does not want to talk to student'/
5' 5=Delete request from file'/
6' 6=Change firm number, put on open list of new firm'/
7' 7=Restore high priority vote or bid immediately'/
8' 8=Restore high priority vote or bid next round'/
9' 9=Unsubmit'/
1' 10=Block further requests but process current'/
2' 11=Block further requests and ignore current')
8 WRITE(ITTY,9)
9 FORMAT(' Do which? ',$)
READ(ITTY,10)JALIAS
10 FORMAT(I)
IF(JALIAS.LT.0)GO TO 3
IF(JALIAS.EQ.0)GO TO 8
IF(JALIAS.GT.11)GO TO 8
MASTER=IALIAS(JALIAS)
NOWARG=KNDARG(JALIAS)
C
C CONFIRM OPTION
IF(MASTER.EQ.1)WRITE(ITTY,11)
IF(MASTER.EQ.2)WRITE(ITTY,12)
IF(MASTER.EQ.3)WRITE(ITTY,13)
IF(MASTER.EQ.4)WRITE(ITTY,14)
IF(MASTER.EQ.5)WRITE(ITTY,15)
IF(MASTER.EQ.6)WRITE(ITTY,16)
IF(MASTER.EQ.7)WRITE(ITTY,17)
IF(MASTER.EQ.8)WRITE(ITTY,18)
IF(MASTER.EQ.9)WRITE(ITTY,19)
IF(MASTER.EQ.10)WRITE(ITTY,20)
IF(MASTER.EQ.11)WRITE(ITTY,21)
11 FORMAT(' Move to closed schedule')
12 FORMAT(' Move to open schedule')
13 FORMAT(' Keep invited student on open schedule')
14 FORMAT(' Reject request but leave in file')
15 FORMAT(' Delete request from file')
16 FORMAT(' Change firm number')
17 FORMAT(' Unsubmit')
18 FORMAT(' Restore high priority vote or bid immediately')
19 FORMAT(' Restore high priority vote or bid next round')
20 FORMAT(' Block further requests but process current')
21 FORMAT(' Block further requests and ignore current requests')
C
C TRANSFER FORWARD FROM HIGHER QUESTION
IF(NOWARG.EQ.0)GO TO 33
GO TO 23
C
C TRANSFER BACK FROM LOWER QUESTION
22 IF(NOWARG.EQ.0)GO TO 6
GO TO 23
C
C OPTION 6 REQURES 2 FIRM NUMBERS
C
C GET SINGLE FIRM NUMBER
23 IF(NOWARG.EQ.2)GO TO 27
24 WRITE(ITTY,25)
25 FORMAT(' Firm number? ',$)
READ(ITTY,26)IFIRM
26 FORMAT(I)
IF(IFIRM.EQ.0)GO TO 24
IF(IFIRM.LT.0)GO TO 6
GO TO 33
C
C GET 2 FIRM NUMBERS
27 WRITE(ITTY,28)
28 FORMAT(' Original firm number? ',$)
READ(ITTY,29)IFIRM
29 FORMAT(I)
IF(IFIRM.LT.0)GO TO 6
IF(IFIRM.EQ.0)GO TO 27
30 WRITE(ITTY,31)
31 FORMAT(' New firm number after change? ',$)
READ(ITTY,32)JFIRM
32 FORMAT(I)
IF(JFIRM.LT.0)GO TO 27
IF(JFIRM.EQ.0)GO TO 30
33 CONTINUE
C
C GET STUDENT NUMBER
34 WRITE(ITTY,35)
35 FORMAT(' Student number? ',$)
READ(ITTY,36)IDNUMB
36 FORMAT(I)
IF(IDNUMB.LT.0)GO TO 22
C
C ****************************************
C * *
C * READ ORIGINAL STUDENT REQUEST FILE *
C * *
C ****************************************
C
C OPEN THE STUDENTS DECISION FILE
CALL RSMOPN(3,IDNUMB,JCLASS,ITTY,IDISK,IFOPEN)
IF(IFOPEN.NE.0)GO TO 38
WRITE(ITTY,37)
37 FORMAT(' Cannot open request file')
GO TO 34
C
C READ THE HEADER INFORMATION
38 READ(IDISK,39)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN,NUMWHO,LTRPSW
39 FORMAT(6I,20A1)
IF(IAUTHR.LT.11)GO TO 121
IF(IAUTHR.GT.15)GO TO 121
IF(IAUTHR.EQ.12)GO TO 123
IF(IAUTHR.EQ.13)GO TO 123
READ(IDISK,40)ISUBMT,IUSED,KNTSIN,LOCKUP,MANNER,
1 KNTALL,IGVBAK
40 FORMAT(7I)
READ(IDISK,41)LTRWHO
41 FORMAT(40A1)
READ(IDISK,42)LTRNAM
42 FORMAT(30A1)
C
C READ THE INTERVIEW REQUESTS
IF(KNTSIN.LE.0)GO TO 46
DO 45 KOMPNY=1,KNTSIN
READ(IDISK,43)NUMVOT(KOMPNY),KNDVOT(KOMPNY),KNTPRF(KOMPNY),
1IDATE(KOMPNY),KLOSED(KOMPNY),IRANK(KOMPNY),JRANK(KOMPNY),
2KLOCK(KOMPNY),MTIME(KOMPNY),MDATE(KOMPNY),MRECRT(KOMPNY),
3ISOURC(KOMPNY)
43 FORMAT(12I)
LIMIT=KNTPRF(KOMPNY)
IF(LIMIT.LE.0)GO TO 45
READ(IDISK,44)(IPREFR(I,KOMPNY),I=1,LIMIT)
44 FORMAT(13I)
45 CONTINUE
46 CONTINUE
CALL RSMCLS(3,IDNUMB,JCLASS,ITTY,IDISK,IFOPEN)
C
C ASK IF THIS IS CORRECT PERSON
WRITE(ITTY,47)LTRNAM
47 FORMAT(1X,30A1)
WRITE(ITTY,48)IMOVE,IPASS
48 FORMAT(' Round',1I4,', Stage',1I4)
IF(ISUBMT.EQ.0)WRITE(ITTY,49)
IF(ISUBMT.EQ.1)WRITE(ITTY,50)
IF(ISUBMT.EQ.2)WRITE(ITTY,51)
IF(ISUBMT.EQ.3)WRITE(ITTY,52)
IF(ISUBMT.EQ.4)WRITE(ITTY,53)
49 FORMAT(' Requests have not been submitted')
50 FORMAT(' Requests have been submitted')
51 FORMAT(' Requests have not been made since processing')
52 FORMAT(' Requests have been blocked but current will be used')
53 FORMAT(' Requests have been blocked and current are ignored')
C
C SEARCH FOR COMPANY TO MODIFY INFORMATION ONLY ABOUT IT
C SEARCH FROM TOP SINCE CANCELLED ENTRIES COULD BE AT BOTTOM
IF(NOWARG.EQ.0)GO TO 64
KOMPNY=KNTSIN
54 IF(KOMPNY.LE.0)GO TO 55
IF(NUMVOT(KOMPNY).EQ.IFIRM)GO TO 57
KOMPNY=KOMPNY-1
GO TO 54
55 WRITE(ITTY,56)
56 FORMAT(' Student has not requested this firm')
GO TO 34
C
C TYPE DESCRIPTION OF THIS REQUEST
57 WRITE(ITTY,58)
58 FORMAT(' Current information for firm')
WRITE(ITTY,59)
59 FORMAT(' NUMVOT KNDVOT KNTPRF IDATE KLOSED IRAN',
1'K JRANK KLOCK MTIME MDATE MRECRT ISOURC')
WRITE(ITTY,60)NUMVOT(KOMPNY),KNDVOT(KOMPNY),KNTPRF(KOMPNY),
1IDATE(KOMPNY),KLOSED(KOMPNY),IRANK(KOMPNY),JRANK(KOMPNY),
2KLOCK(KOMPNY),MTIME(KOMPNY),MDATE(KOMPNY),MRECRT(KOMPNY),
3ISOURC(KOMPNY)
60 FORMAT(1X,1I6,1I10,1I7,1I6,1I7,5I6,2I7)
LIMIT=KNTPRF(KOMPNY)
IF(LIMIT.LE.0)GO TO 63
WRITE(ITTY,61)
61 FORMAT(' TIMES')
WRITE(ITTY,62)(IPREFR(I,KOMPNY),I=1,LIMIT)
62 FORMAT(1X,16I5)
63 CONTINUE
C
C ASK IF THIS IS CORRECT STUDENT
64 WRITE(ITTY,65)
65 FORMAT(' Is this the correct student? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(64,64,66,34,64),KNDYES
C
C *************************************************
C * *
C * CHANGE THE CONTENTS OF STUDENT REQUEST FILE *
C * *
C *************************************************
C
C HANDLE OPTIONS WHICH CHANGE MORE THAN SCHEDULE OR SOURCE
66 GO TO(67,68,69,71,72,76,83,84,84,94,95),MASTER
C
C MASTER = 1, MOVE TO CLOSED SCHEDULE
67 KLOSED(KOMPNY)=1
ISOURC(KOMPNY)=1
GO TO 96
C
C MASTER = 2, MOVE TO OPEN SCHEDULE
68 ISAVE=KLOSED(KOMPNY)
KLOSED(KOMPNY)=0
ISOURC(KOMPNY)=0
GO TO 70
C
C MASTER = 3, KEEP INVITED ON OPEN SCHEDULE
69 ISAVE=KLOSED(KOMPNY)
KLOSED(KOMPNY)=0
ISOURC(KOMPNY)=1
GO TO 70
C
C IF MOVING FROM CLOSED TO OPEN, CANCEL OLD TIME ALLOCATION
70 IF(ISAVE.EQ.0)GO TO 96
IRANK(KOMPNY)=0
JRANK(KOMPNY)=0
KLOCK(KOMPNY)=0
MTIME(KOMPNY)=0
MDATE(KOMPNY)=0
MRECRT(KOMPNY)=0
GO TO 79
C
C MASTER = 4, REJECT REQUEST BUT LEAVE IN FILE
71 KLOSED(KOMPNY)=2
GO TO 96
C
C MASTER = 5, REMOVE REQUEST ENTIRELY FROM FILE
72 KNTSIN=KNTSIN-1
IF(LOCKUP.GE.KOMPNY)LOCKUP=LOCKUP-1
73 IF(KOMPNY.GT.KNTSIN)GO TO 96
NUMVOT(KOMPNY)=NUMVOT(KOMPNY+1)
KNDVOT(KOMPNY)=KNDVOT(KOMPNY+1)
KNTPRF(KOMPNY)=KNTPRF(KOMPNY+1)
IDATE(KOMPNY) =IDATE(KOMPNY+1)
KLOSED(KOMPNY)=KLOSED(KOMPNY+1)
IRANK(KOMPNY) =IRANK(KOMPNY+1)
JRANK(KOMPNY) =JRANK(KOMPNY+1)
KLOCK(KOMPNY) =KLOCK(KOMPNY+1)
MTIME(KOMPNY) =MTIME(KOMPNY+1)
MDATE(KOMPNY) =MDATE(KOMPNY+1)
MRECRT(KOMPNY)=MRECRT(KOMPNY+1)
ISOURC(KOMPNY)=ISOURC(KOMPNY+1)
LIMIT=KNTPRF(KOMPNY)
IF(LIMIT.LE.0)GO TO 75
DO 74 I=1,LIMIT
IPREFR(I,KOMPNY)=IPREFR(I,KOMPNY+1)
74 CONTINUE
75 KOMPNY=KOMPNY+1
GO TO 73
C
C MASTER = 6, CHANGE FIRM NUMBER
76 DO 78 INNER=1,KNTSIN
IF(NUMVOT(INNER).NE.JFIRM)GO TO 78
IF(KLOSED(INNER).NE.0)GO TO 78
WRITE(ITTY,77)
77 FORMAT(
1' Change cannot be performed'/
2' Student has already requested interview with new firm')
GO TO 34
78 CONTINUE
C INITIALIZE MOST OF ITEMS STORED FOR THIS COMPANY
C ITEMS LEFT UNCHANGED ARE KNDVOT, IDATE, KNTPRF
IRANK(KOMPNY)=0
JRANK(KOMPNY)=0
NUMVOT(KOMPNY)=JFIRM
KLOSED(KOMPNY)=0
KLOCK(KOMPNY)=0
MTIME(KOMPNY)=0
MDATE(KOMPNY)=0
MRECRT(KOMPNY)=0
ISOURC(KOMPNY)=0
GO TO 79
C
C ESTABLISH NEW LOCATION ON RANKED LIST
79 WRITE(ITTY,80)
80 FORMAT(
1' Rank you specify here is effective with next processing'/
2' Do not duplicate existing rank or current ranks will changed'/
3' Value of 0 gives random position next processing'/
4' Value above number of ranked students puts at end of list')
WRITE(ITTY,81)
81 FORMAT(' Rank in list? ',$)
READ(ITTY,82)IRANK(KOMPNY)
82 FORMAT(I)
IF(IRANK(KOMPNY).LT.0)IRANK(KOMPNY)=0
JRANK(KOMPNY)=0
GO TO 96
C
C MASTER = 7, UNSUBMIT THE DECISIONS
83 ISUBMT=0
GO TO 96
C
C MASTER = 8 OR 9, RESTORE HIGH PRIORITY A VOTE OR BID
84 IF(MANNER.GT.20)GO TO 88
IF(MANNER.GT.10)GO TO 86
WRITE(ITTY,85)
85 FORMAT(' Cannot restore since requests are being ranked')
GO TO 96
86 WRITE(ITTY,87)
87 FORMAT(' Restore how many high priority votes? ',$)
GO TO 90
88 WRITE(ITTY,89)
89 FORMAT(' Restore how many bid units? ',$)
90 READ(ITTY,91)IVALUE
91 FORMAT(I)
I=IUSED
J=IGVBAK
IF(MASTER.EQ.8)IUSED=IUSED-IVALUE
IF(MASTER.EQ.9)IGVBAK=IGVBAK+IVALUE
IF(MASTER.EQ.8)WRITE(ITTY,92)I,IUSED
IF(MASTER.EQ.9)WRITE(ITTY,93)J,IGVBAK
92 FORMAT(' Current amount used changed from',1I10,' to',1I10)
93 FORMAT(' Amount restored next round changed from',1I10,' to',1I10)
GO TO 96
C
C MASTER = 10, BLOCK FURTHER USE BUT PROCESS CURRENT REQUESTS
94 ISUBMT=3
GO TO 96
C
C MASTER = 7, BLOCK FURTHER USE AND IGNORE CURRENT REQUESTS
95 ISUBMT=4
GO TO 96
C
C ***********************************************
C * *
C * WRITE NEW VERSION OF STUDENT REQUEST FILE *
C * *
C ***********************************************
C
C OPEN THE STUDENTS DECISION FILE
96 CALL RSMOPN(6,IDNUMB,JCLASS,ITTY,KDISK,IFOPEN)
IF(IFOPEN.NE.0)GO TO 98
WRITE(ITTY,97)
97 FORMAT(' Cannot write request file')
GO TO 34
C
C WRITE HEADER INFORMATION
98 IAUTHR=15
WRITE(KDISK,99)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN,NUMWHO,LTRPSW
WRITE(KDISK,100)ISUBMT,IUSED,KNTSIN,LOCKUP,MANNER,
1 KNTALL,IGVBAK
99 FORMAT(5I6,1I7,1X,20A1)
100 FORMAT(1I6,1I10,4I6,1I10)
WRITE(KDISK,101)LTRWHO
101 FORMAT(40A1)
WRITE(KDISK,102)LTRNAM
102 FORMAT(30A1)
C
C WRITE INTERVIEW REQUESTS
IF(KNTSIN.LE.0)GO TO 106
DO 105 KOMPNY=1,KNTSIN
C
C WRITE THE NEW LINE FOR THIS COMPANY
WRITE(KDISK,103)NUMVOT(KOMPNY),KNDVOT(KOMPNY),KNTPRF(KOMPNY),
1IDATE(KOMPNY),KLOSED(KOMPNY),IRANK(KOMPNY),JRANK(KOMPNY),
2KLOCK(KOMPNY),MTIME(KOMPNY),MDATE(KOMPNY),MRECRT(KOMPNY),
3ISOURC(KOMPNY)
103 FORMAT(1I6,1I10,10I6)
LIMIT=KNTPRF(KOMPNY)
IF(LIMIT.LE.0)GO TO 105
WRITE(KDISK,104)(IPREFR(I,KOMPNY),I=1,LIMIT)
104 FORMAT(13I6)
105 CONTINUE
C
C COPY THE - AT END OF STUDENT ENTRY
106 WRITE(KDISK,107)
107 FORMAT('-')
CALL RSMCLS(6,IDNUMB,JCLASS,ITTY,KDISK,IFOPEN)
IF(MASTER.EQ.1)WRITE(ITTY,108)
IF(MASTER.EQ.2)WRITE(ITTY,109)
IF(MASTER.EQ.3)WRITE(ITTY,110)
IF(MASTER.EQ.4)WRITE(ITTY,111)
IF(MASTER.EQ.5)WRITE(ITTY,112)
IF(MASTER.EQ.6)WRITE(ITTY,113)
IF(MASTER.EQ.7)WRITE(ITTY,114)
IF(MASTER.EQ.8)WRITE(ITTY,115)
IF(MASTER.EQ.9)WRITE(ITTY,116)
IF(MASTER.EQ.10)WRITE(ITTY,117)
IF(MASTER.EQ.11)WRITE(ITTY,118)
108 FORMAT(' Student has been moved to closed schedule')
109 FORMAT(' Student has been moved to open schedule')
110 FORMAT(' Student has been moved to open schedule,'/
1' but marked as being invited by firm')
111 FORMAT(' Request marked as rejected by firm')
112 FORMAT(' Request removed entirely from file')
113 FORMAT(' Student has been moved to open schedule for new firm')
114 FORMAT(' Request file has been unsubmitted')
115 FORMAT(' High priority vote or bid has been restored')
116 FORMAT(' High priority vote or bid will be restored')
117 FORMAT(' Future requests are blocked but current will be used')
118 FORMAT(' Future requests are blocked and current ignored')
GO TO 34
C
C COMMON BLOCK NOT LOADED
119 WRITE(ITTY,120)
120 FORMAT(' BLOCK DATA routine not loaded')
GO TO 125
C
C WRONG INPUT FILE
121 WRITE(ITTY,122)
122 FORMAT(' Input file is not an interview request file')
GO TO 125
C
C WRONG TYPE OF DECISION FILE
123 WRITE(ITTY,124)
124 FORMAT(
1' Input file is a request file, but written by wrong program')
GO TO 125
125 STOP
END