	PROGRAM IOFMT
C
C RUN UNDER RT11, WILL NOT WORK UNDER TSX
C
C THE COMMAND BLOCK
	COMMON/CMDBLK/CMD,B,CCMD,C,CCCMD,CC
	BYTE CMD,B(5),CCMD,C(5),CCCMD,CC(5)

	BYTE BUF(512),ANS,IR(2)
	DIMENSION YN(2)

C FORMAT COMMAND
	DATA CMD,B/4,"26,4*0/
	DATA CCMD,C/"200,"304,2,3*0/

C SENSE COMMAND
	DATA CCCMD,CC/3,0,0,0,13,0/

	DATA YN/'ON','OFF'/
	EQUIVALENCE (ICSR,IR)
C
1	TYPE 2
2	FORMAT('0Do you have 1)Alpha 10 or 2)Alpha 10.5: ',$)
	READ(5,10,ERR=1)IOMEGA
	IF(IOMEGA.LT.1 .OR. IOMEGA.GT.2)GO TO 1
C
4	TYPE 5
5	FORMAT('0Enter unit to format (0 OR 1): ',$)
	READ(5,10,ERR=4)IU
10	FORMAT(I1)
	IF(I.LT.0 .OR. I.GT.1)CALL EXIT

	CC(1)=IU*32
C
C DO TWICE BECAUSE FIRST TIME WILL MOST LIKELY GIVE A MEDIA CHANGED ERROR
C
	DO 490 I=1,2
	CALL IPOKE("177466,IADDR(CCCMD))
	CALL IPOKE("177464,IADDR(BUF))
	CALL IPOKE("177470,0)
	CALL IPOKE("177472,0)
	CALL IPOKE("177462,1)
400	ICSR=IPEEK("177462)
	IF(IR(1).GE.0)GO TO 400
	IF(ICSR.GE.0)GO TO 450
490	CONTINUE
	PAUSE 'IO ERROR'
	GO TO 1
450	CONTINUE
C
	IV=BUF(10).AND."77
	IE=BUF(10).AND."377
	IE=IE/64
	IW=IE/2
	IE=IE.AND.1
	IE=IE+1
	IW=IW.AND.1
	IW=IW+1
	IDWC=BUF(11)
C
	TYPE 460,IV,YN(IE),YN(IW),IDWC
460	FORMAT('0INTERLEAVE = ',I5,/,' ECC LOGIC = ',A4,/,
	1 ' READ AFTER WRITE LOGIC = ',A4,/,' DWELL COUNT = ',I5)
C
	B(1)=IU*32+"26
C
	GO TO (20,26) IOMEGA
C
20	TYPE 21
21	FORMAT('0ENTER INTERLEAVE (1,2,4,8,16,32): ',$)
	READ(5,25,ERR=20)IV
25	FORMAT(I2)
	IF(IV.NE.1 .AND. IV.NE.2 .AND. IV.NE.4 .AND. IV.NE.8
	1 .AND. IV.NE.16 .AND. IV.NE.32)GO TO 20
	GO TO 30
C
26	TYPE 27
27	FORMAT('0ENTER INTERLEAVE (1,2,4,17,34): ',$)
	READ(5,25,ERR=26)IV
	IF(IV.NE.1 .AND. IV.NE.2 .AND. IV.NE.4
	1 .AND. IV.NE.17 .AND. IV.NE.34)GO TO 26
C
30	TYPE 31
31	FORMAT('0ENTER POST WRITE CHECK (0=ENABLE,1=DISABLE): ',$)
	READ(5,10,ERR=30)IW
	IF(IW.LT.0 .OR. IW.GT.1)GO TO 30

40	TYPE 41
41	FORMAT('0ENTER ECC LOGIC (0=ENABLE,1=DISABLE): ',$)
	READ(5,10,ERR=40)IE
	IF(IE.LT.0 .OR. IE.GT.1)GO TO 40
C
	I=IV+IE*64+IW*128
	C(1)=I
C
50	TYPE 51
51	FORMAT
	1('0ENTER DWELL TIMER COUNT (1 COUNT=2.5 MINS. 15=NO TIMEOUT)',
	2 ' (2-12,15): ',$)
	READ(5,25,ERR=50)IDWC
C
	C(2)=IDWC
C
60	TYPE 61
61	FORMAT('0DO YOU WISH TO FORMAT? ',$)
	READ(5,65)ANS
65	FORMAT(A1)
	IF(ANS.NE.'Y')CALL EXIT
C
	CALL IPOKE("177466,IADDR(CMD))
	CALL IPOKE("177464,IADDR(CCMD))
	CALL IPOKE("177470,0)
	CALL IPOKE("177472,0)
	CALL IPOKE("177462,1)
100	ICSR=IPEEK("177462)
	IF(IR(1).GE.0)GO TO 100
	IF(ICSR.LT.0)PAUSE 'FORMAT ERROR'
	IF(ICSR.LT.0)GO TO 1
C
	TYPE 105
105	FORMAT('0CONTINUE PROGRAM ONLY IF AFTER BAD BLOCK SCAN YOU',
	1 ' FIND BAD BLOCKS',/,'0DO YOU WISH TO CONTINUE? ',$)
	READ(5,65)ANS
	IF(ANS.NE.'Y')CALL EXIT
	TYPE 120
120	FORMAT('0BEGINNING VERIFY')
C
500	IER=0
	JEND=19584
	IF(IOMEGA.EQ.2)JEND=20501

	DO 200 I=1,JEND
210	CONTINUE
	CALL IPOKE("177464,IADDR(BUF))
	CMD=8
	B(1)=IU*32
	B(4)=2
	B(5)=0
	J=I-1
	IF(MOD(J,100).EQ.0)TYPE 777,J
777	FORMAT(' BLOCK = ',I5)
	ICSR=J*2
	B(2)=IR(2)
	B(3)=IR(1)

	CALL IPOKE("177466,IADDR(CMD))
240	CALL IPOKE("177462,1)
250	ICSR=IPEEK("177462)
	IF(IR(1).GE.0)GO TO 250
	IF(ICSR.GE.0)GO TO 200

	IER=1
260	TYPE 270,J,J
270	FORMAT('0ERROR WITH BLOCK ',I5,2X,O6,//,
	1 ' PLEASE LOOK AT LED FOR ERROR TYPE',//,
	2 ' 1)CONTINUE',/,' 2)RETRY',/,' 3)ASSIGN ALTERNATE SECTOR',
	3 /,' 4)ASSIGN ALTERNATE TRACK',//,'0ENTER CHOICE ',$)

	READ(5,280,ERR=260)IG
280	FORMAT(I1)
	IF(IG.LE.0 .OR. IG.GT.4)GO TO 260

	GO TO (200,210,310,320),IG
310	CONTINUE
	CCMD="100
	GO TO 330
320	CONTINUE
	CCMD="40
330	CONTINUE

	C(1)=0
	ICSR=J*2
	C(2)=IR(2)
	C(3)=IR(1)
	C(4)=0
	C(5)=0
	CMD=4
	B(1)=IU*32+"26
	CALL IPOKE("177466,IADDR(CMD))
	CALL IPOKE("177464,IADDR(CCMD))
	GO TO 240
200	CONTINUE
C
	IF(IER.NE.0)GO TO 500
C
	TYPE 110
110	FORMAT('0FORMAT COMPLETE')
	CALL EXIT
	END
