C      VTAPEIN - READ LABELED TAPES WITH VERIABLE RECORD LENGTHS
C
C      R. COUCH PRIME MARKETING SUPPORT N.Y.C.   03/28/85
C
C  *** Reads tapes created by:
C  ***    VAX with Unix using ANSITAR utility
C  ***    VAX with VMS  using the COPY utility
C  ***    DECSYSTEM-20 using the WRITEL program
C
C  *** These will come from VAX/VMSM, RSX-11 or RSTS/E sites
C
C  *** This routine is written to read tapes written as follows:
C
C  *** 9 Track, 1600 BPI
C
C  *** ANSI labels (each label is an 80-byte ASCII record)
C  *** Each label begins with a 4-char identifier, like VOL1,HDR1,EOF.,EOV1
C  *** Volume name is in columns 5-10 (Vol labels only at beginning of tape)
C  *** HDR1 - file name is in columns 5-21
C  *** HDR2 - column 5 is record format (F, D, or S) (I only work with D)
C  ***               6-10 block length (I use what they tell me from keyboard)
C  ***               1-15 record length (this program defaults to 300
C  ***                                   it doesn't matter anyway because
C  ***                                   this is a max record size)
C  *** There may be an EOF1 and EOF2 they are skipped
C  *** At the end of the tape there is supposed to be an EOV1 and EOV2
C  *** followed by a double tape mark.
C
C  *** Record Format "D":
C  *** Variable length records with a 4-digit ASCII length field at
C  *** the beginning of each record (the length includes the length field)
C  *** Line terminators are stripped, and there is no record crossing
C  *** a block boundry . The record may be padded at the end with 1, 2,
C  *** or 3 circumflex characters, which are not included in the field
C  *** length. (this programer did not know what the heck a circumflex
C  *** character was and did not take them into account. This routine
C  *** did however, work on the tape I had to test with.)
C  *** My spec called for block sizes of 2048, 4096, and 8192 characters
C  *** only, so this program only allows that selection. If there were
C  *** other block sizes to wory about simply allow that size to be entered.
C
C
         LOGICAL
     * OPEN$A,YSNO$A,CSTR$A,LSTR$A
C
C
         INTEGER
     * IUNIT,HRSIZE,READRC,STATUS(6),CODE,HAT,PUNIT,GCHR$A,
     * ZERO,GSTAT,TSTAT(6),TCODE,IBUF(4200),TCHAR,RLEN,MAXCHR,
     * I,J,K,L,OCTAL,TEXT,LSIZ(2),LBUF(150),EARY(152),FIXODD,
     * ESIZ,BUFPNT,RSIZ, DATASZ,FSTCHR,LSTCHR,FNAM(8),EOF,
     * NUNAM(9),NLEN,NLEN$A,RWIND,XCODE,GTPMRK,WDATSZ,JOBNO,
     * TSTNAM(8),TSTLEN,CKLEN,SKPREC
C
C
         INTEGER*4
     * BIGZRO
C
C
       EQUIVALENCE
     * (EARY(1),LSIZ(1)),
     * (EARY(3),LBUF(1)),
     * (IBUF(2),NUNAM(1)),
     * (IBUF(3),FNAM(1))
C
C
$INSERT SYSCOM>A$KEYS
$INSERT SYSCOM>ERRD.INS.FTN
C
C
       HRSIZE = 40   /* HEADER RECORD SIZE
       READRC = :042600   /* READ A RECORD (BLOCK)
       RWIND  = :000040   /* REWIND TAPE
       GSTAT  = :100000   /* GET TAPE STATUS (CAUSES A WAIT ON SEMIPHORE)
       GTPMRK = :022200   /* GET TAPE MARK
       SKPREC = :062200
       ZERO = 0
       BIGZRO = 0
       OCTAL = 7777
       TEXT = 0000
       HAT = '^ '
       EOF = 0
C
5      CONTINUE
       CALL TONL
       CALL TNOUA ('ENTER TAPE DRIVE #: ',20)
       READ (1,10,ERR=5) IUNIT
10     FORMAT (I2)
15     CONTINUE
       CALL TNOUA ('BLOCK SIZE (2048,4096 OR 8192 ONLY): ',37)
       READ (1,20,ERR=15) DATASZ
20     FORMAT (I4)
       WDATSZ = DATASZ / 2
       IF (DATASZ.NE.2048 .AND.
     *     DATASZ.NE.4096 .AND.
     *     DATASZ.NE.8192) GOTO 15
C
C  ***  REWIND TO BEGINNING OF TAPE
C  ***  READ THE VOLUME LABEL
C
       CALL T$MT (IUNIT,BIGZRO,ZERO,RWIND,TSTAT,TCODE)
C
C  *** DURING REWIND LET'S SEE WHAT HE WANT'S TO DO
C
70     CONTINUE
       JOBNO = 0  /* READ ALL FILES
       IF (YSNO$A('READ FULL TAPE ',15,A$NDEF)) GO TO 90
       JOBNO = 1  /* READ A SINGLE FILE
       IF (YSNO$A('READ A SINGLE FILE ',19,A$NDEF)) GOTO 80
       JOBNO = 2  /* READ ALL FILES CONTAINING STRING
       IF (YSNO$A('READ ALL FILES CONTAINING STRING ',33,A$NDEF))
     * GOTO 80
       GOTO 70
80     CONTINUE
       CALL TNOUA ('ENTER FULL NAME OR STRING (16 CHAR MAX): ',41)
       READ (1,85) TSTNAM
85     FORMAT (8A2)
       TSTLEN = NLEN$A (TSTNAM,16)
       IF (TSTLEN.EQ.0) GOTO 80
90     CONTINUE
       CALL T$MT (IUNIT,BIGZRO,ZERO,GSTAT,TSTAT,XCODE)
       IF (TCODE.NE.0) GOTO 9020
       CALL T$MT (IUNIT,LOC(IBUF),HRSIZE,READRC,STATUS,CODE) /* VOLUME HEADER
       CALL T$MT (IUNIT,BIGZRO,ZERO,GSTAT,TSTAT,TCODE)
C
C  *** READ THE HDR1 RECORD , TURN ON THE :200 BIT IN EACH CHARACTER
C  *** GET THE FILE NAME OUT OF COLUMNS 5-21, AND OPEN A SAM FILE OF
C  *** THAT NAME FOR WRITTING. (ON THE TAPE THAT I HAD SOME OF THE FILE
C  *** NAMES BEGAN WITH DIGITS, SO I INSERTED 'V.' IN FRONT OF THE NAME)
C
100    CONTINUE
       CALL T$MT (IUNIT,LOC(IBUF),HRSIZE,READRC,STATUS,CODE) /* HEADER
       CALL T$MT (IUNIT,BIGZRO,ZERO,GSTAT,TSTAT,TCODE)
       IF (AND(STATUS(2),:400).NE.0) GOTO 9500   /* MUST BE END OF VOLUME
       DO 1055 I = 1,50
       IBUF(I) = OR(IBUF(I),:100200)
1055    CONTINUE
       NUNAM(1) = 'V.'
       NLEN = NLEN$A(NUNAM,18)
       CKLEN = NLEN - 2
       CALL TNOU (FNAM,CKLEN)
       IF (JOBNO.EQ.0) GOTO 104  /* READ ALL FILES
       IF (JOBNO.NE.1) GOTO 103
       IF (CSTR$A(TSTNAM,TSTLEN,FNAM,CKLEN)) GOTO 104
       GOTO 375
103    CONTINUE
       IF (LSTR$A(TSTNAM,TSTLEN,FNAM,CKLEN,FSTCHR,LSTCHR))
     * GOTO 104
       GO TO 375
104    CONTINUE
       CALL TNOUA ('OPENING ',8)
       CALL TNOU (NUNAM,NLEN)
       IF (OPEN$A(A$WRIT+A$SAMF+A$GETU,NUNAM,NLEN,PUNIT)) GOTO 105
       CALL TNOUA ('CAN''T OPEN ',11)
       GOTO 9000
105    CONTINUE
C
C  *** DON'T CARE ABOUT BALANCE OF HEADER STUFF, SO SKIP TO NEXT TAPE
C  *** THIS IS THE ACTUAL DATA STUFF
C
110    CONTINUE
       CALL T$MT (IUNIT,BIGZRO,ZERO,GTPMRK,TSTAT,XCODE)
C
C  *** READ A BLOCK OF THE ACTUAL TAPE DATA, TURN ON THE :200 BIT
C  *** IN EACH CHARACTER
C
200    CONTINUE
       CALL T$MT (IUNIT,LOC(IBUF),WDATSZ,READRC,STATUS,CODE)
       CALL T$MT (IUNIT,BIGZRO,ZERO,GSTAT,TSTAT,TCODE)
       IF (STATUS(3).EQ.0) GOTO 300
       MAXCHR = STATUS(3) * 2 - 1
       DO 205 I = 1,WDATSZ
       IBUF(I) = OR(IBUF(I),:100200)
205    CONTINUE
       BUFPNT = 0
       FSTCHR = 1
       LSTCHR = 4
C
C  *** FIRST 4 CHAR OF EACH DATA RECORD AR THE RECORD LENGTH
C  *** IN CHARACTERS (THIS INCLUDES THE 4 CHAR).
C  *** MOVE THE RECORD OUT OF THE TAPE BUFFER INTO A LINE BUFFER
C  *** STUFF A SPACE AT THE END TO TAKE CARE OF ODD CHAR LENGTH RECORDS
C  *** WRITE IT TO THE DISK FILE, BUMP THE TAPE BUFFER POINTERS
C  *** IF LAST CHARA POINTER IS POINTING BEYOND NUMBER OF WORDS
C  *** READ IN THIS BLOCK WE ARE READY TO GET THE NEXT BLOCK
C
210    CONTINUE
       CALL MSUB$A (IBUF,DATASZ,FSTCHR,LSTCHR,LSIZ,4,1,4)
       DECODE (4,225,LSIZ,ERR=400) ESIZ
225    FORMAT (I4)
       IF (ESIZ.GT.304) GOTO 5000  /* LINE IS OUT OF RANGE
       LSTCHR = FSTCHR + ESIZ - 1
       CALL MSUB$A (IBUF,DATASZ,FSTCHR,LSTCHR,EARY,304,1,ESIZ)
       RSIZ = ESIZ - 4
       RLEN = (RSIZ + 1) / 2
       FIXODD = RSIZ + 1
       CALL MCHR$A (LBUF,FIXODD,' ',1)
       CALL WTLIN$ (PUNIT,LBUF,RLEN,CODE)
       IF (CODE.NE.0) GOTO 9010
       FSTCHR = FSTCHR + ESIZ
       LSTCHR = FSTCHR + 3
       IF (LSTCHR.GE.MAXCHR) GOTO 300
       GOTO 210
C  *** THE TAPE BUFFER IS NOW EMPTY, IF WE HAVEN'T READ A TAPE MARK
C  *** GO GET THE NEXT DATA BLOCK.
C  *** IF WE HAVE READ A TAPE MARK IT'S END OF FILE, SKIP THE END
C  *** FILE LABEL AND GO GET THE NEXT FILE
C
300    CONTINUE
       IF (AND(STATUS(2),:400).EQ.0) GOTO 200
325    CONTINUE
       CALL CLOS$A (PUNIT)
       IF (JOBNO.EQ.1) GOTO 9510
C
C  *** WE GO FORWARD ONE TAPE MARK HERE.
C  *** FRANKLY, I DON'T KNOW IF I'M SKIPPING THE TAPE MARK I READ
C  *** WHEN I TRIED TO GET THE NEXT DATA BLOCK OR IF I'M SKIPPING THE
C  *** THE 'EOF' RECORD, BUT IT SEEMS TO WORK.
C
350    CONTINUE    /* COME DIRECTLY HERE TO SKIP AN EOF RECORD
       CALL T$MT (IUNIT,BIGZRO,ZERO,GTPMRK,STATUS,CODE)
       CALL T$MT (IUNIT,BIGZRO,ZERO,GSTAT,TSTAT,XCODE)
       GOTO 100
375    CONTINUE    /* COME DIRECTLY HERE TO SKIP A FILE
C  *** SKIP HEADER TAPE MARK
       CALL T$MT (IUNIT,BIGZRO,ZERO,GTPMRK,STATUS,CODE) /* HEADER
       CALL T$MT (IUNIT,BIGZRO,ZERO,GSTAT,TSTAT,XCODE)
       CALL T$MT (IUNIT,BIGZRO,ZERO,GTPMRK,STATUS,CODE) /* DATA FILE
       CALL T$MT (IUNIT,BIGZRO,ZERO,GSTAT,TSTAT,XCODE)
       GOTO 350  /* GO SKIP THE TRAILER LABEL
C
400    CONTINUE
       WRITE (1,405) FSTCHR,MAXCHR
405    FORMAT ('POINTING AT CHAR#',I5,' READ',I5,' CHARS',/,
     *         'IF TAPE MARK GET NEXT FILE ELSE NEXT BLOCK')
       IF (AND(STATUS(2),:400).NE.0) GOTO 325
       GOTO 200
C
C
5000   CONTINUE
       WRITE (1,5005) ESIZ
5005   FORMAT ('THAT''S STUPID   RECORD SIZE CAN''T BE ',I5)
       STOP 200
C
C
9000   CONTINUE
       CALL EXIT
C
9010   CONTINUE
       WRITE (1,9015) CODE
9015   FORMAT ('ERROR',I6,' WRITTING DATA FILE')
       GOTO 9000
9020   CONTINUE
       IF (TCODE.NE.E$NASS) GOTO 9030
       CALL TNOU ('** TAPE NOT ASSIGNED **',23)
       CALL EXIT
9030   CONTINUE
       IF (TCODE.NE.E$BNWD) GOTO 9040
       CALL TNOU ('** BAD BLOCK SIZE **',20)
       CALL EXIT
9040   CONTINUE
       WRITE (1,9045) TCODE
9045   FORMAT ('TAPE ERROR -',I5)
       CALL EXIT
9500   CONTINUE
       CALL CLOS$A (PUNIT)
       CALL TONL
       CALL TNOU ('      *** END OF TAPE ***',25)
       CALL EXIT
9510   CONTINUE
       CALL TNOU ('FILE COMPLETE',13)
       CALL EXIT
       END