Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0034/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
C144085053368'
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
C052312004075
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
C104054030038
END