Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50545/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 ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
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 RESUME.WHO
C FROM RESUME STORAGE AREA
C = 2, READ PASSWORD FILE NAMED PASWRD.YYY FROM
C RESUME STORAGE AREA
C = 3, READ RESUME FILE NAMED XXXXXX.YYY FROM
C RESUME STORAGE AREA
C = 4, READ THE BOILER PLATE EDUCATION SECTION
C FROM FILE NAMED SCHOOL.YYY IN THE RESUME
C STORAGE AREA
C = 5, WRITE RESUME FILE NAMED XXXXXX.YYY TO
C RESUME STORAGE AREA
C = 6, WRITE FILE NAMED RESUME.DOC CONTAINING
C A PROOF OF THE RESUME TO THE LOCAL AREA.
C THIS IS USED IF EACH STUDENT HAS SEPARATE
C ACCOUNT. TELL USER WHAT THIS FILE IS.
C = 7, WRITE FILE NAMED XXXXXX.DOC CONTAINING
C A PROOF OF THE RESUME TO THE LOCAL AREA.
C THIS IS USED IF SEVERAL STUDENTS USE THE
C SAME ACCOUNT. TELL USER WHAT THIS FILE IS.
C = 12, READ MESSAGE FILE NAMED MESAGE.YYY FROM
C RESUME STORAGE AREA
C = 16, TELL USER HOW TO PRINT THE FILE OPENED
C BY KNDFIL=7. DO NOT OPEN THIS FILE NOW.
C = 17, TELL USER HOW TO TYPE THE FILE OPENED
C BY KNDFIL=7. DO NOT OPEN THIS FILE NOW.
C
C FOLLOWING ARE ADMINISTRATOR FUNCTIONS ONLY
C
C = 8, WRITE FILE NAMED XXXXXX.DOC CONTAINING
C TYPESET COPY OF THE RESUME TO THE PRINTING
C SERVICE ACCOUNT
C = 9, WRITE FILE NAMED RESUME.LST CONTAINING A
C LIST OF ALL STUDENTS AND ASSOCIATED NUMBERS
C INTO THE LOCAL AREA.
C = 10, WRITE FILE NAMED RESUME.PRF CONTAINING
C PROOFS OF SEVERAL RESUMES INTO THE LOCAL
C AREA.
C = 11, READ FILE NAMED RESUME.WRD CONTAINING
C LIST OF SPECIALLY CAPITALIZED WORDS FROM
C THE RESUME STORAGE AREA.
C = 13, READ LIST OF STUDENTS AND ASSOCIATED
C NUMBERS FROM FILE NAMED RESUME.LST IN
C THE LOCAL AREA
C = 14, WRITE ALPHABETICALLY SORTED LIST OF STUDENT
C NAMES AND NUMBERS IN FILE NAMED RESUME.SRT
C IN THE LOCAL AREA
C = 15, READ ALPHABETICALLY SORTED LIST OF STUDENT
C NAMES AND NUMBERS FROM FILE NAMED RESUME.SRT
C IN THE LOCAL AREA
C
C NUMWHO = NUMBER UNIQUELY IDENTIFYING THIS STUDENT IN CLASS
C IYEAR = THE CLASS NUMBER OF THIS STUDENT
C ITTY = UNIT NUMBER OF TERMINAL. USED TO TELL USER THE
C NAME OF THE FILE CONTAINING THE PROOF OF RESUME.
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 RESUMES
C NUMYPS = PROJECT AND PROGRAMMER NUMBER AND TERMINAL ZERO
C OF THE ACCOUNT USED BY THE PRINTING SERVICE
C
COMMON/RSMFOU/NUMDIR(3),NUMYPS(3)
C
C ODD CHARACTERS
DATA LTRSPA,LTRZER/1H ,1H0/
C
C CONSTRUCT THE FILE NAME
GO TO(1,2,4,6,4,8,9,11,13,15,
1 16,17,13,14,14,9,9),KNDFIL
C
C ADMINISTRATOR FILE NAMED RESUME.WHO
1 FILNAM='RESUME.WHO'
GO TO 27
C
C PASSWORD FILE NAMED PASWRD.YYY
2 ENCODE(10,3,LA5FIL)IYEAR
3 FORMAT(7HPASWRD.,1I3)
GO TO 19
C
C SOURCE OF RESUME NAMED XXXXXX.YYY
4 ENCODE(10,5,LA5FIL)NUMWHO,IYEAR
5 FORMAT(1I6,1H.,1I3)
GO TO 19
C
C EDUCATION BOILER PLATE NAMED SCHOOL.YYY
6 ENCODE(10,7,LA5FIL)IYEAR
7 FORMAT(7HSCHOOL.,1I3)
GO TO 19
C
C PROOF FILE NAMED RESUME.DOC
8 FILNAM='RESUME.DOC'
GO TO 27
C
C PROOF FILE NAMED XXXXXX.DOC
9 ENCODE(10,10,LA5FIL)NUMWHO
10 FORMAT(1I6,4H.DOC)
GO TO 19
C
C TRANSMITTED FILE NAMED XXXXXX.
11 ENCODE(10,12,LA5FIL)NUMWHO
12 FORMAT(1I6,4H. )
GO TO 23
C
C LIST OF STUDENTS IN FILE NAMED RESUME.LST
13 FILNAM='RESUME.LST'
GO TO 27
C
C SORTED LIST OF STUDENTS IN FILE NAMED RESUME.SRT
14 FILNAM='RESUME.SRT'
GO TO 27
C
C PROOFS OF SEVERAL RESUMES IN FILE NAMED RESUME.PRF
15 FILNAM='RESUME.PRF'
GO TO 27
C
C LIST OF SPECIALLY CAPITALIZED WORDS
16 FILNAM='RESUME.WRD'
GO TO 27
C
C PASSWORD FILE NAMED MESAGE.YYY
17 ENCODE(10,18,LA5FIL)IYEAR
18 FORMAT(7HMESAGE.,1I3)
GO TO 19
C
C CONVERT SPACES IN FILE NAME TO ZEROES
19 DECODE(10,20,LA5FIL)LTRFIL
20 FORMAT(10A1)
DO 21 I=1,10
IF(LTRFIL(I).EQ.LTRSPA)LTRFIL(I)=LTRZER
21 CONTINUE
ENCODE(10,22,FILNAM)LTRFIL
22 FORMAT(10A1)
GO TO 27
C
C REMOVE SPACES FROM FILE NAME
23 DECODE(10,24,LA5FIL)LTRFIL
24 FORMAT(10A1)
J=0
DO 25 I=1,10
IF(LTRFIL(I).EQ.LTRSPA)GO TO 25
J=J+1
IF(J.EQ.I)GO TO 25
LTRFIL(J)=LTRFIL(I)
LTRFIL(I)=LTRSPA
25 CONTINUE
ENCODE(10,26,FILNAM)LTRFIL
26 FORMAT(10A1)
GO TO 27
C
C OPEN FILE FOR READING OR WRITING
27 GO TO(28,28,28,28,30,32,32,35,31,34,
1 28,28,29,31,29,36,38),KNDFIL
C
C READ FILE FROM RESUME STORAGE AREA
28 OPEN(UNIT=IDISK,FILE=FILNAM,DIRECTORY=NUMDIR,
1 ACCESS='SEQIN',ERR=40)
GO TO 41
C
C READ FILE TO LOCAL AREA
29 OPEN(UNIT=IDISK,FILE=FILNAM,
1 ACCESS='SEQIN',ERR=40)
GO TO 41
C
C WRITE FILE TO RESUME STORAGE AREA
30 OPEN(UNIT=IDISK,FILE=FILNAM,DIRECTORY=NUMDIR,
1 ACCESS='SEQOUT',PROTECTION="100,ERR=40)
GO TO 41
C
C WRITE FILE TO LOCAL AREA WITHOUT CARRIAGE CONVERSION
31 OPEN(UNIT=IDISK,FILE=FILNAM,
1 ACCESS='SEQOUT',ERR=40)
GO TO 41
C
C WRITE FILE TO LOCAL AREA WITH CARRIAGE CONVERSION
32 WRITE(ITTY,33)FILNAM
33 FORMAT(' The file named ',1A10,
1' contains an expendable copy of your resume.')
34 OPEN(UNIT=IDISK,FILE=FILNAM,
1 ACCESS='SEQOUT',CARRIAGECONTROL='FORTRAN',ERR=40)
GO TO 41
C
C WRITE FILE TO PRINTING SERVICE AREA
35 OPEN(UNIT=IDISK,FILE=FILNAM,DIRECTORY=NUMYPS,
1 ACCESS='SEQOUT',PROTECTION="100,
2 CARRIAGECONTROL='FORTRAN',ERR=40)
GO TO 41
C
C INSTRUCTIONS FOR PRINTING FILE, DO NOT OPEN NOW
36 WRITE(ITTY,37)FILNAM
37 FORMAT(
1' You would type the following to print the file'/
2' PRINT ',1A10)
GO TO 40
C
C INSTRUCTIONS FOR TYPING FILE, DO NOT OPEN NOW
38 WRITE(ITTY,39)FILNAM
39 FORMAT(
1' You would type the following on the letter quality printer'/
2' HC'/
3' ',1A10/
4' G')
GO TO 40
C
C RETURN TO CALLING PROGRAM
40 IFOPEN=0
GO TO 42
41 IFOPEN=1
42 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 THIS ROUTINE IS PART OF THE STUDENT RESUME SYSTEM
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 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 RSMDIR(JDISK ,KNTFIL,JOBUSR,LYEAR ,IFOPEN)
C RENBR(/IDENTIFY NEXT RESUME IN ACCOUNT DIRECTORY)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS IS A MACHINE DEPENDENT ROUTINE. IT READS A
C FILE CONTAINING THE DIRECTORY OF THE FILES IN THE
C ACCOUNT IN WHICH THE RESUMES ARE STORED, AND
C IDENTIFIES THE NEXT RESUME FILE IN THE ACCOUNT.
C THIS VERSION IS FOR THE DECSYSTEM10
C
C THE FOLLOWING ARGUMENTS ARE RETURNED UNCHANGED
C
C JDISK = UNIT ON WHICH TO OPEN DIRECTORY FILE IF KNTFIL=0
C OR ON WHICH TO READ DIRECTORY FILE IF KNTFIL.GT.0
C
C THE FOLLOWING ARGUMENTS ARE RETURNED CHANGED
C
C KNTFIL = 0 INPUT, GET FIRST FILE. THE NAMES OF
C THESE FILE ARE READ FROM A FILE NAME RESUME.DIR
C IN THE RESUME STORAGE AREA. THE NAMES IN THE
C DIRECTORY FILE START IN COLUMN 2, RATHER THAN 1.
C RETURNED SET TO 1.
C = 1 OR GREATER, GET NEXT FILE IN SEQUENCE.
C RETURNED SET TO KNTFIL+1.
C JOBUSR = RETURNED SET TO STUDENT NUMBER
C LYEAR = RETURNED SET TO CLASS NUMBER
C IFOPEN = INPUT VALUE IS IGNORED
C = 0 RETURNED IF COULD NOT OPEN FILE. THE FINAL
C FILE HAS ALREADY BEEN PROCESSED.
C = 1 RETURNED, FILE IS OPEN
C
C
DIMENSION LTRFIL(10),LTRDGT(10)
C
C DECSYSTEM10 PROJECT AND PROGRAMMER NUMBER OF THE
C ACCOUNT WHERE RESUME AND ADMINISTRATOR FILES ARE STORED
COMMON/RSMFOU/NUMDIR(3),NUMYPS(3)
C
DATA LTRSPA,LTRZER,LTRDOT/1H ,1H0,1H./
DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C LTRTAB = TAB CHARACTER. APPEARS BETWEEN NAME AND EXTENSION
DATA LTRTAB/"045004020100/
C
C DETERMINE TYPE OF FILE NEEDED
IF(KNTFIL.GT.0)GO TO 1
C
C OPEN FILE CONTAINING NAMES OF INDIVIDUAL FILES
OPEN(UNIT=JDISK,FILE='RESUME.DIR',DIRECTORY=NUMDIR,
1ACCESS='SEQIN',ERR=8)
C
C GET NAME OF NEXT FILE IF LOOPING THROUGH GROUP OF RESUMES
1 READ(JDISK,2,END=8)LTRFIL
2 FORMAT(10A1)
C
C EVALUATE THE STUDENT NUMBER
JOBUSR=0
DO 4 I=1,6
LTRNOW=LTRFIL(I)
DO 3 J=1,10
IF(LTRNOW.NE.LTRDGT(J))GO TO 3
JOBUSR=(10*JOBUSR)+J-1
GO TO 4
3 CONTINUE
GO TO 7
4 CONTINUE
C
C CHECK FOR TAB BETWEEN STUDENT AND CLASS NUMBERS
IF(LTRFIL(7).NE.LTRTAB)GO TO 7
C
C EVALUATE CLASS NUMBER
LYEAR=0
DO 6 I=8,10
LTRNOW=LTRFIL(I)
DO 5 J=1,10
IF(LTRNOW.NE.LTRDGT(J))GO TO 5
LYEAR=(10*LYEAR)+J-1
GO TO 6
5 CONTINUE
GO TO 7
6 CONTINUE
KNTFIL=KNTFIL+1
IFOPEN=1
GO TO 9
C
C LINE IN DIRECTORY FILE NOT CORRECT FORMAT FOR FILE NAME
7 GO TO 1
C
C NO MORE FILES TO BE READ
8 IFOPEN=0
C
C RETURN TO CALLING PROGRAM
9 RETURN
END
SUBROUTINE NEWDAT(IDAY,IMONTH,IYEAR)
C RENBR(/RETURN CURRENT DAY, MONTH, YEAR)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS IS A MACHINE DEPENDENT ROUTINE
C
C IDAY = RETURNED CONTAINING NUMBER OF DAY IN MONTH
C IMONTH = RETURNED CONTAINING NUMBER OF MONTH IN YEAR
C IYEAR = RETURNED CONTAINING RIGHT 2 DIGITS OF YEAR
C
DOUBLE PRECISION LTRDAT
DIMENSION NAMMTH(12)
DATA NAMMTH/'Jan','Feb','Mar','Apr','May','Jun',
1'Jul','Aug','Sep','Oct','Nov','Dec'/
C
C DATE RETURNS FORM 23-OCT-82 SO CAN BE WRITTEN WITH A10 FORMAT
CALL DATE(LTRDAT)
C
C SPLIT A10 FORMAT DATE INTO DAY, YEAR AND A3 FORMAT MONTH
DECODE(9,1,LTRDAT)IDAY,LTRMTH,IYEAR
1 FORMAT(I2,1X,A3,1X,I2)
IYEAR=IYEAR+1900
IF(IYEAR.LE.1980)IYEAR=IYEAR+100
C
C IDENTIFY MONTH
DO 2 I=1,12
IF(LTRMTH.NE.NAMMTH(I))GO TO 2
IMONTH=I
GO TO 3
2 CONTINUE
IMONTH=0
3 RETURN
END
SUBROUTINE TTYSIM(IDISK)
C RENBR(/REPLACE FIRST CHARACTERS BY CARRIAGE CONTROLS)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C ***************************
C * *
C * THIS IS A DUMMY ROUTINE *
C * *
C ***************************
C
C THE ASSEMBLY VERSION OF THIS ROUTINE CAUSES THE FIRST
C CHARACTER ON EACH LINE OF THE NEXT FILE WRITTEN ONTO
C UNIT IDISK TO BE CONVERTED DIRECTLY TO THE CARRIAGE
C CONTROL CHARACTER GIVING THE PROPER LINE SPACING.
C
C THIS IS NO LONGER NEEDED IN VERSION 7 OF FORTRAN ON
C THE DECSYSTEM10 OR DECSYSTEM20 SINCE IT HAS BEEN
C REPLACED BY CARRIAGECONTROL='FORTRAN' IN THE OPEN
C STATEMENTS OF THE FILES NEEDING THIS CONVERSION.
C
RETURN
END