C..   XEROX.FTN   BOHDEN K. CMAYLO   OCT 81
C..
C..  PROGRAM TO BUILD XEROX JCL + ASDD AFTER MASTER TAPE.
C..
	BYTE JDATA(8096)
      DIMENSION XJDATA(2),IST(2),IR(6)
	EQUIVALENCE (XJDATA,JDATA)
	DATA XEOF/'90:S'/
      DATA MM,MMREAD,MMWRIT,MMREW,MMREWU,MMEOF,MMATT,MMSPF,MMSTC,MMSEC
     1 /'MM',"1000,"400,"2400,"2540,"3000,"1400,"2440,"2500,"2520/
	DATA IDENS/"4000/
	IQ=ISTXQT(JDATA)
	IF(IQ.GT.0) XEOF=XJDATA(1)
	TYPE 444,XEOF
444	FORMAT('0*** XEROX EOF MARK = ',A4/)
	IDISK=1
	TYPE 21
21	FORMAT('0*** XEROX 1200 COMMANDS TO TAPE TRANSFER ***'
     1//'$* ENTER INPUT XEROX COMMAND FILE NAME  ')
C..
C..	READ IN DISK NAME
C..
	ACCEPT 900,IQ,(JDATA(I),I=1,IQ)
900	FORMAT(Q,80A1)
	JDATA(IQ+1)=' '
	CALL ASSIGN(IDISK,JDATA)
	ITAPE1=2
24	TYPE 22
22	FORMAT(//'$* ENTER INPUT TAPE UNIT NUMBER (0 1) ')
	ACCEPT 23,MUNIT
23	FORMAT(I1)
	IERR=0
	IF(MUNIT.NE.0.AND.MUNIT.NE.1) IERR=1
      CALL ASNLUN(ITAPE1,MM,MUNIT,IDS)
      CALL WTQIO(MMATT,ITAPE1,6,50,IST,IR,IDS)
	IF(IST(1).NE.1) IERR=2
      IF(IST(1).NE.1) TYPE 901,MUNIT,IST
901   FORMAT('0*** ERROR *** ATTACH MM',I1,': = ',2O7)
801   FORMAT('0*** ERROR *** DENSITY MM',I1,': = ',2O7)
      CALL WTQIO(MMREW,ITAPE1,6,50,IST,IR,IDS)
	IF(IST(1).NE.1) IERR=3
      IF(IST(1).NE.1) TYPE 902,MUNIT,IST
902   FORMAT('0*** ERROR *** INITIAL MM',I1,' REWIND = ',2O7)
C**	CALL WTQIO(MMSPF,ITAPE1,6,50,IST,1,IDS)
C**	IF(ISE(1).NE.1) IERR=4
C**	IF(IST(1).NE.1) TYPE 903,MUNIT,IST
C**903	FORMAT('0*** ERROR *** INITIAL MM',I1,' SPACE FILE ERROR = ',2O7)
	ITAPE2=3
  	TYPE 222
222	FORMAT(//'$* ENTER OUTPUT TAPE UNIT NUMBER (0 1) ')
	ACCEPT 23,MUNITO
	IF(MUNITO.NE.0.AND.MUNITO.NE.1.OR.MUNIT.EQ.MUNITO) IERR=5
      CALL ASNLUN(ITAPE2,MM,MUNITO,IDS)
      CALL WTQIO(MMATT,ITAPE2,6,50,IST,IR,IDS)
	IF(IST(1).NE.1) IERR=6
      IF(IST(1).NE.1) TYPE 901,MUNIT,IST
      CALL WTQIO(MMREW,ITAPE2,6,50,IST,IR,IDS)
	IF(IST(1).NE.1) IERR=7
      IF(IST(1).NE.1) TYPE 902,MUNIT,IST
C..	SET DENSITY
	CALL WTQIO(MMSTC,ITAPE2,6,50,IST,IDENS,IDS)
	IF(IST(1).NE.1) TYPE 801,MUNIT,IST
	IF(IERR.NE.0) GO TO 99
      CALL GETADR(IR,JDATA)
C..
C..	READ FROM INPUT TAPE; WRITE ON OUTPUT TAPE
C..
333	IR(2)=8096
	CALL WTQIO(MMREAD,ITAPE1,6,50,IST,IR,IDS)
C..	CHECK FOR EOF
	LENG=IST(2)
	IR(2)=LENG
	IF(LENG.EQ.0) GO TO 1590
	XINPUT=XJDATA(1)
	CALL EBASCI(4,XINPUT)
C..	CHECK FOR XEOF
	IF(XINPUT.EQ.XEOF) GO TO 590
	CALL WTQIO(MMWRIT,ITAPE2,6,50,IST,IR,IDS)
	GOTO 333
C..
590	CONTINUE
      CALL WTQIO(MMREW,ITAPE1,6,50,IST,IR,IDS)
	IDREAD=0
95	CONTINUE
C..
C..	READ FROM DISK
C..
	READ(IDISK,76,END=1590)IQ,(JDATA(I),I=1,IQ)
76	FORMAT(Q,80(80A1))
	IF(IQ.EQ.0) GO TO 1590
	IDREAD=IDREAD+1
C..	CHECK IF LESS THAN 80
	IF(IQ.LT.80) CALL DOBYTE(JDATA(IQ+1),JDATA(80),' ')
C..	CONVERT TO EBASCI
	CALL EBASCI(-80,JDATA)
	IR(2)=80
C..	WRITE TO TAPE
      CALL WTQIO(MMWRIT,ITAPE2,6,50,IST,IR,IDS)
	GO TO 95
1590	CONTINUE
	IR(2)=0
C..	WRITE EOF
      CALL WTQIO(MMEOF,ITAPE2,6,50,IST,IR,IDS)
      CALL WTQIO(MMEOF,ITAPE2,6,50,IST,IR,IDS)
	TYPE 29,IDREAD
29	FORMAT('0* XEROX COMMAND READ AND TRANSFERED = ',I5)
      CALL WTQIO(MMREW,ITAPE2,6,50,IST,IR,IDS)
	CALL EXIT
99	TYPE 999
999	FORMAT('0*** ERROR HALT ***')
	CALL EXIT
	END