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