Trailing-Edge
-
PDP-10 Archives
-
decuslib20-08
-
decus/20-0175/jobput.for
There is 1 other file named jobput.for in the archive. Click here to see a list.
C RENBR(JOBPUT/JOBS - COMPOSITE FILE UNMERGE 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
DIMENSION IDUMMY(12),JDUMMY(13)
DIMENSION LTRWHO(40),LTRNAM(30),LTRPSW(20)
C
C UNIT NUMBERS FOR TERMINAL AND FILES
DATA ITTY,IDISK,JDISK,KDISK,LDISK/5,1,20,21,22/
DATA LTRSPA,LTRMIN/1H ,1H-/
DATA LMTNAM,LMTPRF/30,13/
C
C TELL USER WHAT PROGRAM THIS IS
WRITE(ITTY,1)
1 FORMAT(' JOBPUT'/
1' Splits a composite student interview request file',
2' into individual student files'/
3' ')
C
C TEST IF COMMON BLOCK IS LOADED
IF(LOADED.NE.1234)GO TO 32
C
C **************************************************
C * *
C * ASK FOR USER TO IDENTIFY THE FILE TO BE READ *
C * *
C **************************************************
C
CALL LCLOPN(8,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
C
C ***********************************
C * *
C * COPY THE STUDENT REQUEST FILE *
C * *
C ***********************************
C
KNTOUT=0
C
C READ HEADER INFORMATION
2 READ(IDISK,3,END=23)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN,
1 NUMWHO,LTRPSW
3 FORMAT(6I,20A1)
IF(IAUTHR.LT.11)GO TO 34
IF(IAUTHR.GT.15)GO TO 34
READ(IDISK,4)ISUBMT,IUSED,KNTSIN,LOCKUP,MANNER,KNTALL,IGVBAK
4 FORMAT(7I)
READ(IDISK,5)LTRWHO
5 FORMAT(40A1)
READ(IDISK,6)LTRNAM
6 FORMAT(30A1)
C
C OPEN THE INDIVIDUAL DECISION FILE
CALL RSMOPN(6,NUMWHO,ICLASS,ITTY,LDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 30
J=LMTNAM
7 IF(LTRNAM(J).NE.LTRSPA)GO TO 8
J=J-1
IF(J.GT.1)GO TO 7
8 WRITE(ITTY,9)NUMWHO,ICLASS,(LTRNAM(I),I=1,J)
9 FORMAT(1X,1I6,1I4,1X,30A1)
C
C WRITE HEADER INFORMATION
KNTOUT=KNTOUT+1
IAUTHR=14
WRITE(LDISK,10)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN,
1 NUMWHO,LTRPSW
WRITE(LDISK,11)ISUBMT,IUSED,KNTSIN,LOCKUP,MANNER,KNTALL,IGVBAK
10 FORMAT(5I6,1I7,1X,20A1)
11 FORMAT(1I6,1I10,4I6,1I10)
WRITE(LDISK,12)LTRWHO
12 FORMAT(40A1)
WRITE(LDISK,13)LTRNAM
13 FORMAT(30A1)
C
C COPY INTERVIEW REQUESTS
IF(KNTSIN.LE.0)GO TO 20
DO 19 KOMPNY=1,KNTSIN
READ(IDISK,14)IDUMMY
14 FORMAT(12I)
C
C WRITE THE INFORMATION BACK TO FILE
WRITE(LDISK,15)IDUMMY
15 FORMAT(1I6,1I10,10I6)
LIMIT=IDUMMY(3)
IF(LIMIT.EQ.0)GO TO 18
IF(LIMIT.GT.LMTPRF)GO TO 28
READ(IDISK,16)(JDUMMY(I),I=1,LIMIT)
16 FORMAT(13I)
WRITE(LDISK,17)(JDUMMY(I),I=1,LIMIT)
17 FORMAT(13I6)
18 CONTINUE
19 CONTINUE
20 READ(IDISK,21)LTREND
21 FORMAT(1A1)
IF(LTREND.NE.LTRMIN)GO TO 26
WRITE(LDISK,22)LTREND
22 FORMAT(1A1)
CLOSE(UNIT=LDISK)
GO TO 2
C
C ALL FILES WRITTEN
23 CALL LCLCLS(8,1,1,ITTY,IDISK,JDISK,KDISK,LDISK)
WRITE(ITTY,24)KNTOUT
24 FORMAT(' Number of output files written:',1I4)
WRITE(ITTY,25)
25 FORMAT(' You must also copy the final administrato',
1'r firm file (file 5)')
GO TO 36
C
C ********************
C * *
C * ERROR MESSAGES *
C * *
C ********************
C
26 WRITE(ITTY,27)
27 FORMAT(' Requests not properly terminated in composite file')
GO TO 36
28 WRITE(ITTY,29)
29 FORMAT(' Too many time preferences in composite file')
GO TO 36
30 WRITE(ITTY,31)NUMWHO,ICLASS
31 FORMAT(
1' Cannot open output file for student',1I6,' in class',1I6)
GO TO 36
32 WRITE(ITTY,33)
33 FORMAT(' BLOCK DATA routine not loaded')
GO TO 36
34 WRITE(ITTY,35)
35 FORMAT(' Input file is not a composite request file')
GO TO 36
36 STOP
END