PROGRAM HPTAPE
C
C	PROGRAM HPTAPE IS USED FOR A QUICK TRANSFER OF DATA, SOURCE
C	FILES, OR ANY OTHER ASCII FILES TO TAPE TO BE READ BY A HP1000.
C	THE RECORDS ARE VARIABLE LENGTH AND DUE TO DEC TE16 PROBLEMS
C	ARE AT LEAST 14 BYTES LONG.  FOR TRANSFER TO THE INTEL MDS
C	SYSTEM THE RECORDS ARE AN EVEN NUMBER OF BYTES (0 FILLED).
C	THERE IS A SWITCH FOR PRODUCING CARD IMAGE RECORDS (80BYTES).
C	THE COMMAND LINE IS:
C		HPT MMn:=FILE[,FILE2,...][/D:1600][/C]
C	MORE THAN ONE FILE CAN BE PUT ON THE TAPE BY PUTTING THEM ON
C	THE COMMAND LINE.  A REWIND IS DONE AFTER ALL THE FILES ARE
C	TRANSFERED.  1600 DENSITY CAN BE SELECTED BY THE /D SWITCH.
C	UPTO 132 BYTE RECORDS CAN BE TRANSFERED, SO THAT LISTING FILES
C	CAN BE TRANSFERED TO THE HP HIGH SPEED PRINTER.
C	THIS PROGRAM REQUIRES THE TAPEIO MACRO ROUTINE.
C
C	THIS QUICK AND DIRTY PROGRAM WAS WRITTEN BY:
C
C	JEFF HAMILTON
C	E-SYSTEMS
C	P.O.BOX 1056
C	GREENVILLE, TEXAS  75401
C	(214)457-4175
C
C
	LOGICAL*1 CI,EOL
	DIMENSION ISTAT(2)
	BYTE MCRLIN(80),FILE(40),IBUF(200)
C
	IPOS=0
	CALL GETMCR(MCRLIN,IDS)
	CALL DRIVE(MCRLIN,IDS,CI)
10	CALL GETFIL(MCRLIN,IDS,IPOS,FILE,EOL)
	OPEN(UNIT=2,FILE=FILE,STATUS='OLD',READONLY,ERR=40)
15	DO 20,I=1,132
20	IBUF(I)=' '
	READ(2,1000,END=30)NCHRS,(IBUF(I),I=1,NCHRS)
	IF((NCHRS/2)*2.NE.NCHRS)NCHRS=NCHRS+1
	IF(NCHRS.LT.14)NCHRS=14
	IF(CI)NCHRS=80
	CALL TAPEIO(2,1,ISTAT,IBUF,NCHRS)	!WRITE BLOCK
	IF(ISTAT(1).EQ.1)GO TO 15
	WRITE(5,*)' HPT - WRITE ERROR'
	WRITE(5,1001)ISTAT(1)
	CALL EXIT(4)
30	CALL TAPEIO(5,1,ISTAT,,)		!EOF
	CLOSE(UNIT=2)
	IF(.NOT.EOL)GO TO 10
	CALL TAPEIO(10,1,ISTAT,,)		!RWOFF
	CALL EXIT(1)
40	WRITE(5,*)' HPT - FILE ERROR'
	CALL EXIT(4)
1000	FORMAT(Q,132A1)
1001	FORMAT(' I/O STATUS= ',O6)
	END
	SUBROUTINE DRIVE(LINE,LENGTH,CI)
	BYTE LINE(LENGTH)
	DIMENSION ISTAT(2)
	LOGICAL*1 CI
	CI=.FALSE.
	DO 10,I=1,LENGTH
	IF(LINE(I).EQ.'M')THEN
		IF(LINE(I+1).EQ.'M')THEN
			IF(LINE(I+2).EQ.':')IDRV=0
			IF(LINE(I+2).EQ.'0')IDRV=0
			IF(LINE(I+2).EQ.'1')IDRV=1
		END IF
	END IF
	IDENS=0
	IF(LINE(I).EQ.'/')THEN
		IF(LINE(I+1).EQ.'D'.AND.LINE(I+2).EQ.':'
	1	.AND.LINE(I+3).EQ.'1'.AND.LINE(I+4).EQ.'6'
	2	.AND.LINE(I+5).EQ.'0'.AND.LINE(I+6).EQ.'0')
	3	IDENS=2048
		IF(LINE(I+1).EQ.'C')CI=.TRUE.
	END IF
10	CONTINUE
	CALL ASNLUN(1,'MM',IDRV)
	CALL TAPEIO(3,1,ISTAT,,)		!REW
	IF(ISTAT(1).NE.1)THEN
		WRITE(5,*)' HPT - DRIVE ERROR'
		CALL EXIT(4)
	END IF
	CALL TAPEIO(6,1,ISTAT,IDENS,)		!DENSITY
	RETURN
	END
	SUBROUTINE GETFIL(LINE,LENGTH,IPOS,FILE,EOL)
	BYTE LINE(LENGTH)
	BYTE FILE(40)
	LOGICAL*1 EOL,UIC
	UIC=.FALSE.
	IF(IPOS.GT.1)GO TO 25
	DO 10,I=1,LENGTH
	IF(LINE(I).EQ.'=')GO TO 20
10	CONTINUE
	WRITE(5,*)' HPT - SYNTAX ERROR'
	CALL EXIT(4)
20	IPOS=I+1
25	DO 30,I=IPOS,LENGTH
	IF(LINE(I).EQ.'[')UIC=.TRUE.
	IF(LINE(I).EQ.']')UIC=.FALSE.
	IF(LINE(I).EQ.','.AND..NOT.UIC)GO TO 40
	FILE(I-IPOS+1)=LINE(I)
30	CONTINUE
	EOL=.TRUE.
40	FILE(I-IPOS+1)='0'O
	IPOS=I+1
	RETURN
	END