Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50546/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