Google
 

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