From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  4-AUG-1989 15:48
To:	MRGATE::"ARISIA::EVERHART"
Subj:	RE: Reading IBM tapes on VAX - part 2 of 5

Message-Id:  <8908041508.AA26272@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Fri,  4 AUG 89 07:18:44 PDT
Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Fri, 4 Aug 89 07:09:00 PDT
Received: from NIHKLMB.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.1MX) with BSMTP id 8829; Fri, 04 Aug 89 10:03:16 EDT
Date: Fri, 4 Aug 89 09:55 EDT
From: Gerson H Cohen <GHC%NIHKLMB.BITNET@CUNYVM.CUNY.EDU>
Subject: RE: Reading IBM tapes on VAX - part 2 of 5
To: greg@HMCVAX.BITNET, INFO-VAX@KL.SRI.COM
X-Vms-To: IN%"greg@hmcvax",GHC,INFO-VAX,GHC

-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X; WILL CONTAIN THE RECORD SIZE (I*2) AND THE RECORD ATTRI-
X; BUTE BYTE (BYTE) IN THAT ORDER AFTER THE FILE IS OPENED.
X;
X`009.IDENT`009/01/
X`009$FABDEF
X`009$XABDEF
X`009.ENTRY`009GET_RAT_SIZ,`094M<>
X`009$OPEN`009FAB=@4(AP)
X`009BLBC`009R0,EXIT`009`009`009; IF ERROR, JUST QUIT
X`009MOVL`0094(AP),R0`009`009; GET ADDRESS OF FAB
X`009MOVL`009FAB$L_XAB(R0),R0`009; GET ADDRESS OF XAB, IF ANY
X1$:`009BEQLU`009ANY_HOW`009`009`009; IF ZERO, THERE WASN'T ANY
X`009CMPB`009#XAB$C_FHC,XAB$B_COD(R0) ; IS THE CODE RIGHT?
X`009BEQLU`009FOUND`009`009`009; IF EQUAL, GOOD.
X`009MOVL`009XAB$L_NXT(R0),R0`009; GET ADDRESS OF NEXT XAB
X`009BRB`0091$`009`009`009; AND TRY IT
XFOUND:`009MOVB`009XAB$B_ATR(R0),RAT`009; MOVE RECORD ATTRIBUTE BYTE
X`009MOVW`009XAB$W_LRL(R0),SIZ`009; MOVE MAX RECORD SIZE
XANY_HOW:`009`009`009`009; CONTINUE EVEN IF NO XAB
X`009$CONNECT RAB=@8(AP)
XEXIT:`009RET`009`009`009`009; RETURN
X`009.PSECT`009RATSIZ,WRT,GBL,NOEXE,LONG,SHR,OVR,PIC
XSIZ:`009.BLKW
XRAT:`009.BLKB
X`009.END
$ CALL UNPACK GETRATSIZ.MAR;19 710616556
$ create/nolog 'f'
X      LOGICAL FUNCTION INITAP
XCHANGES MADE 10-SEP-1981 ***
XC
XC      SUBROUTINE TO INITIALIZE 'TAPE' FOR INPUT OF AN IBM370 FB OR VBS
XC      TAPE. RETURNS THE VALUE TRUE IF THE INITIALIZATION WAS
XC      SUCCESSFULL OR FALSE IF IT WAS NOT.
XC
X      IMPLICIT INTEGER*2 (I-N)
X      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X     1 IFN(17),IVOL(6),TRAN,LAB,IEOF,FV
X      LOGICAL*1 IFN,TRAN,LAB,IEOF,IVOL,FV
X    1 FORMAT ('$TRANSLATE EBCDIC TO ASCII (T/F) ? ')
X    2 FORMAT (I5)
X    4 FORMAT (L1)
X    6 FORMAT ('$INPUT LRECL `09180`093 ')
X    7 FORMAT ('$INPUT BLKSIZE `091'I4,'`093 ')
X    8 FORMAT (' INPUT BLKSIZE IS NOT A MULTIPLE OF INPUT LRECL ***')
X   10 FORMAT (' INPUT BLKSIZE LIMITED TO 8000 ***')
X      CALL IRD370
X      initap = lunmt.ne.0
X      if (initap) then
X         IF (LAB) GO TO 70
X         FV = 'F'`009`009! IF UNLABELED, FORCE TO FIXED RECORDS
X         WRITE (LUNTT,1)
X         READ (LUNTT,4) TRAN
X         WRITE (LUNTT,6)
X         READ (LUNTT,2) ILRECL
X         IF (ILRECL .EQ. 0) ILRECL = 80
X         IBL = 4200/ILRECL*ILRECL`009!REASONABLE BLKSIZE
X         WRITE (LUNTT,7) IBL
X         READ (LUNTT,2) IBLKSZ
X         IF (IBLKSZ .EQ. 0) IBLKSZ = IBL
X   70    IF (MOD(IBLKSZ,ILRECL) .EQ. 0 .OR. FV.EQ.'V') GO TO 90
X         WRITE (LUNTT,8)
X         GO TO 95
X   90    IF (IBLKSZ .LE. 8000) GO TO 100
X         WRITE (LUNTT,10)
X   95    INITAP = .FALSE.
X         CALL SYS$CANCEL(%VAL(LUNMT))
X  100    IRC = IBLKSZ
X         IOSTAT(5) = IBLKSZ`009!IBLKSZ GETS MODIFIED IN RD370
X      end if
X      RETURN
X      END
$ CALL UNPACK INITAP.TAP;7 859269172
$ create/nolog 'f'
X      LOGICAL FUNCTION INIVBS
XCHANGES MADE 08-JAN-1980 ***
XC
XC      SUBROUTINE TO INITIALIZE 'TAPE' FOR INPUT OF AN IBM370 VBS
XC      TAPE. RETURNS THE VALUE TRUE IF THE INITIALIZATION WAS
XC      SUCCESSFULL OR FALSE IF IT WAS NOT.
XC
X      IMPLICIT INTEGER*2 (I-N)
X      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X     1 IFN(17),IVOL(6),TRAN,LAB,IEOF
X      LOGICAL*1 IFN,TRAN,LAB,IEOF,IVOL
X    2 FORMAT (I5)
X    7 FORMAT ('$INPUT BLKSIZE `0913156`093 ')
X    9 FORMAT (' BLKSIZE MUST BE A MULTIPLE OF 2 ***')
X   10 FORMAT (' INPUT BLKSIZE LIMITED TO 8000 ***')
X      CALL IRD370
X`009inivbs = lunmt.ne.0
X`009if (inivbs) then
X      IF (LAB) GO TO 80
X      WRITE (LUNTT,7)
X      READ (LUNTT,2) IBLKSZ
X      IF (IBLKSZ .EQ. 0) IBLKSZ = 3156`009!BEST BLKSIZE ON 3330 DISK
X   80 IF (MOD(IBLKSZ,2) .EQ. 0) GO TO 90
X      WRITE (LUNTT,9)
X      GO TO 95
X   90 IF (IBLKSZ .LE. 8000) GO TO 100
X      WRITE (LUNTT,10)
X   95 INIVBS = .FALSE.
X      CALL SYS$CANCEL(%VAL(LUNMT))
X  100 IRC = IBLKSZ
X      IOSTAT(5) = IBLKSZ`009!IBLKSZ IS MODIFIED IN RDVBS
X`009end if
X      RETURN
X      END
$ CALL UNPACK INIVBS.TAP;7 2017004628
$ create/nolog 'f'
X      LOGICAL FUNCTION INOTAP
XCHANGES MADE 10-DEC-1982 ***
XC
XC      SUBROUTINE TO INITIALIZE 'TAPE' FOR OUTPUT OF AN IBM370 FB
XC      OR FBA TAPE. RETURNS THE VALUE TRUE IF THE INITIALIZATION
XC      WAS SUCCESSFULL OR FALSE IF IT WAS NOT.
XC
X      IMPLICIT INTEGER*2 (I-N,O)
X      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X     1 IFN(17),IVOL(6),TRAN,LAB,IEOF
X      COMMON /GHCOTP/ ORC,OBC,OLRECL,OBLKSZ,OSTAT(4),OFN(17),
X     1 VNAME(6),OTRAN,OLAB,CC,ODEN,OEOF
X      LOGICAL*1 IFN,TRAN,LAB,IEOF,OFN,OTRAN,OLAB,CC,ODEN,OEOF,VNAME,IVOL
X      LOGICAL*1 A,BL
X      INTEGER*4 I
X      DATA A/"101/,BL/"40/
X    1 FORMAT ('$TRANSLATE ASCII TO EBCDIC (T/F) ? ')
X    2 FORMAT (I5)
X    4 FORMAT (L1)
X    6 FORMAT ('$OUTPUT LRECL `09180`093 ')
X    7 FORMAT ('$OUTPUT BLKSIZE `091'I4,'`093 ')
X    8 FORMAT (' OUTPUT BLKSIZE IS NOT A MULTIPLE OF OUTPUT LRECL ***')
X    9 FORMAT (' BLKSIZE MUST BE A MULTIPLE OF 2 ***')
X   10 FORMAT (' OUTPUT BLKSIZE LIMITED TO 8000 ***')
X   12 FORMAT (17A1)
X   13 FORMAT ('$DSNAME = ')
X   14 FORMAT ('$RECFM = (FBA/FB) `091FB`093 ')
X   15 FORMAT (2X,A1)
X      INOTAP = .TRUE.
X      CALL IWR370(I)
X      IF (OLAB) GO TO 30
X      WRITE (LUNTT,1)
X      READ (LUNTT,4) OTRAN
X      GO TO 40
X   30 WRITE (LUNTT,13)
X      READ (LUNTT,12) OFN
X      CALL STR$UPCASE(%DESCR(OFN),%DESCR(OFN))
X      WRITE (LUNTT,14)
X      READ (LUNTT,15) CC
X      CALL STR$UPCASE(%DESCR(CC),%DESCR(CC))
X      IF (CC .NE. A) CC = BL
X   40 WRITE (LUNTT,6)
X      READ (LUNTT,2) OLRECL
X      IF (OLRECL .EQ. 0) OLRECL = 80
X      OBL = 3156/OLRECL*OLRECL`009!BEST BLKSIZE ON 3330 DISK
X      WRITE (LUNTT,7) OBL
X      READ (LUNTT,2) OBLKSZ
X      IF (OBLKSZ .EQ. 0) OBLKSZ = OBL
X      IF (MOD(OBLKSZ,OLRECL) .EQ. 0) GO TO 80
X      WRITE (LUNTT,8)
X      GO TO 95
X   80 IF (MOD(OBLKSZ,2) .EQ. 0) GO TO 90
X      WRITE (LUNTT,9)
X      GO TO 95
X   90 IF (OBLKSZ .LE. 8000) GO TO 100
X      WRITE (LUNTT,10)
X   95 INOTAP = .FALSE.
X      CALL SYS$CANCEL(%VAL(LUNMT))
X      RETURN
X  100 IF (.NOT. OLAB) GO TO 120
X      IF (I .LE. 1) GO TO 110
X      DO 105 J=1,6
X  105 VNAME(J) = IVOL(J)
X      CALL WRTLBL(1,I)
X      GO TO 120
X  110 CALL WRTLBL(0,I)
X  120 ORC = 0
X      OEOF = .FALSE.
X      RETURN
X      END
$ CALL UNPACK INOTAP.TAP;7 289014573
$ create/nolog 'f'
X      LOGICAL FUNCTION INOVBS
XCHANGES MADE 10-DEC-1982 ***
XC
XC      SUBROUTINE TO INITIALIZE 'TAPE' FOR OUTPUT OF AN IBM370 VBS
XC      TAPE. RETURNS THE VALUE TRUE IF THE INITIALIZATION WAS
XC      SUCCESSFULL OR FALSE IF IT WAS NOT.
XC
X      IMPLICIT INTEGER*2 (I-N,O)
X      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X     1 IFN(17),IVOL(6),TRAN,LAB,IEOF
X      COMMON /GHCOTP/ ORC,OBC,OLRECL,OBLKSZ,OSTAT(4),OFN(17),
X     1 VNAME(6),OTRAN,OLAB,CC,ODEN,OEOF
X      LOGICAL*1 IFN,TRAN,LAB,IEOF,OFN,OTRAN,OLAB,CC,ODEN,OEOF,VNAME,IVOL
X      LOGICAL*1 V
X      INTEGER*4 I
X      DATA V/"126/
X    2 FORMAT (I5)
X    6 FORMAT ('$OUTPUT LRECL `0913152`093 ')
X    7 FORMAT ('$OUTPUT BLKSIZE `0913156`093 ')
X    9 FORMAT (' BLKSIZE MUST BE A MULTIPLE OF 2 ***')
X   10 FORMAT (' OUTPUT BLKSIZE LIMITED TO 8000 ***')
X   12 FORMAT (17A1)
X   13 FORMAT ('$DSNAME = ')
X      INOVBS = .TRUE.
X      CALL IWR370(I)
X      CC = V
X      IF (.NOT.OLAB) GO TO 80
X      WRITE (LUNTT,13)
X      READ (LUNTT,12) OFN
X      CALL STR$UPCASE(%DESCR(OFN),%DESCR(OFN))
X      WRITE (LUNTT,6)
X      READ (LUNTT,2) OLRECL
X      IF (OLRECL .EQ. 0) OLRECL = 3152
X   80 WRITE (LUNTT,7)
X      READ (LUNTT,2) OBLKSZ
X      IF (OBLKSZ .EQ. 0) OBLKSZ = 3156`009!BEST BLKSIZE ON 3330 DISK
X      IF (MOD(OBLKSZ,2) .EQ. 0) GO TO 90
X      WRITE (LUNTT,9)
X      GO TO 95
X   90 IF (OBLKSZ .LE. 8000) GO TO 100
X      WRITE (LUNTT,10)
X   95 INOVBS = .FALSE.
X      CALL SYS$CANCEL(%VAL(LUNMT))
X      RETURN
X  100 IF (.NOT. OLAB) GO TO 120
X      IF (I .LE. 1) GO TO 110
X      DO 105 J=1,6
X  105 VNAME(J) = IVOL(J)
X      CALL WRTLBL(1,I)
X      GO TO 120
X  110 CALL WRTLBL(0,I)
X  120 ORC = 4
X      OEOF = .FALSE.
X      RETURN
X      END
$ CALL UNPACK INOVBS.TAP;7 1933140187
$ create/nolog 'f'
X      SUBROUTINE IRD370
XCHANGES MADE 15-JAN-1980 ****
XC
XC      SUBROUTINE TO ASSIGN, REWIND AND POSITION 'TAPE'.
XC
X      IMPLICIT INTEGER*2 (I-N)
X      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X     1 IFN(17),IVOL(6),TRAN,LAB,IEOF
X      LOGICAL*1 IFN,TRAN,LAB,IEOF,IVOL
X      INTEGER*4 I,sys$assign
X      DATA IORWD/'24'X/,IOSPF/'25'X/
X    2 FORMAT ('$INPUT FILE # `0911`093 ')
X    3 FORMAT ('$LABELED TAPE (T/F) ? ')
X    4 FORMAT (L1)
X    5 FORMAT (I5)
XC`009ASSIGN CHANNEL TO LOGICAL DEVICE 'TAPE':
X      if (SYS$ASSIGN('TAPE',LUNMT,,)) then
XC`009REWIND 'TAPE':
X      CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IORWD),,,,,,,,,)
X      WRITE (LUNTT,3)
X      READ (LUNTT,4) LAB
X      TRAN = LAB
X      WRITE (LUNTT,2)
X      READ (LUNTT,5) I
X      IF (LAB) GO TO 30
X      IF (I .GT. 1) CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOSPF),,,,%VAL(I-1),
X     1 ,,,,)
X      RETURN
X   30 CALL RDLBL(0)
X      IF (I .LE. 1) RETURN
X      DO 40 J = 2,I
X      CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOSPF),,,,%VAL(1),,,,,)
X      CALL RDLBL(2)
X   40 CALL RDLBL(1)
X`009end if
X      RETURN
X      END
$ CALL UNPACK IRD370.TAP;9 503676270
$ create/nolog 'f'
X`009SUBROUTINE IWR370(I)
XCHANGES MADE 10-DEC-1982 ***
XC
XC`009SUBROUTINE TO ASSIGN, REWIND AND POSITION 'TAPE'.
XC
X`009IMPLICIT INTEGER*2 (I-N,O)
X`009COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X`0091 IFN(17),IVOL(6),TRAN,LAB,IEOF
X`009COMMON /GHCOTP/ ORC,OBC,OLRECL,OBLKSZ,OSTAT(4),OFN(17),
X`0091 VNAME(6),OTRAN,OLAB,CC,ODEN,OEOF
X`009BYTE IFN,TRAN,LAB,IEOF,OFN,OTRAN,OLAB,CC,ODEN,OEOF,VNAME,IVOL
X`009INTEGER*4 I,SETCHAR(2),DENVAL
X`009INTEGER*4 MT$V_DENSITY,MT$K_NRZI_800,MT$V_PE_1600
X`009DATA IORWD/'24'X/,IOSTC/'23'X/,SETCHAR/2*0/,IOSPF/'25'X/
X`009DATA MT$V_DENSITY/8/,MT$K_NRZI_800/3/,MT$K_PE_1600/4/
X1`009FORMAT ('$1600BPI TAPE (T/F) ? ')
X2`009FORMAT ('$OUTPUT FILE # `0911`093 ')
X3`009FORMAT ('$LABELED TAPE (T/F) ? ')
X4`009FORMAT (L1)
X5`009FORMAT (I5)
X6`009FORMAT ('$VOLUME = SER = ')
X7`009FORMAT (6A1)
X8`009FORMAT (' VOLUME = SER = '6A1)
XC`009ASSIGN CHANNEL TO LOGICAL DEVICE 'TAPE':
X`009CALL SYS$ASSIGN('TAPE',LUNMT,,)
XC`009REWIND MT0:
X`009CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IORWD),,,,,,,,,)
X`009WRITE (LUNTT,1)
X`009READ (LUNTT,4) ODEN
XC`009SET TAPE DENSITY
X`009IF (ODEN) THEN
X`009ODEN = 3
X`009DENVAL = MT$K_PE_1600
X`009ELSE
X`009ODEN = 2
X`009DENVAL = MT$K_NRZI_800
X`009END IF
X`009SETCHAR(2) = ISHFT(DENVAL,MT$V_DENSITY)
X`009CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOSTC),,,,SETCHAR,,,,,)
X`009WRITE (LUNTT,3)
X`009READ (LUNTT,4) OLAB
X`009WRITE (LUNTT,2)
X`009READ (LUNTT,5) I
X`009LAB = OLAB
X`009TRAN = LAB
X`009OTRAN = OLAB
X`009IF (OLAB) GO TO 50
X`009IF (I .GT. 1) CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOSPF),,,,%VAL(I-1),
X`0091 ,,,,)
X`009RETURN
X50`009IF (I .GT. 1) GO TO 60
X`009WRITE (LUNTT,6)
X`009READ (LUNTT,7) VNAME
X`009CALL STR$UPCASE(%DESCR(VNAME),%DESCR(VNAME))
X`009RETURN
X60`009CALL RDLBL(0)
X`009WRITE (LUNTT,8) IVOL`009!TELL THE NAME ON THE VOL1 LABEL
X`009DO 70 J = 2,I
X`009IF (J .GT. 2) CALL RDLBL(1)
X`009CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOSPF),,,,%VAL(1),,,,,)
X70`009CALL RDLBL(2)
X`009RETURN
X`009END
$ CALL UNPACK IWR370.TAP;12 173226936
$ create/nolog 'f'
X       PROGRAM MLTAPE
XCHANGES MADE 06-Aug-1982 ***
XC
X      IMPLICIT INTEGER*2 (I-N)
X      parameter mxix=10000
X      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X     1 IFN(17),IVOL(6),TRAN,LAB,IEOF,FV
X      LOGICAL*1 IFN,TRAN,LAB,IEOF,IVOL,FV
X      integer*2 record(2*mxix+4)
X      BYTE INIVBS
X      CHARACTER NAME*120,BLANK,C
X      INTEGER*4 L
X      integer*4 nat3,istep
X      equivalence (record(3),nat3),(record,istep)
X      DATA BLANK/' '/
XC
X    1 FORMAT ('$NAME OF OUTPUT FILE: ')
X    2 FORMAT (I10)
X    4 FORMAT (L1)
X    6 FORMAT ('$NAME OF OUTPUT FILE `091'17A1,'`093 ')
X    7 FORMAT (A)
X   10 FORMAT (I10,' RECORDS PROCESSED.')
X   11 FORMAT (' OUTPUT FILE IS NAMED: 'A)
XC
X      L = 0
X      LUNTT = 1
X      lundsk = 3
X      OPEN (UNIT=LUNTT,FILE='TT',STATUS='UNKNOWN')
X      IFN(1) = 0
X      IF (.NOT.INIVBS(0)) STOP 'CAN`096T INIT TAPE'
X      IF (FV.NE.'V') STOP 'HORRORS,  not V?'
X      LRECO = ILRECL
X      IF (IFN(1) .NE. 0) THEN
X         WRITE (LUNTT,6) IFN
X      ELSE
X         WRITE (LUNTT,1)
X      END IF
X      READ (LUNTT,7) NAME
X      IF (NAME(1:1) .EQ. BLANK) THEN
X         IF (IFN(1).EQ.0) THEN
X            NAME ='MLTAPE.OUT'
X         ELSE
X            NAME = BLANK
X            I = 1
X            DO WHILE (I.LE.17 .AND. IFN(I).NE.0)
X               NAME(I:I) = CHAR(IFN(I))
X               I = I + 1
X            END DO
X         END IF
X      END IF
X      OPEN (UNIT=lundsk,FILE=NAME,STATUS='NEW',
X     1            form='unformatted')
X      INQUIRE (UNIT=lundsk,NAME=NAME)
X      WRITE (LUNTT,11) NAME(:INDEX(NAME,BLANK)-1)
XC NOW BEGIN TO PROCESS
XC NEXT CALL IS TO READ A RECORD
X      DO WHILE (.TRUE.)
X         CALL RDVBS(record)
Xc`009type *,(record(i),i=1,10)
X         LRECM = ILRECL
X         IF (IEOF) GO TO 100
X         L = L + 1
X         call i4v(record,2)
Xc`009type *,'istep=',istep,', nat3=',nat3
X         if (nat3.gt.mxix) then
X            type *,'nat3=',nat3,'which is too large.'
X            stop 'dimension error'
X         end if
X          call i2v(record(5),nat3)
Xc`009type *,istep,nat3,ilrecl
X      write (lundsk) (record(i),i=1,nat3+4)
X      END DO
XC CLOSE UP OPERATIONS!
X  100 CALL TAPTRM
X      CLOSE (UNIT=lundsk)
X      WRITE (LUNTT,10) L
X      CALL EXIT
X      END
X      SUBROUTINE RDLBL(MODE)
XCHANGES MADE 10-SEP-1981 ***
XC
XC      SUBROUTINE TO READ AND VERIFY STANDARD IBM TAPE LABELS, BOTH
XC      HEADER AND TRAILER LABELS ARE INCLUDED. VERIFICATION IS LIMITED
XC      TO CHECKING THE FIRST FOUR CHARACTERS OF EACH RECORD. IN`032
XC      ADDITION THE ROUTINE GETS THE LRECL AND BLKSIZE FROM HDR2, THE
XC      FILENAME FROM HDR1, THE TOTAL BLOCK COUNT FROM EOF1, THE
XC      VOLUME SERIAL IS READ FROM VOL1 AND IT IS RECORDED IF THE
XC      FILE HAS FIXED OR VARIABLE BLOCKS.
XC
X      IMPLICIT INTEGER*2 (I-N)
X      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X     1 IFN(17),IVOL(6),TRAN,LAB,IEOF,FV
X      LOGICAL*1 IFN,TRAN,LAB,IEOF,IVOL,FV
X      LOGICAL*1 BL,IREAD(80)
X      EQUIVALENCE (TEST,IREAD(1))
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-

