Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-08 - decus/20-0175/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