d       SUBROUTINE IRD370
È CHANGES MADE 15-JAN-1980 ****
,C
C      SUBROUTINE TO ASSIGN, REWIND AND POSITION 'TAPE'.
ôC
X      IMPLICIT INTEGER*2 (I-N)
¼      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
      1 IFN(17),IVOL(6),TRAN,LAB,IEOF
„      LOGICAL*1 IFN,TRAN,LAB,IEOF,IVOL
è      INTEGER*4 I,sys$assign
L      DATA IORWD/'24'X/,IOSPF/'25'X/
°    2 FORMAT ('$INPUT FILE # [1] ')
    3 FORMAT ('$LABELED TAPE (T/F) ? ')
x    4 FORMAT (L1)
Ü    5 FORMAT (I5)
@C	ASSIGN CHANNEL TO LOGICAL DEVICE 'TAPE':
¤      if (SYS$ASSIGN('TAPE',LUNMT,,)) then
C	REWIND 'TAPE':
l      CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IORWD),,,,,,,,,)
Ð      WRITE (LUNTT,3)
4      READ (LUNTT,4) LAB
˜      TRAN = LAB
ü      WRITE (LUNTT,2)
`	      READ (LUNTT,5) I
Ä	      IF (LAB) GO TO 30
(
      IF (I .GT. 1) CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOSPF),,,,%VAL(I-1),
Œ
     1 ,,,,)
ð
      RETURN
T   30 CALL RDLBL(0)
¸      IF (I .LE. 1) RETURN
      DO 40 J = 2,I
€      CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOSPF),,,,%VAL(1),,,,,)
ä      CALL RDLBL(2)
H   40 CALL RDLBL(1)
¬	end if
      RETURN
t      END