SUBROUTINE CFIRST(IOLUN)
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      CHARACTER*1 CHAR
      CHARACTER*1 ESC
      CHARACTER*40 LOGIC,RESULT
      LOGICAL D_OPEN
      INTEGER*4 SYS$TRNLOG,SYS$CRELOG
      BYTE IESC
      EXTERNAL SS$_NOTRAN,SS$_ABORT
      DATA FIRST/20*.TRUE./
      DATA WRITE/20*.FALSE./
      DATA WAIT/20*.FALSE./
      DATA NDRIVE/20*-1/
      DATA LUNAME/'01','02','03','04','05','06','07','08','09',
     .   '10','11','12','13','14','15','16','17','18','19','20'/
C     if first is clear we're all set
      IF(.NOT.FIRST(IOLUN))RETURN
C     get real name
      LOGIC(1:) = 'IOP0'//LUNAME(IOLUN)
5     I = 1
      L = 6
      LEV = 0
C     attempt a translation
10    I = SYS$TRNLOG(LOGIC(1:L),L,RESULT,,,)
D     TYPE *,'JUST TRANSLATED',LOGIC,' TO',RESULT
D     CALL ERRMES(I)
      IF(I.EQ.%LOC(SS$_NOTRAN))GOTO 40
      IF(MOD(I,8).NE.1)THEN
         CALL ERRMES(I)
         TYPE *,'BAD TRANSLATION IN IOPACK'
         CALL SYS$EXIT(SS$_ABORT)
      END IF
      LEV = 1
      J = 1
      IESC = '1B'X
      ESC = CHAR(IESC)
      IF(RESULT(1:1).EQ.ESC)J=5
      LOGIC(1:L+1-J) = RESULT(J:L)
      L = L + 1 - J
      GOTO 10
C     if there weren't any translations then use SY:IOP00n.DAT
40    IF(LEV.EQ.0)THEN
         CALL IFERR(SYS$CRELOG(%VAL(2),LOGIC(1:6),LOGIC(1:6)//'.DAT',))
         GOTO 5
      END IF
C     there was a translation and we've got it now in RESULT(1:L)
C     check for a magtape
      M = INDEX(RESULT(1:L),'MT')
      IF(M.EQ.0)GOTO 60
      N = INDEX(RESULT(1:L),':')
      IF(N.EQ.0)GOTO 60
      IF(N.LT.M)GOTO 60
      NDRIVE(IOLUN) = 0
      IF(RESULT(N-1:N-1).EQ.'1')NDRIVE(IOLUN) = 1
      GOTO 80
C     we've got a disk file on our hands
60    CONTINUE
D     TYPE *,'THIS WILL BE A DISK UNIT'
      NDRIVE(IOLUN) = -1
      IF(WRITE(IOLUN))THEN
         IF(.NOT.D_OPEN(IOLUN,'W',RESULT(1:L)))
     .   STOP 'IOPACK UNABLE TO OPEN DISK FILE'
      ELSE
         IF(.NOT.D_OPEN(IOLUN,'R',RESULT(1:L)))
     .   STOP 'IOPACK UNABLE TO OPEN DISK FILE'
      END IF
80    CONTINUE
      FIRST(IOLUN) = .FALSE.
      RETURN
      END
      SUBROUTINE IOPEN(IOLUN,NAME)
      CHARACTER*(*) NAME
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      INTEGER*4 SYS$CRELOG
      EXTERNAL SS$_ABORT
      IF(.NOT.FIRST(IOLUN))THEN
         TYPE *,'ILLEGAL ATTEMPT TO IOPEN AN OPEN LUN'
         CALL SYS$EXIT(SS$_ABORT)
C        force in CFIRST to initialize COMMON
         CALL CFIRST
      END IF
      I = SYS$CRELOG(%VAL(2),'IOP0'//LUNAME(IOLUN),NAME,)
      IF(MOD(I,8).NE.1)THEN
         CALL ERRMES(I)
         TYPE *,'UNABLE TO ASSIGN LOGICAL NAME IN IOPEN'
         CALL SYS$EXIT(SS$_ABORT)
      END IF
      RETURN
      END
      SUBROUTINE IOCLOS(IOLUN)
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      IF(FIRST(IOLUN))RETURN
      IF(NDRIVE(IOLUN).LT.0)THEN
C        it's a disk drive
         CALL D_CLOS(IOLUN)
      ELSE
C        it's a tape drive
C        if they didn't do a wait, insert one
         IF(WAIT(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
         WAIT(IOLUN) = .FALSE.
C        if they wrote on it write an EOF at the end
         IF(WRITE(IOLUN))CALL T_WEOF(NDRIVE(IOLUN))
         IF(WRITE(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
         IF(WRITE(IOLUN))CALL T_WEOF(NDRIVE(IOLUN))
         IF(WRITE(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
         IF(WRITE(IOLUN))CALL T_SKPF(NDRIVE(IOLUN),-1)
         IF(WRITE(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
      END IF
C     in either case set FIRST again
      FIRST(IOLUN) = .TRUE.
C     force load CFIRST
      IF(.NOT.FIRST(IOLUN))CALL CFIRST
      RETURN
      END
      SUBROUTINE BUFFEROUT(IOLUN,PARITY,IFWA,ILWA)
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      WRITE(IOLUN) = .TRUE.
      CALL CFIRST(IOLUN)
      NBYTES = %LOC(ILWA) - %LOC(IFWA) + 4
      IF(NDRIVE(IOLUN).LT.0)THEN
C        disk
         CALL D_PUT(IOLUN,IFWA,NBYTES)
      ELSE
C        tape
C        if they didn't do a wait, insert one
         IF(WAIT(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
         CALL T_WRIT(NDRIVE(IOLUN),IFWA,NBYTES)
         WAIT(IOLUN) = .TRUE.
      END IF
      RETURN
      END
      SUBROUTINE WRTAPE(IOLUN,MODE,NTYPE,NADDR,NWDCNT)
C
C        NB:
C        NWDCNT IN WRTAPE IS THE BYTE COUNT NOT THE WORD COUNT
C
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      WRITE(IOLUN) = .TRUE.
      CALL CFIRST(IOLUN)
      NBYTES = NWDCNT
      IF(NDRIVE(IOLUN).LT.0)THEN
C        disk
         CALL D_PUT(IOLUN,NADDR,NBYTES)
      ELSE
C        tape
C        if they didn't do a wait, insert one
         IF(WAIT(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
         CALL T_WRIT(NDRIVE(IOLUN),NADDR,NBYTES)
         WAIT(IOLUN) = .TRUE.
      END IF
      RETURN
      END
      SUBROUTINE BUFFERIN(IOLUN,PARITY,IFWA,ILWA)
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      WRITE(IOLUN) = .FALSE.
      CALL CFIRST(IOLUN)
      NBYTES = %LOC(ILWA) - %LOC(IFWA) + 4
      IF(NDRIVE(IOLUN).LT.0)THEN
C        disk
         CALL D_GET(IOLUN,IFWA,NBYTES)
      ELSE
C        tape
C        if they didn't do a wait, insert one
         IF(WAIT(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
         CALL T_READ(NDRIVE(IOLUN),IFWA,NBYTES)
         WAIT(IOLUN) = .TRUE.
      END IF
      RETURN
      END
      SUBROUTINE RDTAPE(IOLUN,MODE,NTYPE,NADDR,NWDCNT)
C
C        NB:
C        NWDCNT IS THE BYTE COUNT NOT THE WORD COUNT
C
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      WRITE(IOLUN) = .FALSE.
      CALL CFIRST(IOLUN)
      NBYTES = NWDCNT
      IF(NDRIVE(IOLUN).LT.0)THEN
C        disk
D        TYPE *,'DISK'
         CALL D_GET(IOLUN,NADDR,NBYTES)
      ELSE
C        tape
C        if they didn't do a wait, insert one
D        TYPE *,'TAPE'
         IF(WAIT(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
         CALL T_READ(NDRIVE(IOLUN),NADDR,NBYTES)
         WAIT(IOLUN) = .TRUE.
      END IF
      RETURN
      END
      INTEGER*4 FUNCTION LENGTHF(IOLUN)
C
C        NB:
C        LENGTHF RETURNS THE INTEGER*4 WORD COUNT
C        TO GET BYTE COUNT USE IOWAIT
C
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      INTEGER*4 D_LEN
      EXTERNAL SS$_ABORT
      IF(FIRST(IOLUN))THEN
         TYPE *,'CALL TO LENGTHF PRECEDES FIRST TRANSFER'
         CALL SYS$EXIT(SS$_ABORT)
C        force load CFIRST
         CALL CFIRST
      END IF
      IF(NDRIVE(IOLUN).LT.0)THEN
C        disk
         LENGTHF = (D_LEN(IOLUN)+3)/4
      ELSE
C        tape
         CALL T_WAIT(NDRIVE(IOLUN),NSTATE,LENG)
         LENGTHF = (LENG+3)/4
         WAIT(IOLUN) = .FALSE.
      END IF
      RETURN
      END
      REAL FUNCTION UNIT(IOLUN)
C
C        NB:
C        THE 7600 VERSION OF UNIT ALLOWED A 4-WAY
C        BRANCH.  THE FIRST BRANCH WAS NEVER TAKEN
C        (IT REPRESENTED OPERATION NOT FINISHED).
C        SINCE 4-WAY BRANCHES ARE NON-STANDARD WE
C        HAVE SIMPLY OMITTED THE FIRST BRANCH CONDITION.
C        FOR 3-WAY BRANCHING, UNIT < 0.0 MEANS SUCCESS,
C                             UNIT = 0.0 MEANS EOF, AND
C                             UNIT > 0.0 MEANS ERROR.
C
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      EXTERNAL SS$_ABORT
      IF(FIRST(IOLUN))THEN
         TYPE *,'CALL TO UNIT PRECEDES FIRST TRANSFER'
         CALL SYS$EXIT(SS$_ABORT)
C        force load CFIRST
         CALL CFIRST
      END IF
      IF(NDRIVE(IOLUN).LT.0)THEN
C        disk
         UNIT = D_UNIT(IOLUN)
      ELSE
C        tape
         CALL T_WAIT(NDRIVE(IOLUN),NSTATE,LENG)
         UNIT = NSTATE - 1
         WAIT(IOLUN) = .FALSE.
      END IF
      RETURN
      END
      SUBROUTINE IOWAIT(IOLUN,NSTATE,NWDS)
C
C        NB:
C        NWDS IS ACTUALLY NUMBER OF BYTES
C        TO GET NUMBER OF WORDS USE LENGTHF
C
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      INTEGER*4 D_LEN
      EXTERNAL SS$_ABORT
      IF(FIRST(IOLUN))THEN
         TYPE *,'CALL TO IOWAIT PRECEDES FIRST TRANSFER'
         CALL SYS$EXIT(SS$_ABORT)
C        force load CFIRST
         CALL CFIRST
      END IF
      IF(NDRIVE(IOLUN).LT.0)THEN
C        disk
D        x = d_unit(iolun)
         NSTATE = D_UNIT(IOLUN) + 1.5
D        type *,'d_unit',x,nstate
         NWDS = D_LEN(IOLUN)
      ELSE
C        tape
         CALL T_WAIT(NDRIVE(IOLUN),NSTATE,NWDS)
         WAIT(IOLUN) = .FALSE.
      END IF
      RETURN
      END
      SUBROUTINE ENDFILE(IOLUN)
      CALL IOCLOS(IOLUN)
      RETURN
      END
      SUBROUTINE SKIPFILE(IOLUN)
C
C        NB:
C        ONLY WORKS ON TAPES
C
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      EXTERNAL SS$_ABORT
      N = 1
      GOTO 10
      ENTRY BACKFILE(IOLUN)
      N = -1
10    WRITE(IOLUN) = .FALSE.
      CALL CFIRST(IOLUN)
      IF(NDRIVE(IOLUN).LT.0)THEN
         TYPE *,'CAN''T SKIP DISK FILES'
         CALL SYS$EXIT(SS$_ABORT)
      END IF
C        if they didn't do a wait, insert one
         IF(WAIT(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
      CALL T_SKPF(NDRIVE(IOLUN),N)
         WAIT(IOLUN) = .TRUE.
      RETURN
      END
      SUBROUTINE SKIPSPACE(IOLUN)
C
C        NB:
C        FOR THE MOMENT ONLY WORKS ON TAPES
C
      COMMON/IOPACK/FIRST(20),WRITE(20),NDRIVE(20),WAIT(20)
      COMMON/IOPAKC/LUNAME(20)
      LOGICAL FIRST,WRITE,WAIT
      CHARACTER*2 LUNAME
      EXTERNAL SS$_ABORT
      N = 1
      GOTO 10
      ENTRY BACKSPACE(IOLUN)
      ENTRY BSTAPE(IOLUN,MODE)
      N = -1
10    WRITE(IOLUN) = .FALSE.
      CALL CFIRST(IOLUN)
      IF(NDRIVE(IOLUN).LT.0)THEN
         TYPE *,'CAN''T SKIP DISK RECORDS FOR NOW'
         CALL SYS$EXIT(SS$_ABORT)
      END IF
C        if they didn't do a wait, insert one
         IF(WAIT(IOLUN))CALL T_WAIT(NDRIVE(IOLUN),M,MM)
      CALL T_SKPR(NDRIVE(IOLUN),N)
         WAIT(IOLUN) = .TRUE.
      RETURN
      END