Trailing-Edge
-
PDP-10 Archives
-
BB-H064A-SM
-
sources/inseq.for
There are no other files named inseq.for in the archive.
SUBROUTINE INSEQ(LUN)
C
C COPYRIGHT (C) 1976,1977 BY
C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
C
C***** THIS IS A GENERAL SUBROUTINE TO OPEN A NAMED DISK
C***** FILE OR DEVICE FOR SEQUENTIAL INPUT/OUTPUT VIA A SPECIFIED
C***** UNIT NUMBER.
C
C LUN INTEGER NUMBER OF THE LOGICAL
C INPUT UNIT.
C
C ENTRY POINTS ARE AS FOLLOWS...........
C
C INSEQ(LUN) SUBROUTINE CALLING SEQUENCE. USED TO
C OPEN UP SEQUENTIAL INPUT/OUTPUT FOR 'LUN'.
C
C SEQIN(LUN,ASCII,NC)
C SUBROUTINE TO PERFORM THE SAME FUNCTION
C AS INSEQ EXCEPT THAT THE USER MAY
C SPECIFY HIS OWN MESSAGE TO BE PRINTED ON THE
C TERMINAL. THE MESSAGE CONSISTS OF 'NC'
C CHARACTERS OF ALPHANUMERIC DATA IN A5 FORMAT
C STARTING AT 'ASCII'.
C
C OUTSEQ(LUN) SUBROUTINE CALLING SEQUENCE. USED TO OPEN
C UP SEQUENTIAL OUTPUT FOR 'LUN'.
C
C SEQOUT(LUN,ASCII,NC)
C THIS ENTRY SERVES THE SAME PURPOSE AS OUTSEQ
C EXCEPT THAT THE USER MAY SPECIFY HIS OWN
C MESSAGE IN A MANNER IDENTICAL TO SEQIN.
C
C
C LOGDEV(LUN,INDEV) SUBROUTINE CALLING SEQUENCE. RETURNS THE
C THE PHYSICAL DEVICE ASSOCIATED WITH 'LUN'
C IN 'INDEV'.
C
C FILNAM(LUN,RNAME) THIS ENTRY POINT IS USED TO RETURN
C THE FILE NAME (AS ENTERED BY THE USER) THAT
C IS ASSOCIATED WITH THE PARTICULAR LOGICAL
C UNIT NUMBER. IF THE DEVICE ASSOCIATED
C WITH THE PARTICULAR UNIT IS NOT 'DSK' THEN
C THE NAME WILL BE RETURNED AS BLANK.
C
C CLSDEV(LUN) SUBROUTINE CALLING SEQUENCE. USED TO CLOSE
C AND SAVE DEVICE ASSOCIATED WITH 'LUN'.
C
C RPTNAM(RPNAME) THIS ENTRY MAY OPTIONALLY BE USED TO SPECIFY
C A NAME TO APPEAR ON THE BURST SHEET
C IN BLOCK LETTERS WHEN THE PRINTER IS SELECTED
C AS THE DEVICE FOR OUTPUT. IF THIS CALL IS
C NOT MADE PRIOR TO THE CALL TO 'OUTSEQ' OR
C 'SEQOUT' THEN THE SYSTEM DEFAULT WILL BE
C USED (FOR03 WHEN WRITING ON UNIT 3).
C
C THIS SUBROUTINE COMMUNICATES WITH THE USER VIA
C THE TTY TO ALLOW THE NAME OF THE FILE TO BE
C SPECIFIED.
C
INTEGER DEVIN(16),NUMIN(16),BUFFER(80),IBF(10)
DOUBLE PRECISION FNAME,RDEV,DEV(4),DEVTOO(4),RNAME,FNAM(16),
1RPNAME,SNAME
DIMENSION ASCII(1),FMT(4)
C SET UP LIST OF DEVICE NAMES NAMES IN ARRAY
EQUIVALENCE(RDEV,IDEV)
DATA DEV/'LPT','TTY','NUL','CDR'/
DATA DEVTOO/'LPT:','TTY:','NUL:','CDR:'/
DATA NMIN/0/,PROMPT/"035744020100/,NDEV/4/
DATA SNAME/' '/
DATA FMT/'(/1X,','XXXA1',',1X,A','2,$)'/
DATA LA/"605004020100/,LZ/"751004020100/,MASK/"577777777777/
C
C*********************************************************************
C
C ASK USER FOR THE FILE NAME
1 WRITE(5,100) LUN,PROMPT
100 FORMAT(/' SELECT DEVICE FOR INPUT UNIT',I3,1X,A2,$)
IENTRY=1
GO TO 5
C
C***********************************************************************
ENTRY SEQIN(LUN,ASCII,NC)
NBRCH=1
C MOVE MESSAGE INTO BUFFER IN A1 FORMAT
20 DECODE(NC,102,ASCII) (BUFFER(J),J=1,NC)
102 FORMAT(80A1)
C SET UP FORMAT FOR MESSAGE
ENCODE(5,103,FMT(2)) NC
103 FORMAT(I3,'A1')
C WRITE MESSAGE
2 WRITE(5,FMT) (BUFFER(J),J=1,NC),PROMPT
IENTRY=2
GO TO (5,21),NBRCH
C
C ENTER COMMON CODE FOR INSEQ AND SEQIN
5 READ(5,101) FNAME
101 FORMAT(A10)
C CHECK TO SEE IF NEW DEVICE SPECIFIED
NMIN=NMIN+1
NUMIN(NMIN)=LUN
C MAKE SURE THAT ALPHA IS ALL CAPS
KBRCH=1
28 DECODE(10,102,FNAME) IBF
DO 7 I=1,10
IF(IBF(I).GE.LA.AND.IBF(I).LE.LZ) IBF(I)=IBF(I).AND.MASK
7 CONTINUE
ENCODE(10,102,FNAME) IBF
GO TO (19,29),KBRCH
19 DO 8 I=1,NDEV
IF(FNAME.EQ.DEV(I).OR.FNAME.EQ.DEVTOO(I)) GO TO 6
8 CONTINUE
C MAKE SURE FILE EXISTS
CALL CKFILE(FNAME,IRET)
IF(IRET.EQ.2) GO TO 18
IF(IRET.NE.1) GO TO 17
C PUT OUT ERROR AND TRY AGAIN
WRITE(5,106)
106 FORMAT(' FILE DOES NOT EXIST')
NMIN=NMIN-1
GO TO (1,2),IENTRY
C FATAL ERROR - ABORT THE RUN
17 WRITE(5,105) IRET
105 FORMAT(' ERROR NO',I2,' CKFILE')
STOP
C NOW OPEN THE FILE FOR INPUT
18 OPEN(UNIT=LUN,DEVICE='DSK',ACCESS='SEQINOUT',
* MODE='ASCII',FILE=FNAME)
DEVIN(NMIN)='DSK'
FNAM(NMIN)=FNAME
RETURN
C NEW DEVICE SPECIFIED
6 OPEN(UNIT=LUN,DEVICE=DEV(I),ACCESS='SEQINOUT',
* MODE='ASCII',FILE=SNAME)
RDEV=DEV(I)
DEVIN(NMIN)=IDEV
FNAM(NMIN)=' '
RETURN
C*************************************************************
C
C ENTRY POINT FOR OUTSEQ SUBROUTINE
ENTRY OUTSEQ(LUN)
C
C ASK USER FOR THE FILE NAME
51 WRITE(5,201) LUN,PROMPT
201 FORMAT(/' SELECT DEVICE FOR OUTPUT UNIT',I3,1X,A2,$)
IENTRY=1
GO TO 21
C
C*************************************************************
C ENTRY POINT FOR SEQOUT SUB
ENTRY SEQOUT(LUN,ASCII,NC)
NBRCH=2
GO TO 20
C ENTER COMMON CODE FOR OUTSEQ AND SEQOUT
21 READ(5,101) FNAME
C CHECK TO SEE IF NEW DEVICE WAS INPUT
C IF DEVICE WAS SPECIFIED THEN DON'T
C USE AS FILE NAME BUT DEVICE INSTEAD
NMIN=NMIN+1
NUMIN(NMIN)=LUN
C MAKE SURE THAT ALPHA