FTN4,L
      PROGRAM TXMV1(3,100),91711-16033  REV 2001  791024
C 
C 
C         *********************************************** 
C         *   SYSTEM AND PERIPHERAL DISC TEST PROGRAM   * 
C         *                   "TXMV1"                   * 
C         *********************************************** 
C 
C 
C 
C 
C    DESCRIPTION: 
C    ------------ 
C 
C    THE PROGRAM "TXMV1" VERIFIES THE PROPER OPERATION
C    OF THE SYSTEM DISC OR ANY PERIPHERAL DISC. 
C 
C 
C 
C    OPERATING PROCEDURE: 
C    -------------------- 
C 
C    SCHEDULE THE PROGAM "TXMV1" FOR EXECUTION WITH THE RUN COMMAND.
C 
C    ENTER:   RU,TXMV1,LOGLU,DISCLU,ST,MT,XXX 
C                                      MM 
C 
C    WHERE
C 
C         LOGLU    IS THE LU FOR LOGGING AND ERROR MESSAGES.
C 
C         DISCLU   IS THE DISC LU TO BE TESTED. 
C 
C         ST       RUN OPTIONAL SELF-TEST.
C                  (DEFAULT NO SELF-TEST).
C 
C         MT       OPTIONAL MEDIA TEST (TESTFILE REST OF CARTRIDGE).
C                  (DEFAULT TESTFILE SIZE 24 BLOCKS). 
C         MM       OPTIONAL MEDIA TEST WITH MESSAGES.  SAME AS MEDIA
C                  TEST ABOVE.  THE FOLLOWING MESSAGE WILL BE REPORTED
C                  EVERY 15-25 SECONDS: 
C                  TXMV1 - LU# XX: DISC TEST  XX.X% COMPLETE
C 
C         XXX      OPTIONAL NUMBER OF PASSES. 
C                  (DEFAULT RUN ONCE).
C 
C 
C    NOTE:  SET BREAK FLAG TO STOP THE DISC TEST. 
C           (USING BR COMMAND)
C 
C 
C 
C 
C 
C 
C 
C    TEST SEQUENCE: 
C    -------------- 
C 
C    1. RUN THE SELF-TEST (FOR IDC DISC ONLY).
C 
C    2. BINARY SEEK-TEST ACROSS THE ENTIRE SURFACE. 
C 
C    3. CREATE TESTFILE "@TEST@" ON DISC LU (FILE TYPE 1).  FILE
C       SIZE IS 24 BLOCKS.  IF MT (MEDIA TEST) WAS SPECIFIED IN 
C       RUN COMMAND, REST OF CARTRIDGE IS ALLOCATED TO TESTFILE 
C       "@TEST@". 
C 
C    4. WRITE WORST CASE TEST PATTERN EACH CONSISTING OF 128 WORDS
C       TO TESTFILE "@TEST@" USING FMP CALLS. 
C 
C    5. READ AND READ/VERIFY THE WRITTEN DATA PATTERN USING DISC
C       OPERATION LIBRARY SUBROUTINES. REPORT ALL ERRORS. 
C 
C    6. REPEAT STEP 4 AND 5 UNTIL THE TESTFILE "@TEST@" IS FILLED.
C       17 WORST CASE TEST PATTERN ARE USED AND ROTATED.
C 
C    7. PURGE THE TESTFILE "@TEST@".
C 
C    8. THE ENTIRE TEST IS REPEATED AS MANY TIMES AS SPECIFIED BY 
C       THE OPTIONAL PARAMETER XXX (DEFAULT ONCE).
C 
C 
C 
C 
C 
C 
C 
C 
C 
C    LIST OF ALL INFORMATION MESSAGES:
C    ---------------------------------
C 
C 
C 
C    TXMV1 - LU# XX:  DISC TEST RUNNING 
C 
C 
C    TXMV1 - LU# 10:  DISC TEST  XX.X% COMPLETE 
C    (OPTIONAL MESSAGE REPORTED EVERY 15 TO 25 SECONDS) 
C 
C 
C    TXMV1 - LU# XX:  SELF-TEST PASSED
C 
C 
C    TXMV1 - LU# XX:  SELF-TEST NOT AVAILABLE!
C 
C 
C    TXMV1 - LU# XX:  DISC TEST FINISHED XXXX PASSES XXXX ERRORS
C 
C 
C 
C 
C 
C    LIST OF ALL ERROR MESSAGES:
C    ---------------------------
C 
C 
C 
C    TXMV1 - LU# SPECIFIED FOR TEST DISC IS ILLEGAL.
C            RERUN TEST SPECIFYING AN INTEGER >0 AND <64 FOR LU#. 
C 
C    TXMV1 - DISC TEST ABORTED! 
C 
C 
C    TXMV1 - LU# XX: NOT ASSIGNED, NOT TESTED!
C 
C 
C    TXMV1 - LU# XX IS NOT A LEGAL DISC.
C            RERUN TEST SPECIFYING CORRECT LU#. 
C 
C 
C    TXMV1 - LU# XX: EQT OR LU FOR TEST DISC IS DOWN. 
C            UP EQT AND RERUN TEST. 
C 
C 
C    TXMV1 - LU# XX: CARTRIDGE NOT MOUNTED. 
C            MOUNT CARTRIDGE AND RERUN TEST.
C 
C 
C    TXMV1 - LU# XX: DISC TEST ABORTED! 
C 
C 
C    TXMV1 - LU# XX: DRIVE NOT READY! 
C 
C 
C    TXMV1 - LU# XX: DISC TRACK MAP TABLE ERROR!
C 
C 
C    TXMV1 - LU# XX: SELF-TEST FAILED!
C 
C 
C    TXMV1 - LU# XX: LOCK/UNLOCK ERROR! 
C 
C 
C    TXMV1 - LU# XX: POWER-ON ERROR, RERUN TEST!
C 
C 
C    TXMV1 - LU# XX: HP-IB PARITY ERROR, RERUN TEST!
C 
C 
C    TXMV1 - LU# XX: TIME-OUT ERROR, RERUN TEST!
C 
C 
C    TXMV1 - LU# XX: ERROR FMP-XXX ON TEST FILE @TEST@! 
C    (REFER TO FMP ERROR NUMBER DESCRIPTION IN THE BATCH SPOOL
C    MONITOR REFERENCE MANUAL)
C 
C 
C    TXMV1 - LU# XX: WRITE/READ DATA COMPARE ERROR! 
C                    TRACK# XXX, CYL# XXX, HEAD# X, UNIT# X 
C                    DATA XXXXXXB  SHOULD BE XXXXXXB
C                    NUMBER OF DATA COMPARE ERRORS: XXX 
C    (ONLY THE FIRST THREE ERRORS ARE DISPLAYED)
C 
C 
C    TXMV1 - LU# XX: DISC STATUS ERROR!  S1=XXXXXXB  S2=XXXXXXB 
C    (SEE NOTE) 
C 
C 
C    TXMV1 - LU# XX: DISC READ ERROR!  S1=XXXXXXB  S2=XXXXXXB 
C                    TRACK# XXX, CYL# XXX, HEAD# X, UNIT# X 
C    (SEE NOTE) 
C 
C 
C    TXMV1 - LU# XX: DISC VERIFY ERROR!  S1=XXXXXXB  S2=XXXXXXB 
C                    TRACK# XXX, CYL# XXX, HEAD# X, UNIT# X 
C    (SEE NOTE) 
C 
C 
C 
C    POSSIBLE STATUS-1 ERRORS:
C 
C             STATUS-1 ERROR: ILLEGAL OPCODE
C 
C             STATUS-1 ERROR: ILLEGAL DRIVE TYPE
C 
C             STATUS-1 ERROR: CYLINDER MISCOMPARE 
C 
C             STATUS-1 ERROR: UNCORRECTABLE DATA ERROR
C 
C             STATUS-1 ERROR: HEAD/SECTOR MISCOMPARE
C 
C             STATUS-1 ERROR: I/O PROGRAM ERROR 
C 
C             STATUS-1 ERROR: END OF CYLINDER 
C 
C             STATUS-1 ERROR: DATA OVERRUN
C 
C             STATUS-1 ERROR: ILLEGAL ACCESS TO SPARE TRACK 
C 
C             STATUS-1 ERROR: DEFECTIVE TRACK 
C 
C             STATUS-1 ERROR: ACCESS NOT READY DURING OPERATION 
C 
C             STATUS-1 ERROR: STATUS-2 ERROR
C 
C             STATUS-1 ERROR: ATTEMPT TO WRITE ON PROTECTED TRACK 
C 
C             STATUS-1 ERROR: UNIT UNAVAILABLE
C 
C             STATUS-1 ERROR: DRIVE ATTENTION 
C 
C 
C 
C    POSSIBLE STATUS-2 ERRORS:
C 
C             STATUS-2 ERROR: DRIVE BUSY
C 
C             STATUS-2 ERROR: DRIVE NOT READY 
C 
C             STATUS-2 ERROR: NO DISC OR HEADS UNLOADED 
C 
C             STATUS-2 ERROR: SEEK OUT OF BOUND 
C 
C             STATUS-2 ERROR: FIRST STATUS BIT SET
C 
C             STATUS-2 ERROR: DRIVE FAULT 
C 
C 
C 
C 
C    NOTE:  ALL POSSIBLE STATUS-1 AND STATUS-2 ERRORS 
C           ARE REPORTED AFTER THE MAIN ERROR MESSAGE.
C 
C 
C 
C 
C 
C 
C 
      COMMON NAME(3),ISTAT(2),ISIZE(2)
      COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG
      COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER
      DIMENSION ICART(125),IPRAM(5),MAP(5)
C 
C************************* RECOVER PARAMETERS ************************
C 
      CALL RMPAR(IPRAM) 
      LULOG=1 
      IF (IPRAM(1) .GT. 0)  LULOG=IPRAM(1)
      LUDSK=IPRAM(2)
      ISELF=0 
      IF (IPRAM(3) .EQ. 2HST)  ISELF=1
      ISIZE(1)=24 
      ISIZE(2)=0
      IF ((IPRAM(4) .EQ. 2HMT) .OR. (IPRAM(4) .EQ. 2HMM))  ISIZE(1)=-1
      LOG=0 
      IF (IPRAM(4) .EQ. 2HMM)  LOG=1
      LMAX=1
      IF (IPRAM(5) .GT. 0)  LMAX=IPRAM(5) 
C 
C************** STORE NAME FOR LOGGING AND ERROR MESSAGES ************
C 
      NAME(1)=2HTX
      NAME(2)=2HMV
      NAME(3)=2H1 
C 
C************************* ILLEGAL DISC LU ***************************
C 
      IF (IAND(LUDSK,177700B) .EQ. 0)  GO TO 200
      WRITE(LULOG,100) NAME 
100   FORMAT(/,2X,3A2,"- LU# SPECIFIED FOR TEST DISC IS ",
     1       "ILLEGAL."/,10X,"RERUN TEST SPECIFYING AN INTEGER",
     2       " >0 AND <64 FOR LU#.")
      WRITE(LULOG,110) NAME 
110   FORMAT(/,2X,3A2,"- DISC TEST ABORTED!",/) 
      GO TO 820 
C 
C************************ GET STATUS OF DISC LU **********************
C 
200   CALL EXEC(13,LUDSK,IEQT5,IEQT4,LUSTAT)
C 
C********************* CHECK IF DISC LU IS ENABLED *******************
C 
      IF (IAND(IEQT4,77B) .NE. 0)  GO TO 220
      WRITE(LULOG,210) NAME,LUDSK 
210   FORMAT(/,2X,3A2,"- LU#",I3,": NOT ASSIGNED, NOT TESTED!",/) 
      GO TO 820 
C 
C******************* CHECK IF DISC DRIVER TYPE IS 32 *****************
C 
220   IF (IAND(IEQT5,37400B) .EQ. 15000B)  GO TO 260
      WRITE(LULOG,230) NAME,LUDSK 
230   FORMAT(/,2X,3A2,"- LU#",I3," IS NOT A LEGAL DISC.",/, 
     1       10X,"RERUN TEST SPECIFYING CORRECT LU#.")
240   WRITE(LULOG,250) NAME,LUDSK 
250   FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/)
      GO TO 820 
C 
C*********************** CHECK IF DISC IS UP *************************
C 
260   IF (IAND(IEQT5,140000B) .EQ. 40000B)  GO TO 270 
      IF (IAND(LUSTAT,100000B) .EQ. 0)  GO TO 300 
270   WRITE(LULOG,280) NAME,LUDSK 
280   FORMAT(/,2X,3A2,"- LU#",I3,": EQT OR LU FOR TEST DISC IS ", 
     1       "DOWN."/,10X,"UP EQT AND RERUN TEST.") 
      GO TO 240 
C 
C***************** GET DEVICE IDENTIFICATION (IDVID) *****************
C                     BITS 0-7   HP-IB ADDRESS
C                     BITS 8-15  UNIT# OF DRIVE 
C 
300   CALL EXEC(1,LUDSK+2200B,MAP,5,0,5)
      IDVID=IAND(MAP(5),16000B)/4 
      IDVID=IDVID+IAND(MAP(3),17B)
C 
C************************** GET DISC STATUS **************************
C 
      IER=0 
      CALL XSTAT(LUDSK,IDVID,ISTAT(1),ISTAT(2),IER) 
      IF (IER .GT. 2)  GO TO 310
      IF (IAND(ISTAT(2),100000B) .EQ. 0)  GO TO 330 
310   WRITE(LULOG,320) NAME,LUDSK 
320   FORMAT(/,2X,3A2,"- LU#",I3,": DRIVE NOT READY!")
      GO TO 240 
C 
C************************** GET DRIVE TYPE ***************************
C 
C     ITYPE=1  FOR 7906     48 SECT/TRK, 4 HEADS, 411 CYL 
C     ITYPE=2  FOR 7920     48 SECT/TRK, 5 HEADS, 823 CYL 
C     ITYPE=3  FOR 7905     48 SECT/TRK, 3 HEADS, 411 CYL 
C     ITYPE=4  FOR 7925     64 SECT/TRK, 9 HEADS, 823 CYL 
C     ITYPE=5  FOR 7910     32 SECT/TRK, 2 HEADS, 748 CYL 
C     ITYPE=6  FOR 9895     30 SECT/TRK, 2 HEADS,  77 CYL 
C 
330   ITYPE=0 
      MASK=177B 
      IF (IFDVR(LUDSK) .EQ. 0)  MASK=377B 
C 
C********************* CHECK FOR 7905/7906/7920 **********************
C 
      IDT=IAND(ISTAT(2),17000B)/1000B 
      IF (MAP(1) .NE. 96)  GO TO 400
      IF (IDT .EQ. 0)  ITYPE=1
      IF (IDT .EQ. 1)  ITYPE=2
      IF (IDT .EQ. 2)  ITYPE=3
C 
C************************** CHECK FOR 7925 ***************************
C 
400   IF (MAP(1) .NE. 128)  GO TO 410 
      IF (IDT .EQ. 3)  ITYPE=4
C 
C************************** CHECK FOR 9895 ***************************
C 
410   IF (MAP(1) .NE. 60)  GO TO 420
      ITYPE=6 
      MASK=37B
C 
C************************** CHECK FOR 7910 ***************************
C 
420   IF (MAP(1) .EQ. 64)   ITYPE=5 
C 
C****************** ILLEGAL DISC TYPE, REPORT EROR *******************
C 
      IF (ITYPE .NE. 0)  GO TO 500
      WRITE(LULOG,430) NAME,LUDSK 
430   FORMAT(/,2X,3A2,"- LU#",I3,": DISC TRACK MAP TABLE ERROR!") 
      GO TO 240 
C 
C*************** CHECK TO SEE IF CARTRIDGE IS MOUNTED ****************
C 
500   CALL FSTAT(ICART) 
      DO 510  I=1,125,4 
      IF (LUDSK .EQ. ICART(I))  GO TO 600 
      IF (ICART(I) .EQ. 0)  GO TO 520 
510   CONTINUE
520   WRITE(LULOG,530) NAME,LUDSK 
530   FORMAT(/,2X,3A2,"- LU#",I3,": CARTRIDGE NOT MOUNTED."/, 
     1       10X,"MOUNT CARTRIDGE AND RERUN TEST.") 
      GO TO 240 
C 
C************************** START TESTING ****************************
C 
600   WRITE(LULOG,610) NAME,LUDSK 
610   FORMAT(/,2X,3A2,"- LU#",I3,":  DISC TEST RUNNING")
C 
C****************** INITIALIZE PROGRAM PARAMETERS ********************
C 
      INCR=1
      NEXT=1
      LOOP=1
C 
C****************** RESET NUMBER OF ERRORS (NERR) ********************
C 
      NERR=0
C 
C************************ CALL TEST SUBROUTINES **********************
C 
700   IF (ISELF .EQ. 1)  CALL STEST 
      CALL BSEEK
      CALL WRTST
      IF (LOOP .EQ. LMAX)  GO TO 800
      LOOP=LOOP+1 
      GO TO 700 
C 
C************** TESTING COMPLETED, REPORT NUMBER OF ERRORS ***********
C 
800   WRITE(LULOG,810) NAME,LUDSK,LOOP,NERR 
810   FORMAT(/,2X,3A2,"- LU#",I3,":  DISC TEST FINISHED",I5,
     1       " PASSES",I5," ERRORS",/)
820   END 
      SUBROUTINE STEST
C 
C 
C         ********************************* 
C         *     SELF-TEST SUBROUTINE      * 
C         ********************************* 
C 
C 
C 
      COMMON NAME(3),ISTAT(2),ISIZE(2)
      COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG
      COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER
      DIMENSION IBUF(20)
C 
C*******************  EXECUTE SELF-TEST (IDC ONLY) *******************
C 
      IF (IFDVR(LUDSK) .NE. 0)  GO TO 1100
      WRITE(LULOG,1000) NAME,LUDSK
1000  FORMAT(/,2X,3A2,"- LU#",I3,":  SELF-TEST NOT AVAILABLE!") 
      RETURN
C 
1100  ID=IAND(IDVID,7)
      IBUF(1)=440B+ID 
      CALL XPRTY(IBUF(1)) 
      IBUF(2)=577B
      IBUF(3)=0 
      IBUF(4)=1004B 
      IBUF(5)=100677B 
C 
C************************* INITIATE SELF TEST ************************
C 
      CALL EQTLK(1) 
      CALL EXEC(1,LUDSK+2200B,IBUF,5,1,0) 
C 
C*************************** PARALLEL POLL ***************************
C 
1200  CALL EXEC(1,LUDSK+2200B,IPOLL,1,6,0)
      IC=IAND(2**(7-ID),IPOLL)
      IF (IAND(2**(7-ID),IPOLL) .EQ. 0)  GO TO 1200 
C 
C*********************** READ SELF TEST RESULT ***********************
C 
      IBUF(1)=500B+ID 
      CALL XPRTY(IBUF(1)) 
      IBUF(2)=100577B 
      LEN=-2
      CALL EXEC(1,LUDSK+2200B,IBUF,LEN,2,0) 
      CALL EQTLK(0) 
      IF (IAND(IBUF(17),200B) .NE. 0)  GO TO 1400 
      WRITE(LULOG,1300) NAME,LUDSK
1300  FORMAT(/,2X,3A2,"- LU#",I3,":  SELF-TEST PASSED") 
      CALL XSTAT(LUDSK,IDVID,ISTAT(1),ISTAT(2),IER) 
      RETURN
1400  CALL XEND(LUDSK,IDVID)
      WRITE(LULOG,1500) NAME,LUDSK
1500  FORMAT(/,2X,3A2,"- LU#",I3,": SELF-TEST FAILED!") 
      WRITE(LULOG,1600) NAME,LUDSK
1600  FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/)
      CALL EXEC(6)
      END 
      SUBROUTINE BSEEK
C 
C 
C         ********************************* 
C         *       BINARY SEEK TEST        * 
C         ********************************* 
C 
C 
C 
      COMMON NAME(3),ISTAT(2),ISIZE(2)
      COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG
      COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER
      DIMENSION NCYL02(8),NCYL05(11),NCYL10(12),NCYL20(12)
      DATA NCYL02 / 0,1,2,4,8,16,32,64 /
      DATA NCYL05 / 0,1,2,4,8,16,32,64,128,256,410 /
      DATA NCYL10 / 0,1,2,4,8,16,32,64,128,256,512,747 /
      DATA NCYL20 / 0,1,2,4,8,16,32,64,128,256,512,822 /
C 
C  GET PHYSICAL ADDRESSES:
C 
      LTRK=0
      LSEC=0
      CALL XGTAD(LUDSK,IDVID,LTRK,LSEC,ICYL,IHEAD,ISECT)
C 
      GO TO (1000,2000,1000,2000,3000,4000), ITYPE
C 
C****************** BINARY SEEK TEST FOR 7905/7906 *******************
C 
1000  DO 1100  I=1,11 
      ICYL=NCYL05(I)
      CALL EQTLK(1) 
      CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER)
      CALL EQTLK(0) 
      CALL CKSTA(1) 
1100  CONTINUE
      RETURN
C 
C******************* BINARY SEEK TEST FOR 7920/7925 ******************
C 
2000  DO 2100  I=1,12 
      ICYL=NCYL20(I)
      CALL EQTLK(1) 
      CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER)
      CALL EQTLK(0) 
      CALL CKSTA(1) 
2100  CONTINUE
      RETURN
C 
C********************* BINARY SEEK TEST FOR 7910 *********************
C 
3000  DO 3100  I=1,12 
      ICYL=NCYL10(I)
      CALL EQTLK(1) 
      CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER)
      CALL EQTLK(0) 
      CALL CKSTA(1) 
3100  CONTINUE
      RETURN
C 
C********************* BINARY SEEK TEST FOR 9895 *********************
C 
4000  DO 4100 I=1,8 
      ICYL=NCYL02(I)
      CALL EQTLK(1) 
      CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER)
      CALL EQTLK(0) 
      CALL CKSTA(1) 
4100  CONTINUE
      RETURN
      END 
      SUBROUTINE WRTST
C 
C 
C         ********************************* 
C         *       WRITE/READ TEST         * 
C         ********************************* 
C 
C 
C 
      COMMON NAME(3),ISTAT(2),ISIZE(2)
      COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG
      COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER
      DIMENSION IDCB(144),IBUFR(144),IBUFW(128) 
      DIMENSION IPAT(17),NFILE(3) 
C 
C********************** WORST CASE DATA PATTERN **********************
C 
      DATA IPAT / 155555B,177777B,175767B,055555B,002010B,170360B,
     1            162745B,000000B,163346B,022222B,033066B,052525B,
     2            125252B,106615B,133333B,143306B,007417B/
C 
C********************** NAME FOR TEST FILE @TEST@ ********************
C 
      DATA NFILE / 2H@T,2HES,2HT@ / 
C 
C*********************** CREATE FMP TEST FILE ************************
C 
      IERR=0
      ITYP=1
      ISECU=0 
      ICR=-LUDSK
      CALL CREAT(IDCB,IERR,NFILE,ISIZE,ITYP,ISECU,ICR)
      IF (IERR .LT. 0)  GO TO 3100
      MAX=IERR/2
      LTRK=IDCB(4)
      LSEC=IDCB(5)
      NSPT=IDCB(9)
C 
C*********************** WRITE/READ TEST LOOP ************************
C 
      LEN=128 
      NUM=0 
      DO 3000  J=1,MAX
C 
C*********************** TEST THE BREAK FLAG *************************
C         IF SET - STOP TESTING AND REPORT FINISHED MESSAGE 
C 
      IF (IFBRK (IDUMY))  1000,1200 
1000  CALL PURGE(IDCB,IERR,NFILE,ISECU,ICR) 
      IF (IERR .LT. 0)  GO TO 3100
      WRITE(LULOG,1100) NAME,LUDSK,LOOP,NERR
1100  FORMAT(/,2X,3A2,"- LU#",I3,":  DISC TEST FINISHED",I5,
     1       " PASSES",I5," ERRORS",/)
      GO TO 3300
C 
C****************** REPORT  XX.X% COMPLETE MESSAGE *******************
C 
1200  IF (LOG .EQ. 0)  GO TO 1400 
      INCR=INCR+1 
      IF (IAND(INCR,MASK) .NE. 0)  GO TO 1400 
      PASS=FLOAT(J)+(FLOAT(MAX)*FLOAT(LOOP-1))
      PRCNT=100.0*PASS/(FLOAT(LMAX)*FLOAT(MAX)) 
      WRITE(LULOG,1300) NAME,LUDSK,PRCNT
1300  FORMAT(/,2X,3A2,"- LU#",I3,":  DISC TEST",F6.1,"% COMPLETE")
C 
C****************** WRITE DATA PATTERN TO THE DISC *******************
C                          USING FMP CALLS
C                      WRITE BUFFER IBUFW(128)
C 
1400  DO 1500  I=1,128
      IBUFW(I)=IPAT(NEXT) 
1500  CONTINUE
      CALL WRITF(IDCB,IERR,IBUFW,LEN,NUM) 
      IF (IERR .LT. 0)  GO TO 3100
C 
C********************** READ DATA FROM THE DISC **********************
C              USING DISC OPERATION LIBRARY SUBROUTINES 
C                       READ BUFFER IBUFR(144)
C 
      CALL XGTAD(LUDSK,IDVID,LTRK,LSEC,ICYL,IHEAD,ISECT)
      CALL EQTLK(1) 
      CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER)
      CALL CKSTA(1) 
C 
      CALL XDRED(LUDSK,IDVID,IBUFR,LEN,ISTAT(1),ISTAT(2),IER) 
      CALL EQTLK(0) 
      CALL CKSTA(2) 
C 
C****************** COMPARE WRITE/READ BUFFER ************************
C              DISPLAY ONLY THE FIRST THREE ERRORS
C 
      N3=0
      DO 2500  I=17,144 
      IF (IBUFR(I) .EQ. IPAT(NEXT))  GO TO 2500 
      NERR=NERR+1 
      N3=N3+1 
      GO TO  (2000,2300,2300,2500), N3
2000  WRITE(LULOG,2100) NAME,LUDSK
2100  FORMAT(/,2X,3A2,"- LU#",I3,": WRITE/READ DATA COMPARE ERROR!")
      IUNIT=IAND(IDVID,7) 
      WRITE(LULOG,2200) LTRK,ICYL,IHEAD,IUNIT 
2200  FORMAT(18X,"TRACK#",I4,", CYL#",I4,", HEAD#",I2,", UNIT#",I2) 
2300  WRITE(LULOG,2400) IBUFR(I),IPAT(NEXT) 
2400  FORMAT(18X,"DATA ",@6,"B  SHOULD BE ",@6,"B") 
2500  CONTINUE
      IF (N3 .NE. 0)  WRITE(LULOG,2600) N3
2600  FORMAT(18X,"NUMBER OF DATA COMPARE ERRORS:",I4) 
C 
C************************* READ VERIFY DATA **************************
C              USING DISC OPERATION LIBRARY SUBROUTINES 
C 
      CALL XGTAD(LUDSK,IDVID,LTRK,LSEC,ICYL,IHEAD,ISECT)
      CALL EQTLK(1) 
      CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER)
      CALL CKSTA(1) 
      NSEC=1
      CALL XVRFY(LUDSK,IDVID,NSEC,ISTAT(1),ISTAT(2),IER)
      CALL EQTLK(0) 
      CALL CKSTA(3) 
      NEXT=NEXT+1 
      IF (NEXT .GT. 17)  NEXT=1 
      LSEC=LSEC+2 
      IF (LSEC .LT. NSPT)  GO TO 3000 
      LSEC=LSEC-NSPT
      LTRK=LTRK+1 
3000  CONTINUE
C 
C*********************** PURGE FMP TEST FILE *************************
C 
      CALL PURGE(IDCB,IERR,NFILE,ISECU,ICR) 
      IF (IERR .LT. 0)  GO TO 3100
      RETURN
C 
C************************* REPORT FMP ERROR **************************
C 
3100  IFMP=KCVT(-IERR)
      IF (IAND(IFMP,157400B) .EQ. 0)  IFMP=IFMP+10000B
      WRITE(LULOG,3200) NAME,LUDSK,IFMP 
3200  FORMAT(/,2X,3A2,"- LU#",I3,": ERROR FMP-0",A2,
     1       " ON TEST FILE @TEST@!") 
3300  WRITE(LULOG,3400) NAME,LUDSK
3400  FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/)
      CALL EXEC(6)
      END 
      SUBROUTINE CKSTA(ICOM)
      COMMON NAME(3),ISTAT(2),ISIZE(2)
      COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG
      COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER
C 
C    THIS SUBROUTINE CHECKS THE STATUS AFTER THE
C    FOLLOWING DISC OPERATION LIBRARY SUBROUTINES:
C 
C      - SEEK COMMAND (ICOM=1)
C      - READ COMMAND (ICOM=2)
C      - VERIFY COMMAND (ICOM=3)
C 
C 
C 
C******************** CHECK ERROR RETURN (IER) ***********************
C 
C    IER: 
C     0     DSJ=0     NORMAL COMPLETION 
C     1     DSJ=1     ABNORMAL COMPLETION 
C     2     DSJ=2     POWER-ON OR COMPLETION OF SELF-TEST 
C     3     DSJ=3     HP-IB PARITY ERROR
C     4               LU HAS TIMED-OUT
C 
C 
      IF ((IER .EQ. 0) .OR. (IER .EQ. 1))  GO TO 2000 
C 
      IF (IER .EQ. 2)  WRITE(LULOG,1000) NAME,LUDSK 
1000  FORMAT(/,2X,3A2,"- LU#",I3,": POWER-ON ERROR, RERUN TEST!") 
C 
      IF (IER .EQ. 3)  WRITE(LULOG,1100) NAME,LUDSK 
1100  FORMAT(/,2X,3A2,"- LU#",I3,": HP-IB PARITY ERROR, RERUN TEST!") 
C 
      IF (IER .EQ. 4)  WRITE(LULOG,1200) NAME,LUDSK 
1200  FORMAT(/,2X,3A2,"- LU#",I3,": TIME-OUT ERROR, RERUN TEST!") 
C 
      WRITE(LULOG,1300) NAME,LUDSK
1300  FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/)
      CALL EXEC(6)
C 
C***************** CHECK STATUS AFTER READ OR VERIFY *****************
C  STATUS-1: IDC STAT SHOULD BE ZERO
C 
2000  IF (ICOM .EQ. 1)  GO TO 2100
      IF (IAND(ISTAT(1),17400B) .EQ. 0)  RETURN 
      GO TO 2300
C 
C****************** CHECK STATUS AFTER SEEK COMMAND ******************
C 
C 7910 ONLY !! *** IGNORE IDC STAT 20B (ILLEGAL ACCESS TO SPARE TRACK)
C 
2100  IF (ITYPE .NE. 5)  GO TO 2200 
      IF (ISTAT(1) .EQ. 110000B)  ISTAT(1)=17400B 
C 
C  STATUS-2: E-BIT SHOULD BE ZERO 
C  STATUS-1: IDC STAT SHOULD BE 37B 
C 
2200  IF (IAND(ISTAT(2),100000B) .NE. 0)  GO TO 2300
      IF (IAND(ISTAT(1),17400B) .EQ. 17400B)  RETURN
C 
C  CHECK FOR NORMAL COMPLETION (ICD STAT 0) 
C 
      IF (ISTAT(1) .EQ. 0)  RETURN
C 
C***************** STATUS ERROR, REPORT ERROR MESSAGE ****************
C 
2300  CALL ERMSG(ICOM)
      RETURN
      END 
      SUBROUTINE ERMSG(ICOM)
      COMMON NAME(3),ISTAT(2),ISIZE(2)
      COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG
      COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER
C 
C  THIS SUBROUTINE DETERMINES THE ERROR AND REPORTS 
C  ALL POSSIBLE STATUS ERRORS TO THE LOG DEVICE.
C 
C 
      IUNIT=IAND(IDVID,7) 
C 
C********************* INCREMENT NUMBER OF ERRORS ********************
C 
      NERR=NERR+1 
C 
C************************ STATUS ERROR MESSAGE ***********************
C 
      IF (ICOM .EQ. 1)  WRITE(LULOG,9010) NAME,LUDSK,ISTAT(1),ISTAT(2)
9010  FORMAT(/,2X,3A2,"- LU#",I3,": DISC STATUS ERROR!  ",
     1       "S1=",@6,2X,"S2=",@6)
      IF (ICOM .EQ. 1)  GO TO 9050
C 
C************************* READ ERROR MESSAGE ************************
C 
      IF (ICOM .EQ. 2)  WRITE(LULOG,9020) NAME,LUDSK,ISTAT(1),ISTAT(2)
9020  FORMAT(/,2X,3A2,"- LU#",I3,": DISC READ ERROR!  ",
     1       "S1=",@6,2X,"S2=",@6)
C 
C************************ VERIFY ERROR MESSAGE ***********************
C 
      IF (ICOM .EQ. 3)  WRITE(LULOG,9030) NAME,LUDSK,ISTAT(1),ISTAT(2)
9030  FORMAT(/,2X,3A2,"- LU#",I3,": DISC VERIFY ERROR!  ",
     1       "S1=",@6,2X,"S2=",@6)
C 
C************* REPORT  LOGICAL AND PHYSICAL DISC ADDRESS *************
C 
      WRITE(LULOG,9040) LTRK,ICYL,IHEAD,IUNIT 
9040  FORMAT(18X,"TRACK#",I4,", CYL#",I4,", HEAD#",I2,", UNIT#",I2) 
C 
C*********************** PROCESS STATUS-1 ERROR **********************
C 
9050  IS1=IAND(ISTAT(1),17400B) 
      IS1=IS1/400B
C 
      IF (IS1 .EQ. 1)    WRITE(LULOG,9101)
      IF (IS1 .EQ. 3)    WRITE(LULOG,9103)
      IF (IS1 .EQ. 7)    WRITE(LULOG,9107)
      IF (IS1 .EQ. 10B)  WRITE(LULOG,9110)
      IF (IS1 .EQ. 11B)  WRITE(LULOG,9111)
      IF (IS1 .EQ. 12B)  WRITE(LULOG,9112)
      IF (IS1 .EQ. 14B)  WRITE(LULOG,9114)
      IF (IS1 .EQ. 16B)  WRITE(LULOG,9116)
      IF (IS1 .EQ. 20B)  WRITE(LULOG,9120)
      IF (IS1 .EQ. 21B)  WRITE(LULOG,9121)
      IF (IS1 .EQ. 22B)  WRITE(LULOG,9122)
      IF (IS1 .EQ. 23B)  WRITE(LULOG,9123)
      IF (IS1 .EQ. 26B)  WRITE(LULOG,9126)
      IF (IS1 .EQ. 27B)  WRITE(LULOG,9127)
      IF (IS1 .EQ. 37B)  WRITE(LULOG,9137)
C 
C********************** PROCESS STATUS-2 ERROR ***********************
C 
      IS2=IAND(ISTAT(2),37B)
C 
C 
C 
C 
      IF (IAND(IS2,3) .EQ. 1)      WRITE(LULOG,9201)
      IF (IAND(IS2,3) .EQ. 2)      WRITE(LULOG,9202)
      IF (IAND(IS2,3) .EQ. 3)      WRITE(LULOG,9203)
      IF (IAND(IS2,4) .EQ. 4)      WRITE(LULOG,9204)
      IF (IAND(IS2,10B) .EQ. 10B)  WRITE(LULOG,9210)
      IF (IAND(IS2,20B) .EQ. 20B)  WRITE(LULOG,9220)
      RETURN
C 
C************************** STATUS-1 ERRORS **************************
C 
9101  FORMAT(18X,"STATUS-1 ERROR: ILLEGAL OPCODE")
9103  FORMAT(18X,"STATUS-1 ERROR: ILLEGAL DRIVE TYPE")
9107  FORMAT(18X,"STATUS-1 ERROR: CYLINDER MISCOMPARE") 
9110  FORMAT(18X,"STATUS-1 ERROR: UNCORRECTABLE DATA ERROR")
9111  FORMAT(18X,"STATUS-1 ERROR: HEAD/SECTOR MISCOMPARE")
9112  FORMAT(18X,"STATUS-1 ERROR: I/O PROGRAM ERROR") 
9114  FORMAT(18X,"STATUS-1 ERROR: END OF CYLINDER") 
9116  FORMAT(18X,"STATUS-1 ERROR: DATA OVERRUN")
9120  FORMAT(18X,"STATUS-1 ERROR: ILLEGAL ACCESS TO SPARE TRACK") 
9121  FORMAT(18X,"STATUS-1 ERROR: DEFECTIVE TRACK") 
9122  FORMAT(18X,"STATUS-1 ERROR: ACCESS NOT READY DURING OPERATION") 
9123  FORMAT(18X,"STATUS-1 ERROR: STATUS-2 ERROR")
9126  FORMAT(18X,"STATUS-1 ERROR: ATTEMPT TO WRITE ON PROTECTED TRACK") 
9127  FORMAT(18X,"STATUS-1 ERROR: UNIT UNAVAILABLE")
9137  FORMAT(18X,"STATUS-1 ERROR: DRIVE ATTENTION") 
C 
C************************** STATUS-2 ERRORS **************************
C 
9201  FORMAT(18X,"STATUS-2 ERROR: DRIVE BUSY")
9202  FORMAT(18X,"STATUS-2 ERROR: DRIVE NOT READY") 
9203  FORMAT(18X,"STATUS-2 ERROR: NO DISC OR HEADS UNLOADED") 
9204  FORMAT(18X,"STATUS-2 ERROR: SEEK OUT OF BOUND") 
9210  FORMAT(18X,"STATUS-2 ERROR: FIRST STATUS BIT SET")
9220  FORMAT(18X,"STATUS-2 ERROR: DRIVE FAULT") 
9240  FORMAT(18X,"STATUS-2 ERROR: DISC WRITE PROTECTED")
      END 
      SUBROUTINE EQTLK(IOPTN) 
C 
C  THIS SUBROUTINE LOCKS THE PROGRAM INTO MEMORY AND LOCKS
C  THE DISC EQT DURING CRITICAL DISC I/O OPERATIONS.
C 
C 
      COMMON NAME(3),ISTAT(2),ISIZE(2)
      COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG
      COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER
      IF (IOPTN .EQ. 1)  CALL EXEC(22,IOPTN)
      CALL EQTRQ(IOPTN,LUDSK) 
      CALL ABREG(IA,IB) 
      IF (IOPTN .EQ. 0)  CALL EXEC(22,IOPTN)
      IF (IA .EQ. 0)  RETURN
      WRITE(LULOG,1000) NAME,LUDSK
1000  FORMAT(/,2X,3A2,"- LU#",I3,": LOCK/UNLOCK ERROR!")
      WRITE(LULOG,1100) NAME,LUDSK
1100  FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/)
      CALL EXEC(6)
      END 
      END$