FTN4,L
      PROGRAM DSKET 
      EXTERNAL EXEC,ABREG 
      DIMENSION IBUF1(384) ,IPRAM(5),IBUF2(30),I(3) 
C 
C************************************************************** 
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS      * 
C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
C REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* 
C THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       * 
C************************************************************** 
C                   DATE CODE  3- 15-77 REV. 1709 
C 
C     THIS PROGRAM IS A DISKETTE FORMAT PROGRAM WHICH 
C     OPERATE WITH RTE DRIVER DVR33.
C     ***** W-A-R-N-I-N-G*****
C         FORMATING A TRACK(S) WILL DESTROY 
C         ANY DATA ON THE TRACK 
C     ************************
C 
C 
C     PICK TERMINAL LU
C 
      CALL RMPAR(IPRAM) 
C 
      IF (IPRAM)5,5,10
5     L=1 
      GOTO 20 
10    L=IPRAM 
20    WRITE(L,35) 
35    FORMAT("ENTER DRIVE LU?_")
C 
C 
      READ(L,*)I1 
75    WRITE(L,80) 
80    FORMAT("DO YOU REALLY WANT TO FORMAT THIS DISC?_")
C 
      READ(L,85)J3
85    FORMAT(A2)
      IF(J3-54505B)940,90,940 
C 
C     DETERMINE FORMAT TYPE 
C     1.STANDARD (4 FILL SECTORS) 
C     2.SERIAL (NO FILL SECTORS)
C 
C 
90    WRITE(L,92) 
92    FORMAT("STANDARD FORMAT?_") 
      READ(L,94)J3
94    FORMAT(A2)
      IF(J3-47117B)98,97,98 
97    K1=1
      GOTO 102
C Cu
98    IF(J3-54505B)940,100,940
100   K1=5
C 
C     RESET CONTROLLER
C 
102   CALL EXEC(3,I1) 
C 
C 
C 
C     ICOUN IS PHYSICAL TRACK 
C     M1 IS LOGICAL TRACK 
C 
C 
C 
C Cu
C     CALC. FORMAT ARRAY FOR TRACK ZERO 
C Cu
      GOTO 500
C 
C     M1 IS LOGICAL TRACK 
C     ICOUN IS PHYSICAL TRACK 
C 
110   M1=0
      ICOUN=0 
C 
C FOR TRACK 0 IBUF1 IS THE SAME AS IBUF2
C uu
114   DO 115 N=1,30 
115   IBUF1(N)=IBUF2(N) 
      GOTO 2000Ñ
C 
C uu
C     CALCULATE TRACK OFFSET (J1)  FOR TRACK M1 
C 
C     CALC NO. OF FILL SECTORS (NO. REV.-1) 
C 
116   J1=K1-1 
C 
C     MUST HAVE 4 MIN. FILL SECTORS 
C 
      IF(J1-4)120,122 
120   J1=4
122   N2=1
C 
C     N2 IS IBUF1 POINTER (CURRENT TRACK BUFFER)
C     J2 IS IBUF2 POINTER  (TRACK 0 BUFFER) 
C 
125   J2=30-J1*M1 
C 
C     ARRAY POINTER MUST BE >0
C 
      IF(J2-1)130,135 
130   J2=30+J2
      IF(J2-1)130,135 
135   IBUF1(N2)=IBUF2(J2) 
      N2=N2+1 
      J2=J2+1 
      IF(N2-31)140,200
140   IF(J2-31)135,145
145   J2=1
      GOTO 135
C 
300   IF(M2)310,305 
C 
C DO NOT INCREMENT LOGICAL  TRACK POINTER IF
C TRACK DEFECTIVE (M2 IS NEG.)
C uu
305   M1=M1+1 
C 
310   ICOUN=ICOUN+1 
      IF(ICOUN-67)320,330 
C 
C 
C     MOVE HEAD IN
C 
C 
320   CALL EXEC(2,2300B+I1,IBUF1(1),1,0,7600B)
C Cu
      GOTO 116
C 
C REPORT TOTAL NO. OF BAD TRACKS
C 
C 
C WRITE  (NUMBER GOOD TRACKS  ) IN WORD 1 
C OF TRACK 0 SECTOR 0 
C Cu
C WRITE NO. OF REV. IN WORD 2 
C 
C 
330   IBUF1(1)=M1 
      IBUF1(2)=K1 
      CALL EXEC(2,2300B+I1,IBUF1(1),2,0,7630B)
C 
C     FILL BUFFER WITH ZEROS
C 
      M1=M1-1 
      DO 410 N=1,384
410   IBUF1(N)=0
      DO 415 J=0,58,6 
415   CALL EXEC(2,I1,IBUF1(1),384,M1,J) 
C 
C     CREATE FILE DIRECTORY FOR CARTRIDEGE
C     "FORMAT"
C 
      IBUF1(1)=143117B
      IBUF1(2)=51115B 
      IBUF1(3)=40524B 
      IBUF1(4)=32760
      IBUF1(6)=2
      IBUF1(7)=60 
      IBUF1(8)=M1 
      IBUF1(9)=-1 
C Cu
C     CREATE ENTRY FOR FILE "FLOPLK"
C 
      IBUF1(17)=43114B
      IBUF1(18)=47520B
      IBUF1(19)=46113B
C 
      IBUF1(20)=1 
      IBUF1(23)=2 
      IBUF1(25)=-32767
      CALL EXEC(2,I1,IBUF1(1),128,M1,0) 
C 
      M1=M1+1 
      WRITE(L,335)M1
335   FORMAT("THE NO. OF GOOD TRACKS IS"  I6) 
      GO TO 950 
C 
C     FORMAT TRACK M1 
C 
200   CALL EXEC(2,2300B+I1,IBUF1(1),30,M1,0)
C 
C     SET DATA PATTERNS 
C 
      I(1)=033066B
      I(2)=155555B
      M2=0
      DO 230 M=1,2
C 
C FILL DATA BUFFER WITH TEST PATTERN
C 
      DO 210 N=1,384
210   IBUF1(N)=I(M) 
      DO 220 J=0,58,6 
C 
C WRITE DATA ON TRACK M1 SECTOR J 
C 
C IF TRACK 0,SECTOR 0 USE SPECIAL WRITE 
C 
      IF((M1+J)-1)215,219 
215   CALL EXEC(100002B,2300B+I1,IBUF1(1),384,M1,7630B) 
      GOTO 751
217   M123=1=
      GOTO 220
219   CALL EXEC(100002B,I1,IBUF1(1),384,M1,J) 
      GOTO 752
220   CONTINUE
C 
C READ DATA BACK
C 
      DO 230 J=0,58,6 
218   M123=1
225   ITRY=1
226   CALL EXEC(100001B,3000B+I1,IBUF1(1),384,M1,J) 
      GO TO 750 
247   CALL ABREG(IA,IB) 
C 
C     CHECK STATUS IN A REG.
C     RETRY ONCE IF ERROR 
C 
      IF(15400B-IA)233,228,233
233   IF(ITRY-2)227,250 
227   ITRY=ITRY+1 
      GOTO 226
C     CHECK  DATA  HERE 
C 
228   DO 230 N=1,384
      IF(IBUF1(N)-I(M))250,230,250
230   CONTINUE
C Cu
C 
      GOTO 300
C 
C WRITE A DEFECTIVE TRACK 
C 
250   CALL EXEC(2,2300B+I1,IBUF1(1),1,M1,7640B) 
      WRITE(L,255)ICOUN 
255   FORMAT("TRACK",I3,"  IS DEFECTIVE") 
      M2=-1 
      GO TO 300 
C 
C CALCULATE SECTOR ARRAY IBUF2
C 
500   K3=30/K1
      IBUF2(1)=0
      K4=1
      K2=2
510   K5=IBUF2(K2-1)+K3 
      IF(29-K5)520,540
520   IBUF2(K2)=K4
      K4=K4+1 
      GOTO 550
540   IBUF2(K2)=K5
550   K2=K2+1 
      IF(K2-31)510,570
570   GOTO 110
750   GOTO 247
751   GOTO 220
752   GOTO 220ÍÍ
C 
940   WRITE(L,941)
941   FORMAT("DSKET END") 
950   END 
      END$
                                                                                                                                                                                                  