Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-08 - decus/20-0175/libd10.for
There are 3 other files named libd10.for in the archive. Click here to see a list.
      SUBROUTINE RSMOPN(KNDFIL,NUMWHO,IYEAR,ITTY,IDISK,IFOPEN)
C     RENBR(/OPEN FILES ON DEC10 OR DEC20)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THIS IS A MACHINE DEPENDENT ROUTINE
C
C     THIS VERSION IS FOR THE DECSYSTEM10 AND DECSYSTEM20
C
C     NOTE THAT IN THESE DESCRIPTIONS, XXXXXX INDICATES
C     THE VALUE OF NUMWHO REPRESENTED AS A 6 DIGIT DECIMAL
C     NUMBER AND YYY INDICATES THE VALUE OF IYEAR REPRESENTED
C     AS A 3 DIGIT DECIMAL NUMBER
C
C     THE FOLLOWING ARGUMENTS ARE RETURNED UNCHANGED
C
C     KNDFIL = 1, READ ACCOUNT VALIDATION FILE ACOUNT.JOB
C                 FROM CENTRAL STORAGE AREA
C            = 2, READ PASSWORD FILE NAMED PSWYYY.JOB FROM
C                 CENTRAL STORAGE AREA
C            = 3, READ INDIVIDUAL INTERVIEW REQUEST FILE
C                 NAMED XXXXXX.YYY FROM CENTRAL STORAGE AREA
C            = 4, READ FIRM SCHEDULE FILE NAMED FRMYYY.JOB
C                 FROM CENTRAL STORAGE AREA
C            = 5, READ MOVE FILE NAMED CURENT.JOB FROM
C                 CENTRAL STORAGE AREA.
C            = 6, WRITE INDIVIDUAL INTERVIEW REQUEST FILE
C                 NAMED XXXXXX.YYY INTO CENTRAL STORAGE AREA
C            = 7, WRITE FIRM SCHEDULE FILE NAMED FRMYYY.JOB
C                 INTO CENTRAL STORAGE AREA
C            = 8, WRITE FILE NAMED JOBADM.LST INTO LOCAL AREA.
C                 TELL USER WHAT NAME OF FILE IS.
C            = 9, READ LIST OF STARTING TIMES FROM FILE NAMED
C                 TIMES.JOB IN CENTRAL STORAGE AREA.
C            = 10, WRITE FILE NAMED XXXXXX.DOC INTO LOCAL AREA.
C                 TELL USER WHAT NAME OF FILE IS.
C            = 11, WRITE FILE NAMED JOBS.DOC INTO LOCAL AREA.
C                 TELL USER WHAT NAME OF FILE IS.
C
C     NUMWHO = NUMBER UNIQUELY IDENTIFYING THIS STUDENT IN CLASS
C     IYEAR  = THE CLASS NUMBER OF THIS STUDENT
C     ITTY   = UNIT NUMBER OF TERMINAL.  NOT USED IN THIS VERSION.
C     IDISK  = THE UNIT NUMBER ON WHICH TO OPEN FILE
C
C     THE FOLLOWING ARGUMENT IS RETURNED INDICATING IF SUCCESS
C
C     IFOPEN = 0, COULD NOT OPEN FILE
C            = 1, FILE WAS SUCCESSFULLY OPENED
C
      DIMENSION LTRFIL(10),LA5FIL(2)
      DOUBLE PRECISION FILNAM
C
C     DECSYSTEM10 ACCOUNT SPECIFICATIONS
C     NUMDIR = PROJECT AND PROGRAMMER NUMBER AND TERMINAL ZERO
C              OF THE ACCOUNT USED FOR STORING FILES
C
      COMMON/JOBTWO/NUMDIR(3)
C
C     ODD CHARACTERS
      DATA LTRSPA,LTRZER/1H ,1H0/
C
C     PREPARE TO CONSTRUCT THE FILE NAME
      GO TO(1,2,4,6,8,4,6,9,10,11,13),KNDFIL
C
C     LIST OF VALID ACCOUNTS IN FILE NAMED ACOUNT.JOB
    1 FILNAM='ACOUNT.JOB'
      GO TO 18
C
C     PASSWORD FILE NAMED PSWYYY.JOB
    2 ENCODE(10,3,LA5FIL)IYEAR
    3 FORMAT(3HPSW,1I3,4H.JOB)
      GO TO 14
C
C     INDIVIDUAL INTERVIEW REQUEST FILE NAMED XXXXXX.YYY
    4 ENCODE(10,5,LA5FIL)NUMWHO,IYEAR
    5 FORMAT(1I6,1H.,1I3)
      GO TO 14
C
C     FIRM SCHEDULE FILE NAMED FRMYYY.JOB
    6 ENCODE(10,7,LA5FIL)IYEAR
    7 FORMAT(3HFRM,1I3,4H.JOB)
      GO TO 14
C
C     FILE SPECIFYING CURRENT MOVE
    8 FILNAM='CURENT.JOB'
      GO TO 18
C
C     LIST OF FILES FOR ADMINISTRATOR
    9 FILNAM='JOBADM.LST'
      GO TO 18
C
C     LIST OF STARTING TIMES
   10 FILNAM='TIMES.JOB '
      GO TO 18
C
C     LIST OF REQUESTS IN FILE XXXXXX.DOC
   11 ENCODE(10,12,LA5FIL)NUMWHO
   12 FORMAT(1I6,4H.DOC)
      GO TO 14
C
C     LIST OF REQUESTS IN FILE JOBS.DOC
   13 FILNAM='JOBS.DOC  '
      GO TO 18
C
C     CONVERT SPACES IN FILE NAME TO ZEROES
   14 DECODE(10,15,LA5FIL)LTRFIL
   15 FORMAT(10A1)
      DO 16 I=1,10
      IF(LTRFIL(I).EQ.LTRSPA)LTRFIL(I)=LTRZER
   16 CONTINUE
      ENCODE(10,17,FILNAM)LTRFIL
   17 FORMAT(10A1)
      GO TO 18
C
C     DECIDE IF READ OR WRITE FILE
   18 GO TO(19,19,19,19,19,20,20,21,19,21,21),KNDFIL
C
C     READ FILE FROM CENTRAL STORAGE AREA
   19 OPEN(UNIT=IDISK,FILE=FILNAM,DIRECTORY=NUMDIR,
     1 ACCESS='SEQIN',ERR=24)
      GO TO 25
C
C     WRITE FILE INTO CENTRAL STORAGE AREA
   20 OPEN(UNIT=IDISK,FILE=FILNAM,DIRECTORY=NUMDIR,
     1 ACCESS='SEQOUT',PROTECTION="100,ERR=24)
      GO TO 25
C
C     WRITE FILE INTO LOCAL ACCOUNT
   21 OPEN(UNIT=IDISK,FILE=FILNAM,
     1 ACCESS='SEQOUT',ERR=24)
      IF(KNDFIL.EQ.8)WRITE(ITTY,22)FILNAM
   22 FORMAT(' List of firms will be in file ',1A10)
      IF(KNDFIL.EQ.10)WRITE(ITTY,23)FILNAM
      IF(KNDFIL.EQ.11)WRITE(ITTY,23)FILNAM
   23 FORMAT(' List of requests will be in file ',1A10)
      GO TO 25
C
C     RETURN TO CALLING PROGRAM
   24 IFOPEN=0
      GO TO 26
   25 IFOPEN=1
      GO TO 26
   26 RETURN
      END
      SUBROUTINE RSMCLS(KNDFIL,NUMWHO,IYEAR,ITTY,IDISK,IFCLOS)
C     RENBR(/CLOSE FILES ON DEC10 OR DEC20)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     DUMMY ROUTINE NEEDED FOR PASSWORD VERIFICATION
C
C     THIS IS A MACHINE DEPENDENT ROUTINE
C
C     THIS VERSION IS FOR THE DECSYSTEM10 AND DECSYSTEM20
C
C     MOST ARGUMENTS ARE SAME AS FOR THE RSMOPN ROUTINE
C
C     THE FOLLOWING ARGUMENT IS RETURNED INDICATING IF SUCCESS
C
C     IFCLOS = 0, COULD NOT CLOSE FILE
C            = 1, FILE WAS SUCCESSFULLY CLOSED
C
      CLOSE(UNIT=IDISK,ERR=1)
      IFCLOS=1
      GO TO 2
    1 IFCLOS=0
    2 RETURN
      END
      SUBROUTINE LCLOPN(KNDFIL,IFASK,KNDDSK,
     1 ITTY,IDISK,JDISK,KDISK,LDISK)
C     RENBR(/OPEN LOCAL FILES DURING PROCESSING)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THIS ROUTINE IS PART OF THE JOB INTERVIEW REQUEST SYSTEM
C
      COMMON/JOBFIL/FILSTR(10)
      DOUBLE PRECISION FILNAM,FILSTR
C
C     KNDFIL = 1, initial administrator file
C            = 2, initial composite student request file
C            = 3, profiles of starting times
C            = 4, listing of students ranked by position on list
C            = 5, final administrative file
C            = 6, intermediate student request file
C            = 7, student identification numbers
C            = 8, final student request file
C            = 9, listing of all recruiter schedules
C            = 10, listing of all student schedules
C            = 11, sorted student identification numbers
C     IFASK  = 0, use file name specified previously
C            = 1, ask for file name this time
C     KNDDSK = 1, read file from IDISK
C            = 2, write listing file to JDISK
C            = 3, write file to KDISK
C            = 4, write file to LDISK
C
C
C     DETERMINE IF ASK FOR NAME OF FILE
      IF(IFASK.EQ.0)GO TO 26
C
C     GET NAME OF FILE
C            1  2  3  4  5  6  7  8  9 10 11
    1 GO TO( 2, 4, 6, 8,10,12,14,16,18,20,22),KNDFIL
    2 WRITE(ITTY,3)
    3 FORMAT('   Original administrator firm file (file 1)? ',$)
      GO TO 24
    4 WRITE(ITTY,5)
    5 FORMAT('      Original student request file (file 2)? ',$)
      GO TO 24
    6 WRITE(ITTY,7)
    7 FORMAT('        Starting times profile file (file 3)? ',$)
      GO TO 24
    8 WRITE(ITTY,9)
    9 FORMAT(' Listing of sorted students by firm (file 4)? ',$)
      GO TO 24
   10 WRITE(ITTY,11)
   11 FORMAT('      Final administrator firm file (file 5)? ',$)
      GO TO 24
   12 WRITE(ITTY,13)
   13 FORMAT('  Intermediate student request file (file 6)? ',$)
      GO TO 24
   14 WRITE(ITTY,15)
   15 FORMAT('         Student numbers/names list (file 7)? ',$)
      GO TO 24
   16 WRITE(ITTY,17)
   17 FORMAT('         Final student request file (file 8)? ',$)
      GO TO 24
   18 WRITE(ITTY,19)
   19 FORMAT('     Listing of recruiter schedules (file 9)? ',$)
      GO TO 24
   20 WRITE(ITTY,21)
   21 FORMAT('      Listing of student schedules (file 10)? ',$)
      GO TO 24
   22 WRITE(ITTY,23)
   23 FORMAT('  Sorted student numbers/names list(file 11)? ',$)
      GO TO 24
C
C     GET FILE NAME AND STORE IT
   24 READ(ITTY,25)FILNAM
   25 FORMAT(1A10)
      FILSTR(KNDFIL)=FILNAM
      GO TO 27
C
C     RESTORE FILE NAME GOTTEN PREVIOUSLY
   26 FILNAM=FILSTR(KNDFIL)
      GO TO 27
C
C     OPEN THE FILE
   27 GO TO(28,29,30,31),KNDDSK
   28 OPEN(UNIT=IDISK,FILE=FILNAM,ACCESS='SEQIN',ERR=32)
      GO TO 36
   29 OPEN(UNIT=JDISK,FILE=FILNAM,ACCESS='SEQOUT',
     1 CARRIAGECONTROL='FORTRAN',ERR=32)
      GO TO 36
   30 OPEN(UNIT=KDISK,FILE=FILNAM,ACCESS='SEQOUT',ERR=32)
      GO TO 36
   31 OPEN(UNIT=LDISK,FILE=FILNAM,ACCESS='SEQOUT',ERR=32)
      GO TO 36
C
C     ERROR MESSAGES
   32 IF(IFASK.EQ.0)GO TO 34
      WRITE(ITTY,33)
   33 FORMAT(' Cannot open file')
      GO TO 1
   34 WRITE(ITTY,35)KNDFIL
   35 FORMAT(' LCLOPN: Cannot open file type',1I3)
      STOP
   36 RETURN
      END
      SUBROUTINE LCLCLS(KNDFIL,IFASK,KNDDSK,
     1 ITTY,IDISK,JDISK,KDISK,LDISK)
C     RENBR(/CLOSE LOCAL FILES DURING PROCESSING)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THIS ROUTINE IS PART OF THE JOB INTERVIEW REQUEST SYSTEM
C
C     CLOSE THE FILE
      GO TO(1,2,3,4),KNDDSK
    1 CLOSE(UNIT=IDISK)
      GO TO 5
    2 CLOSE(UNIT=JDISK)
      GO TO 5
    3 CLOSE(UNIT=KDISK)
      GO TO 5
    4 CLOSE(UNIT=LDISK)
      GO TO 5
    5 RETURN
      END
      SUBROUTINE RSMWHO(LTRWHO,IPRJCT,IPRGRM,NUMWHO)
C     RENBR(/RETURN ACCOUNT NAME AND IDENTIFIER NUMBER)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C     THIS IS A MACHINE DEPENDENT ROUTINE FOR DECSYSTEM10
C
C     LTRWHO = RETURNED CONTAINING THE PROJECT AND PROGRAMMER
C              NUMBER OF ACCOUNT RUNNING PROGRAM.  THIS CAN
C              BE PRINTED BY 40A1 FORMAT.
C     NUMWHO = RETURNED CONTAINING THE PROGRAMMER NUMBER
C              IN A FORM WHICH CAN BE USED AS A DECIMAL
C              INTEGER.  THIS IS USED TO CONSTRUCT THE NAME
C              OF THE FILE CONTAINING THE RAW RESUME.
C
      DIMENSION LTRWHO(40)
      DIMENSION LA5NAM(8)
C
C     PPNU RETURNS DEC10 PROJECT AND PROGRAMMER NUMBERS
      CALL PPNU(IPRJCT,IPRGRM)
C
C     CONVERT OCTAL PROGRAMMER NUMBER SO CAN BE WRITTEN WITH
C     DECIMAL INTEGER FORMAT WITH SAME DIGITS AS IF OCTAL
C
C     THE FOLLOWING CALCULATION IS BASED UPON THE FOLLOWING
C     EXTRACTION OF OCTAL DIGITS AND REPACKING OF DECIMAL DIGITS
C     NUMWHO =  IPRGRM  -(8*(IPRGRM/8))
C    1    +10*((IPRGRM/8)-(8*(IPRGRM/64)))
C    2   +100*((IPRGRM/64)-(8*(IPRGRM/512)))
C    3  +1000*((IPRGRM/512)-(8*(IPRGRM/4096)))
C    4 +10000*((IPRGRM/4096)-(8*(IPRGRM/32768)))
C    5+100000*((IPRGRM/32768))
C
      NUMWHO = IPRGRM
     1    +2*((IPRGRM/8))
     2   +20*((IPRGRM/64))
     3  +200*((IPRGRM/512))
     4 +2000*((IPRGRM/4096))
     5+20000*((IPRGRM/32768))
C
C     CONVERT NUMBERS INTO 40A1 FORMAT
      ENCODE(40,1,LA5NAM)IPRJCT,IPRGRM
C     FOLLOWING FORMAT ENDS WITH 25 SPACES RATHER THAN WITH 25X
C     SINCE DEC FORTRAN V7 ONLY USES RIGHTMOST X'S IF THERE
C     IS SOMETHING TO THE RIGHT OF THESE SPACES.
C   1 FORMAT('[',1O6,',',1O6,']','1234567890123456789012345')
    1 FORMAT('[',1O6,',',1O6,']','                         ')
      DECODE(40,2,LA5NAM)LTRWHO
    2 FORMAT(40A1)
C
C     RETURN TO CALLING PROGRAM
      RETURN
      END
      SUBROUTINE RSMWIP(ITTY)
C     RENBR(/CLEAR SCREEN OF VIDEO TERMINAL)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
C
C     THIS IS A MACHINE DEPENDENT ROUTINE
C
C     THIS ROUTINE CLEARS THE  SCREEN  OF  THE  CONTROLLING
C     VIDEO  TERMINAL  AND  CAUSES THE NEXT LINE WRITTEN BY
C     THE PROGRAM TO APPEAR AT THE TOP OF THE SCREEN
C
      WRITE(ITTY,1)
    1 FORMAT(1H1,$)
      RETURN
      END
      SUBROUTINE NEWDAT(IDAY,IMONTH,IYEAR)
C     DUMMY ROUTINE NOT NEEDED BY THE INTERVIEW PROGRAM
      RETURN
      END
      SUBROUTINE TTYSIM(IDISK)
      RETURN
      END
      SUBROUTINE TSTAMP(LTRTIM)
C     RENBR(/RETURN CURRENT DATE AND TIME IN 15A1 FORMAT)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THIS IS A MACHINE DEPENDENT ROUTINE
C
C     LTRTIM = ARRAY RETURNED CONTAINING DATE AND TIME IN FORM
C              15-FEB-83 10:30 UNPACKED 1 CHARACTER PER COMPUTER
C              WORD SO IT CAN BE WRITTEN WITH A 15A1 FORMAT.
C
      DIMENSION LA5DAT(2),LTRTIM(15)
C
C     DEC DATE ROUTINE RETURNS DATE IN FORM 15-FEB-83 PACKED
C     5 CHARACTERS PER COMPUTER WORD SO IT CAN BE WRITTEN WITH
C     A 2A5 FORMAT
      CALL DATE(LA5DAT)
C
C     DEC TIME ROUTINE RETURNS TIME IN FORM 10:30 PACKED 5
C     CHARACTERS PER COMPUTER WORD SO IT CAN BE WRITTEN WITH A
C     1A1 FORMAT
C
      CALL TIME(LA5TIM)
C
C     CONVERT THE A5 PACKED WORDS CONTAINING DATE INTO A1 PACKED
C
C     THE FOLLOWING DECODE COMMAND UNPACKS 10 CHARACTERS
C     VIA FORMAT 1 FROM THE A5 PACKED ARRAY NAMED LA5DAT
C     INTO LOCATIONS LTRTIM(1) THROUGH LTRTIM(10)
C
      DECODE(10,1,LA5DAT)(LTRTIM(I),I=1,10)
    1 FORMAT(10A1)
C
C     CONVERT THE A5 PACKED WORD CONTAINING TIME INTO A1 PACKED
      DECODE(5,2,LA5TIM)(LTRTIM(I),I=11,15)
    2 FORMAT(5A1)
      RETURN
      END