C_TITLE TPOPEN 3      SUBROUTINE TPOPEN(IFU,LUN,FNAME,LREC,LBUF,IR)C_ARGUMENTS   9      INTEGER*4 IFU     ![I] IFU is Fortran logical unit.P      INTEGER*4 LUN     ![I] LUN specifies tape drive (IGNORED ON SOME SYSTEMS).F      INTEGER*2 FNAME(3) ![I] 6 character ASCII logical name specified.                        !in the mount command.3      INTEGER*2 LREC    ![I] Logical Record length.N      INTEGER*2 LBUF    ![I] Physical record length, must be integral multiple!                        !of LREC.H      INTEGER*2 IREC(LREC) ![O] The array to receive the logical record.C      INTEGER*2 IBUF(LBUF) ![O] The buffer for the physical record.0      INTEGER*4 IR      ![O] Status return code.O                        !IR=0 OK, -1 EOF, greater than zero Fortran error code.C_DESCRIPTION OC  TPOPEN Opens a TAPE unit for unformatted read.  For an unlabelled multi-file4C  tape with fixed length blocked unspanned records.4C  To use this routine:  The VAX/VMS mount command: 2C  MOUNT/FOREIGN/BLKSIZE=LBUF TDRIVE tpname TPFILE1C  assumes drive 'TDRIVE', lun argument not used.C_CALLS NSKIPF,NRWD,A2AN    MC_HISTORY RMX 6/24/82 modified argument list 1/19/83  LOGICAL 'TDRIVE' 11/83.C_PAUSE      INTEGER*2 ZNAME(4) /4*0/C     INTEGER*2 MZERO /'8000'X/      SAVE KPTR,LREC2      CALL A2AN(FNAME,ZNAME,3)      LBUF4=(LBUF+1)/24      OPEN(IFU,FILE=ZNAME,STATUS='UNKNOWN',IOSTAT=IR9     1 ,FORM='UNFORMATTED',RECORDTYPE='FIXED',RECL=LBUF4)      KPTR=LBUF+1      LREC2=LREC      RETURN=C_TITLE TPREAD.  Routine to read a physical record from tape.)      ENTRY TPREAD(IFU,IREC,IBUF,LBUF,IR)AC_Description  TPREAD reads a physical record from the tape unit.C_HISTORY RMX 6/24/82.C_End       IF (KPTR.LE.LBUF) GO TO 20 C----Read a new block from tape.      READ (IFU,IOSTAT=IR) IBUF      IF (IR.NE.0) RETURN      KPTR=1&C----Transfer a logical record record.& 20   CALL A2AN(IBUF(KPTR),IREC,LREC2)GC  Check for internal end-of-file in data, (record of all minus zeros).C     DO 25 I=1,LREC2$C     IF (IREC(I).NE.MZERO) GO TO 26C25   CONTINUEC     IR=-1C     RETURNC----Not EOF, bump pointer. 26   KPTR=KPTR+LREC2
      IR=0      RETURN	      END%C_TITLE Routine to close a tape unit.      SUBROUTINE TPCLOS(IFU,IR)C_ARGUMENTS1      INTEGER*4 IFU ![I] Tape drive logical unit.'      INTEGER*4 IR  ![O] Output status.E                    !IR=0 then OK, Greater than 0 Fortran error code.'C_Description  Closes a tape unit file.C_HISTORY RMX 6/24/82.C_END      CLOSE (IFU,IOSTAT=IR)      RETURN	      END9C_TITLE  Skip N niles on device with logical unit of LUN.%      SUBROUTINE TPSKPF(LUN,NSKIP,IR)C_ARGUMENTS2      INTEGER*4 LUN   ![I] Logical unit of device.3      INTEGER*4 NSKIP ![I] Number of files to skip..      INTEGER*4 IR    ![O] Output status code..C TPSKPF: 0 OK  -1 EOT  >0 System error code. BC_DESCRIPTION  Skips N files on a tapedrive with Logical Unit LUN.C_HISTORY RMX 6/24/82.C File not open.C_END      JR=NSKIPF(LUN,NSKIP)
      IR=0      IF (JR.GT.0) IR=JR)      IF (JR.LT.0.AND.-JR.LT.NSKIP) IR=-1      RETURN	      END2C_TITLE TPRWND routine to rewind a tapedrive unit.&      SUBROUTINE TPRWND(LUN,UNLOAD,IR)C_ARGUMENTS2      INTEGER*4 LUN   ![I] Logical unit of device.L      LOGICAL UNLOAD  ![I] Logical flag, .TRUE. to unload tape, ELSE .FALSE..      INTEGER*4 IR    ![O] Output status code.G                      !IR=0 then OK, Greater than 0 Fortran error code.>C_DESCRIPTION Unloads a tape drive with a Logical Unit of LUN.C_HISTORY RMX 6/24/82.C_END      JR=NRWD(LUN,UNLOAD)
      IR=0      RETURN	      END