Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-09 - decus/20-34/retmp1.for
There are 6 other files named retmp1.for in the archive. Click here to see a list.
      SUBROUTINE RETEMP(KNDSPR,JOBNUM,ISPR)
C     RENBR(RETMP1/PDP10 OPEN AND CLOSE SCRATCH FILE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     KNDSPR = 0, RETURN JOBNUM CONTAINING NUMBER UNIQUELY
C              IDENTIFYING THIS JOB WHICH CAN BE USED BY
C              SUBSEQUENT CALLS TO THIS ROUTINE IN THE
C              CONSTRUCTION OF A SCRATCH FILE NAME.  NO
C              FILES ARE OPENED.
C            = 1, OPEN SCRATCH FILE FOR WRITING
C            = 2, CLOSE SCRATCH FILE JUST WRITTEN
C            = 3, OPEN SCRATCH FILE FOR READING
C            = 4, CLOSE AND DELETE SCRATCH FILE AFTER
C              READING
C     ISPR   = UNIT NUMBER UPON WHICH SCRACH UNIT CAN BE
C              WRITTEN OR READ OR CLOSED
C
      DOUBLE PRECISION FILTMP
C
      IF(KNDSPR.GT.0)GO TO 1
C
C     OBTAIN JOB IDENTIFIER FROM WHICH FILE NAME IS MADE
C
C     THE SECNDS ROUTINE IS FIRST CALLED TO OBTAIN THE TIME
C     AS  THE  NUMBER  OF SECONDS SINCE MIDNIGHT.  THE FILE
C     NAME IS THEN CONSTRUCTED FROM THE NUMBER OF TENTHS OF
C     SECONDS  SINCE  MIDNIGHT  PLUS 100000.  THE OFFSET IS
C     ADDED TO FORCE THE NUMBER TO CONSIST OF 6  CHARACTERS
C     WHEN WRITTEN AS A DECIMAL INTEGER.  THE MAXIMUM VALUE
C     INCLUDING THIS OFFSET IS 963999.
C
      JOBNUM=100000.0+10.0*SECNDS(0.0)
      GO TO 7
C
C     CONSTRUCT NAME OF FILE THEN OPEN OR CLOSE IT
    1 ENCODE(10,2,FILTMP)JOBNUM
    2 FORMAT(1I6,4H.TMP)
      GO TO(3,4,5,6),KNDSPR
C
C     OPEN OUTPUT FILE
    3 OPEN(UNIT=ISPR,FILE=FILTMP,ACCESS='SEQOUT')
      GO TO 7
C
C     CLOSE OUTPUT FILE
    4 CLOSE(UNIT=ISPR)
      GO TO 7
C
C     OPEN INPUT FILE
    5 OPEN(UNIT=ISPR,FILE=FILTMP,ACCESS='SEQIN')
      GO TO 7
C
C     CLOSE AND DELETE INPUT FILE
    6 CLOSE(UNIT=ISPR,DISPOSE='DELETE')
C
C     RETURN TO CALLING PROGRAM
    7 RETURN
      END
      SUBROUTINE RECLOS(INCR,IOUT,IPAGE,ILPT,LPTTTY)
C     RENBR(RECLS1/PDP10 CLOSE OUTPUT FILES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     INCR   = NOT EQUAL TO ZERO IF RENUMBERING
C     IOUT   = UNIT ON WHICH RENUMBERED OUTPUT IS WRITTEN
C     IPAGE  = NOT EQUAL TO ZERO IF MAKING LISTING
C     ILPT   = UNIT ON WHICH LISTING IS WRITTEN
C     LPTTTY = -1, LISTING DEVICE IS LINE PRINTER
C            = 0, LISTING DEVICE IS DISK
C            = 1, LISTING DEVICE IS TERMINAL
C
      IF(INCR.NE.0)CLOSE(UNIT=IOUT)
      IF(IPAGE.NE.0)CLOSE(UNIT=ILPT)
      RETURN
      END
      FUNCTION SECNDS(OFFSET)
C     RENBR(SECND1/PDP10 SECONDS SINCE MIDNIGHT)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS DECSYSTEM-10 ROUTINE RETURNS THE  CURRENT  TIME,
C     STATED  AS  THE  NUMBER  OF  SECONDS  SINCE MIDNIGHT,
C     OFFSET BY THE VALUE  OF  ITS  SINGLE  ARGUMENT.   THE
C     DECSYSTEM-10  TIME ROUTINE RETURNS ITS FIRST ARGUMENT
C     IN THE FORM 'HH:MM' AND ITS SECOND  ARGUMENT  IN  THE
C     FORM  ' SS.T' WHERE HH, MM ,SS AND T FORM THE CURRENT
C     TIME STATED IN HOURS, MINUTES, SECONDS AND TENTHS  OF
C     SECONDS.   DECODE STATEMENTS ARE USED TO CONVERT FROM
C     THE HOLLERITH FORM RETURNED BY THE  TIME  ROUTINE  TO
C     THE  NUMERIC  FORM  WHICH  IS  TO  BE RETURNED BY THE
C     SECNDS ROUTINE.  THE  CALLING  CONVENTIONS  FOR  THIS
C     ROUTINE  ARE THE SAME AS FOR THE VAX-11 SECNDS SYSTEM
C     SUBROUTINE WHICH  IS  DESCRIBED  IN  SECTION  C.6  OF
C     APPENDIX C OF THE VAX-11 USER'S GUIDE.
C
      CALL TIME(LTRHHM,LTRSST)
      DECODE(5,1,LTRHHM)IHOURS,IMINUT
    1 FORMAT(1I2,1X,1I2)
      DECODE(5,2,LTRSST)ISECND,ITENTH
    2 FORMAT(1I3,1X,1I1)
      IF(IHOURS.GE.24)IHOURS=0
      WHOLE=(3600*IHOURS)+(60*IMINUT)+ISECND
      TENTHS=FLOAT(ITENTH)/10.0
      SECNDS=OFFSET+WHOLE+TENTHS
      RETURN
      END