PROGRAM TAR
C PROGRAM TO READ UNIX TAR TAPES WITH SOME INPUT
C FORMAT RESTRICTIONS AND ASSUMPTIONS ABOUT FILE
C NAMES ON INPUT. BY BCZ.
	BYTE Z(512),A(132),FILNAM(14),TAPNAM(8)
	CHARACTER*11 TESTIT
	CHARACTER*8 DMONAM
	INTEGER*4 ISTAT,SYS$MOUNT,SYS$DISMOU
	INTEGER*2 ITMBUF(2)
	INTEGER*4 ITMLIS(15),TEMP,FLAGS,BUFSIZ,RECSIZ
	LOGICAL FLAG1,FLAG2,FLAG3,FLAG4
	EQUIVALENCE (TEMP,ITMBUF)
	EQUIVALENCE (DMONAM,TAPNAM)
	EQUIVALENCE (TESTIT,Z(125))
	DATA TAPNAM/8*0/
	INCLUDE '($MNTDEF)'
	INCLUDE '($DMTDEF)'
	WRITE(6,2)
 2	FORMAT(' ENTER TAPE DRIVE (MTA0: OR MTA1:) ==> ',$)
	READ(5,4)NKNT,(TAPNAM(I),I=1,7)
 4	FORMAT(Q,7A1)
	IF(NKNT.GT.7)GO TO 2000
	BUFSIZ=10240
	RECSIZ=512
	FLAGS=(MNT$M_FOREIGN.OR.MNT$M_NOASSIST.OR.
     1MNT$M_NOWRITE.OR.MNT$M_OVR_ACCESS)
	ITMBUF(2)=MNT$_DEVNAM
	ITMBUF(1)=8
	ITMLIS(1)=TEMP
	ITMLIS(2)=%LOC(TAPNAM(1))
	ITMLIS(3)=0
	ITMBUF(2)=MNT$_FLAGS
	ITMBUF(1)=4
	ITMLIS(4)=TEMP
	ITMLIS(5)=%LOC(FLAGS)
	ITMLIS(6)=0
	ITMBUF(2)=MNT$_BLOCKSIZE
	ITMLIS(7)=TEMP
	ITMLIS(8)=%LOC(BUFSIZ)
	ITMLIS(9)=0
	ITMBUF(2)=MNT$_RECORDSIZ
	ITMLIS(10)=TEMP
	ITMLIS(11)=%LOC(RECSIZ)
	ITMLIS(12)=0
	ITMLIS(13)=0
	ITMLIS(14)=0
	ITMLIS(15)=0
	ISTAT=SYS$MOUNT(%REF(ITMLIS))
	IF(.NOT.ISTAT)CALL LIB$STOP(%VAL(ISTAT))
	OPEN(UNIT=1,NAME=TAPNAM,TYPE='OLD')
	OPEN(UNIT=3,NAME='TAPEDIR.TAR',TYPE='NEW')
	FLAG1=.FALSE.
	FLAG2=.FALSE.
	FLAG3=.FALSE.
	FLAG4=.FALSE.
	ICHEC=0
	FILNAM(14)=0
 10	READ(1,12,END=1000)(Z(I),I=1,512)
 12	FORMAT(512A1)
	IF(FLAG1)GO TO 60
 15	DO 20 ITMP=512,1,-1
	IPOINT=ITMP
	IF(Z(ITMP).EQ.'/')GO TO 30
 20	CONTINUE	
	IPOINT=0
 30	FLAG1=.TRUE.
	IF(Z(IPOINT+1).NE.0) GO TO 40
	FLAG1=.FALSE.
	GO TO 10
 40	NTMP=0
	DO 45 ITMP=1,13
	FILNAM(ITMP)=0
	IF(FLAG2)GO TO 45
	IF(ICHEC.GE.3)GO TO 45
	IF(Z(IPOINT+ITMP).EQ.0)GO TO 45
	NTMP=NTMP+1
	FILNAM(NTMP)=Z(IPOINT+ITMP)
C MUNGE FILENAME UP FROM UNIX TO MAKE A VALID VMS (V3 STYLE)
C OR RSX FILESPEC.
	IF(.NOT.FLAG3.AND.FILNAM(NTMP).EQ.'.')GO TO 43
	IF(FILNAM(NTMP).LT.'0'.OR.FILNAM(NTMP).GT.'z')FILNAM(NTMP)='0'
	IF(FILNAM(NTMP).GT.'9'.AND.FILNAM(NTMP).LT.'A')FILNAM(NTMP)='0'
	IF(FILNAM(NTMP).GT.'Z'.AND.FILNAM(NTMP).LT.'a')FILNAM(NTMP)='0'
	IF(FLAG3)ICHEC=ICHEC+1
 43	IF(Z(IPOINT+ITMP).EQ.'.')FLAG3=.TRUE.	
	IF(.NOT.FLAG3.AND.NTMP.EQ.10)FLAG2=.TRUE.
	IF(.NOT.FLAG2)GO TO 45
	FILNAM(NTMP)='.'
 45	CONTINUE
	  IF(.NOT.FLAG2.AND..NOT.FLAG3)THEN
		NTMP=NTMP+1
		FILNAM(NTMP)='.'
	  ENDIF
	FLAG2=.FALSE.
	FLAG3=.FALSE.
	FLAG4=.FALSE.
	ICHEC=0
	DECODE (11,47,TESTIT,ERR=1000) NCHECK
 47	FORMAT(1O11)
	WRITE(3,42)(Z(I),I=1,IPOINT+14)
 42	FORMAT(1X,132A1:)
	WRITE(6,48)(FILNAM(I),I=1,NTMP)
 48	FORMAT(' File ',<NTMP>A1,' created.')
	OPEN(UNIT=2,NAME=FILNAM,TYPE='NEW')
	NCOUNT=0
	MCOUNT=0
	ICOUNT=0
	GO TO 10
 60	DO 100 ITMP=1,512
	IF(MCOUNT.EQ.NCHECK)GO TO 100
	MCOUNT=MCOUNT+1
	IF(Z(ITMP).NE.10.AND.ICOUNT.LT.132)GO TO 70
	IF(ICOUNT.EQ.0)GO TO 65
	IF(ICOUNT.LT.132)GO TO 63
	FLAG4=.TRUE.
	NCOUNT=NCOUNT+1
 63	CONTINUE
	WRITE(2,865)(A(I),I=1,ICOUNT)
 865	FORMAT(' ',512A1:)
	ICOUNT=0
	GO TO 100
 65	CONTINUE
	WRITE(2,965)
 965	FORMAT(' ')	
	GO TO 100
 70	ICOUNT=ICOUNT+1
	A(ICOUNT)=Z(ITMP)
	IF(A(ICOUNT).EQ.8)ICOUNT=ICOUNT-2
	IF(A(ICOUNT).EQ.0)ICOUNT=ICOUNT-1
 100	CONTINUE
	IF(MCOUNT.NE.NCHECK)GO TO 10
 	IF(FLAG4)WRITE(3,110)(FILNAM(I),I=1,14),NCOUNT
 110	FORMAT(5X,'FILE ',14A1,' HAD ',1I2,' RECORDS WRAPPED')
	CLOSE (UNIT=2)
	FLAG1=.FALSE.
	GO TO 10
 1000	CONTINUE
	IF(ICOUNT.NE.0)WRITE(2,865)(A(I),I=1,ICOUNT)
	CLOSE (UNIT=3)
	CLOSE (UNIT=2)
	CLOSE (UNIT=1)
	ISTAT=SYS$DISMOU(DMONAM,)
	IF(.NOT.ISTAT)CALL LIB$STOP(%VAL(ISTAT))
	GO TO 2020
 2000	WRITE(6,2010)
 2010	FORMAT(' ERROR IN DEVICE SPECIFICATION.')
 2020	CONTINUE
	CALL EXIT
	END