*DECK,HPA9
      OVCAP.
      SUBROUTINE HPA9 
  
  
*         ***  CONTROL PROGRAM FOR MEDIA REPORTS   ***
  
  
*CALL,HPACOM1 
*       TIME PRINT OUT CONTROLLED BY (X=T) PARAMETER                    001120
      IF (FROG(6) .NE. L"T") GO TO 10 
      CP = SECOND ()
      PRINT 9,CP                                                        001150
    9 FORMAT (' ENTER HPA9 , SECOND = ',F10.3)
   10 CONTINUE                                                          001170
  
  
*     DO DETAIL REPORT AND SUMMARY DATA 
  
      IF (FROG(5) .NE. L"SS") CALL TAPREP9
      IF (FROG(5) .EQ. L"SS") CALL MSSREP9
  
*     GENERATE SUMMARY REPORT 
  
      IF ((FROG(5).EQ.L"S").OR.(FROG(5).EQ.L"SD").OR.(FROG(5).EQ.L"DS"))
     .   CALL MEDSUM9 
                                                                         R2FHWMO
      IF (FROG(5).NE.L"SS") GO TO 800 
      CALL MEDSUM9
      GO TO 900 
*        GENERATE REPORT OF BAD MEDIA IN VSN EXTRACT NOT SELECTED 
  800 CONTINUE
  
      IF(FROG(10).EQ.3HOFF) CALL WTT9 
                                                                         R2FHWMO
  900 CONTINUE
      END 
      SUBROUTINE MEDSUM9
  
  
**       MEDSUM9 - GENERATES SUMMARY REPORT 
* 
*        DATA AREAS 
*        ---------- 
* 
*         IDX    - ARRAY TO HOLD INDEX VALUE TO SELECT EACH DATA
*                  ITEM IN ARRAY PRIM AND SECO
*         PRIM   - ARRAY TO HOLD DATA FOR ONE LINE OF TAPE MEDIA
*                  DETAIL REPORT
*         SECO   - ARRAY TO HOLD DATA FOR ONE LINE OF TAPE MEDIA
*                  SUMMARY REPORT 
*         IHDR   - VALUE TO SELECT PROPER REPORT HEADER 
*         HCF(5) - VALUE TO SELECT PROPER REPORT SUB-HEADER 
*         FEOF(SCR1)   - FLAG TO INDICATE EOF STATUS OF FILE
*         PL  - HOLD ONE LINE OF DATA TO PRINT IN VARIOUS REPORTS 
* 
* 
*        CALLS
*        -----
* 
*         PRINT9  - PRINT A LINE OF DATA IN VARIOUS REPORTS 
* 
  
  
*CALL,HPACOM1 
*CALL HPACOM9 
      EQUIVALENCE  (IDX(01),IRT   ),
     .             (IDX(02),IVSN  ),
     .             (IDX(03),IDAYTO),
     .             (IDX(04),IRTRY ,IDAYFM), 
     .             (IDX(05),IMOUNT),
     .             (IDX(06),IBLKR ),
     .             (IDX(07),IBLKW ),
     .             (IDX(08),IRPRCV),
     .             (IDX(09),IRPURV),
     .             (IDX(10),IWPRCV),
     .             (IDX(11),IWPURV),
     .             (IDX(12),IJOB  ),
     .             (IDX(13),IDTEST),
     .             (IDX(14),ICH   ),
     .             (IDX(15),IEQ   ),
     .             (IDX(16),IUNIT ),
     .             (IDX(17),IRDCOR),
     .             (IDX(18),IWRCOR) 
  
      DATA (IDX(I),I=1,18,1) / 01, 02, 03, 04, 05, 06, 07, 08, 09, 10 
     .,                        11, 12, 13, 14, 15, 16, 17, 18 / 
  
  
*     ALL DATA IN INPUT FILE HAVE BEEN PROCESSED -
*     AND GENERATE TAPE MEDIA SUMMAY REPORT AS REQUIRED.
  
  
      IF (FROG(5) .EQ. L"SS") THEN
         IHDR = 19
         HCF(5) = 7 
      ELSE
         IHDR = 21
         HCF(5) = 6 
      ENDIF 
      CALL HEADER 
      CALL PRHEAD9 (5)
  
*        READ DATA FROM SCRATCH FILE
  304 CALL RMREAD (SCR2,SECO,LENGTH)
      IF (FEOF(SCR2) .EQ. 3HYES) GO TO 700
  
      IF (SECO(IMOUNT) .EQ. 0) SECO(IMOUNT) = 1 
      PL(01)=SECO(IVSN  ) 
      PL(02)=SECO(IDAYFM) 
      PL(03)=SECO(IDAYTO) 
      PL(04)=SECO(IMOUNT) 
      PL(05)=SECO(IBLKR ) 
      PL(06)=SECO(IBLKW ) 
      PL(07)=SECO(IRPRCV) 
      PL(08)=SECO(IRPURV) 
      PL(09)=SECO(IWPRCV) 
      PL(10)=SECO(IWPURV) 
      PL(11) = SECO(IRDCOR) 
      PL(12) = SECO(IWRCOR) 
  
*     PRINT ONE LINE OF MEDIA SUMMARY REPORT
      IF (FROG(5).EQ.L"SS") CALL PRINT9(10,12)
      IF (FROG(5).NE.L"SS") CALL PRINT9(2,12) 
      GO TO 304 
  
  
*     REPORT ALL UNRECOVERED ERRORS 
*     READ DATA FROM SCRACH FILE
  
  700 CONTINUE
      IF (FROG(5).EQ.L"SS") GO TO 900 
  
      CALL RMREWND(SCR2)
  
  705 CALL RMREAD (SCR2,SECO,LENGTH)
      IF (FEOF (SCR2) .EQ. 3HYES) GO TO 900 
  
*     IF NO UNRECOVERED PARITY ERRORS, IGNORE ENTRY 
  
      IF((SECO(IWPURV) .EQ. 0).AND.(SECO(IRPURV).EQ.0)) GO TO 705 
  
      IF (HCF(5) .NE. 4) THEN 
         HCF(5) = 4 
         CALL HEADER
         CALL PRHEAD9 (5) 
      ENDIF 
  
      PL(01)=SECO(IVSN  ) 
      PL(02)=SECO(IDAYFM) 
      PL(03)=SECO(IDAYTO) 
      PL(04)=SECO(IMOUNT) 
      PL(05)=SECO(IBLKR ) 
      PL(06)=SECO(IBLKW ) 
      PL(07)=SECO(IRPRCV) 
      PL(08)=SECO(IRPURV) 
      PL(09)=SECO(IWPRCV) 
      PL(10)=SECO(IWPURV) 
  
*     PRINT ONE LINE OF SUMMARY REPORT. 
  
      CALL PRINT9(2,10) 
      GO TO 705 
* 
  900 RETURN
      END 
      SUBROUTINE MSSREP9
* 
***       DESCRIPTION 
*         ----------- 
*         SUBROUTINE MSSREP9 GENERATES MEDIA SUMMARY REPORTS FOR MASSTOR
*         AND MASS STORAGE EXTENDED.
* 
*         EXTRACTED MSS/MSE ERROR ENTRIES ARE SORTED BY 
*         MAJOR KEY -   VSN 
*            .      -   RECORD TYPE 
*            .      -   DAY 
*         MINOR KEY -   JOB NAME
* 
*         HPA PARAMETER T=SS OR T=CS UNCONDITIONALLY TURNS ON THE SUMMARY 
*         REPORT. 
* 
*         DATA AREAS
*         ----------
*         IDX    - ARRAY TO HOLD INDEX VALUE TO SELECT EACH DATA
*                  ITEM IN ARRAY PRIM AND SECO
*         SECO   - ARRAY TO HOLD DATA FOR ONE LINE OF TAPE MEDIA
*                  SUMMARY REPORT 
*         IHDR   - VALUE TO SELECT PROPER REPORT HEADER 
*         HCF(5) - VALUE TO SELECT PROPER REPORT SUB-HEADER 
*         FEOF(SCR1)   - FLAG TO INDICATE EOF STATUS OF FILE
*         IYEAR  - HOLD DATE FORMATTED FOR PRINT OUT AS XX/XX/XXBB
*                  SET BY ROUTINE UNJUL VIA ROUTINE RDATE 
*         PL  - HOLD ONE LINE OF DATA TO PRINT IN VARIOUS REPORTS 
*         IFLD   - ARRAY TO HOLD PARSED SEF RECORD
* 
*         CALLED BY 
*         --------- 
*         PROGRAM HPA9. 
* 
*         CALLS 
*         ----- 
*         SETFLDS - PARSE SEF RECORD INTO ARRAY IFLD
*         RDATE9  - GET FORMATTED DATE FROM CURRENT SEF RECORD
* 
*CALL HPACOM1 
*CALL HPACOM9 
  
      EQUIVALENCE  (IDX(01),IRT   ),
     .             (IDX(02),IVSN  ),
     .             (IDX(03),IDAYTO),
     .             (IDX(04),IRTRY ,IDAYFM), 
     .             (IDX(05),IMOUNT),
     .             (IDX(06),IBLKR ),
     .             (IDX(07),IBLKW ),
     .             (IDX(08),IRPRCV),
     .             (IDX(09),IRPURV),
     .             (IDX(10),IWPRCV),
     .             (IDX(11),IWPURV),
     .             (IDX(12),IJOB  ),
     .             (IDX(13),IDTEST),
     .             (IDX(14),ICH   ),
     .             (IDX(15),IEQ   ),
     .             (IDX(16),IUNIT ),
     .             (IDX(17),IRDCOR),
     .             (IDX(18),IWRCOR) 
  
      CALL LOVCAP ('SETFLDS') 
  
      CALL RMREWND (SCR1) 
      CALL RMREWND (SCR2) 
  
*     SET PARAMETERS TO CONTROL PRINT-OUT.
      IHDR = 15 
  
*     CLEAR ARRAY FOR DETAIL/SUMMARY REPORT DATA. 
      DO 72 I = 1,18
   72 SECO(I) = 0 
  
*     READ OUT FIRST ENTRY FROM INPUT FILE SEF. 
      CALL RMREWND (SCR3) 
      CALL RMREAD (SCR3,SEFREC,LENGTH)
      CALL SETFLDS ('IFLD') 
      CALL RDATE9 
  
*     AFFIX CONTINUATION REEL NUMBER
      IFLD(25) = SHIFT (IFLD(26),48) .OR. IFLD(25)
  
      SECO(IDAYFM) = IYEAR
      SVDATE = IFLD(FJDAY) .OR. (SHIFT(IFLD(FC7),9))
      MAXDATE = MINDATE = SVDATE
      TMFMDAY = TMTODAY = IYEAR 
  
      IF (IFLD(FRTY).EQ.O"66") GO TO 720
      VSN = IFLD(23) + SHIFT(IFLD(22),12) + SHIFT(IFLD(21),24)
  
* 
*     GENERATE MASS STORAGE EXTENDED (MSE) SUMMARY REPORTS
* 
  400 IF (IFLD(FMTY).NE.O"60") GO TO 450
      SECO(IBLKR) = SECO(IBLKR) + IFLD(28)
      SECO(IBLKW) = SECO(IBLKW) + IFLD(29)
      SECO(IMOUNT) = SECO(IMOUNT) + 1 
      GO TO 550 
  
  450 WT = SHIFT(IFLD(27),-11) .AND. 1
      IF (WT .EQ. 1) GO TO 500
      IF (IFLD(FEST+1) .EQ. 1)  SECO(IRPURV) = SECO(IRPURV) + 1 
      IF (IFLD(FEST+1) .EQ. 0)  SECO(IRPRCV) = SECO(IRPRCV) + 1 
      GO TO 550 
  
  500 IF (IFLD(FEST+1) .EQ. 1)  SECO(IWPURV) = SECO(IWPURV) + 1 
      IF (IFLD(FEST+1) .EQ. 0)  SECO(IWPRCV) = SECO(IWPRCV) + 1 
  
  550 SVSN = VSN
      CALL RMREAD (SCR3,SEFREC,LENGTH)
      IF (FEOF(SCR3) .EQ. 3HYES) GO TO 600
      CALL SETFLDS ('IFLD') 
      CALL RDATE9 
      ITEMP = IFLD(FJDAY) .OR. (SHIFT(IFLD(FC7),9)) 
      IF (ITEMP .LT. MINDATE) GO TO 1410
      IF (ITEMP .GT. MAXDATE) GO TO 1450
      GO TO 1500
  
 1410 TMFMDAY = IYEAR 
      MINDATE = ITEMP 
      GO TO 1500
  
 1450 TMTODAY = IYEAR 
      MAXDATE = ITEMP 
  
 1500 VSN = IFLD(23) + SHIFT(IFLD(22),12) + SHIFT(IFLD(21),24)
      IF (VSN .EQ. SVSN) GO TO 400
  600 SECO(IVSN) = SVSN 
      IF (SVSN .EQ. 0) SECO(IVSN) = O"55 55 55 55 55 55"
      SECO(IDAYFM) = TMFMDAY
      SECO(IDAYTO) = TMTODAY
  
      CALL RMWRITE(SCR2,SECO,11)
  
      DO 700  I = IRT,IWPURV,1
  700 SECO(I) = 0 
      SECO(IEQ) = 0 
      SECO(IDAYFM) = IYEAR
      SVDATE = IFLD(FJDAY).OR.(SHIFT(IFLD(FC7),9))
      TMFMDAY = TMTODAY = IYEAR 
      MAXDATE = MINDATE = SVDATE
      IF (FEOF(SCR3).NE.3HYES) GO TO 400
      GO TO 800 
  
* 
*     GENERATE MASSTOR (MSS) SUMMARY REPORTS
* 
  720 ENCODE (10,725,ICSN) SEFREC(4)
  725 FORMAT (A10)
      IF((SEFREC(4).EQ.0).OR.(SEFREC(4).EQ.O"7777 7777 7777 7777 7777"))
     .    ICSN = 10H
  730 STRPWR = SHIFT(IFLD(26),16) + IFLD(27)
      T2 = SHIFT(IFLD(29),8).OR.IFLD(30)
      T3 = SHIFT(IFLD(34),12).OR.IFLD(35) 
      STRPRD = SHIFT(IFLD(28),16) + T2
      STRPDMK = IFLD(32) - IFLD(33) 
      WRCHK = IFLD(31)
      RDCHK = T3
      UNRCVD = IFLD(36) 
      SVRCHK = IFLD(37) 
      FMTCHK = IFLD(38) 
      SECO(6) = SECO(6) + STRPWR
      SECO(9) = SECO(9) + STRPRD
      SECO(8) = SECO(8) + STRPDMK 
      SECO(7) = SECO(7) + WRCHK 
      SECO(10) = SECO(10) + RDCHK 
      SECO(11) = SECO(11) + UNRCVD
      SECO(17) = SECO(17) + SVRCHK
      SECO(18) = SECO(18) + FMTCHK
      SECO(IMOUNT) = SECO(IMOUNT) + 1 
      SCSN = ICSN 
      CALL RMREAD (SCR3,SEFREC,LENGTH)
      IF (FEOF(SCR3) .EQ. 3HYES) GO TO 770
      CALL SETFLDS ('IFLD') 
      CALL RDATE9 
      ITEMP = IFLD(FJDAY) .OR. (SHIFT(IFLD(FC7),9)) 
      IF (ITEMP .LT. MINDATE) GO TO 740 
      IF (ITEMP .GT. MAXDATE) GO TO 750 
      GO TO 760 
  
  740 TMFMDAY = IYEAR 
      MINDATE = ITEMP 
      GO TO 760 
  
  750 TMTODAY = IYEAR 
      MAXDATE = ITEMP 
  
  760 ENCODE (10,725,ICSN) SEFREC(4)
      IF((SEFREC(4).EQ.0).OR.(SEFREC(4).EQ.O"7777 7777 7777 7777 7777"))
     .    ICSN = 10H
      IF (ICSN .EQ. SCSN) GO TO 730 
  770 SECO(IVSN) = SCSN 
      SECO(IDAYFM) = TMFMDAY
      SECO(IDAYTO) = TMTODAY
  
      CALL RMWRITE(SCR2,SECO,18)
  
      DO 780 I = 1,18,1 
  780 SECO(I) = 0 
      SECO(IEQ) = 0 
      SECO(IDAYFM) = IYEAR
      SVDATE = IFLD(FJDAY) .OR. (SHIFT(IFLD(FC7),9))
      TMFMDAY = TMTODAY = IYEAR 
      MAXDATE = MINDATE = SVDATE
      IF (FEOF(SCR3) .NE. 3HYES) GO TO 730
  
  800 CALL UOVCAP ('SETFLDS') 
  
*     REWIND TAPE AND EXIT
  
      CALL RMREWND (SCR3) 
* 
      CALL RMFILEM (SCR2) 
      CALL RMFILEM (SCR2) 
      CALL RMREWND (SCR2) 
      CALL RMFILEM (SCR1) 
      CALL RMFILEM (SCR1) 
      CALL RMREWND (SCR1) 
  
      RETURN
      END 
      SUBROUTINE PRHEAD9 (ST) 
  
  
**     PRHEAD9 PRINTS HEADINGS FOR REPORTS DEVELOPED
*      BY OV-3 ROUTINES.
* 
*      ENTRY CONDITIONS 
*      -----------------
*      HCF(5) - ARRAY PRESET WITH POINTERS TO A SET OF HEADINGS 
*               THAT MAY BE PRINTED.  A NON-ZERO VALUE IN HCF(1)
*                  TO HCF(5) IS A POINTER TO A HEADING, AS USED IN
*                  COMPUTED GO-TO. HCF(1) TO (5) ARE SCANNED
*               SEQUENTIALLY AND SEVERAL SUBHEADERS MAY BE PRINTED. 
*          ST = CONTAINS POINTER TO WHERE ROUTINE WILL
*               START SCANN OF (HCF) FLAG.
* 
*       EXIT CONDITIONS 
*       ----------------
*          SUB-HEADER PRINT COMPLETED.
*              ENCOUNTER (HCF) FLAG CONTAINING ( 0 ). 
* 
*       DATA AREAS
*       --------------------
*        HCF(5) - FROG TO CONTROL SUB-HEADER PRINT
* 
*         CALLED BY 
*         --------- 
*         PRINT9 - AUTOMATICALLY, WHEN NEW PAGE IS INITIATED. 
* 
*CALL HPACOM1 
  
      P = ST
      GO TO 5                                                            R2FHWMO
    2 LINE = LINE + 1                                                    R2FHWMO
      PRINT 20                                                           R2FHWMO
   20 FORMAT (1H )                                                       R2FHWMO
    5 LINE = LINE + 1                                                    R2FHWMO
  
      IF (P .GT. 5) GO TO 1000
      PTR = HCF(P)                                                       R2FHWMO
      IF ((PTR .LE. 0) .OR. (PTR .GT. 7)) GO TO 1000
      P = P + 1 
  
*        JUMP TO PRINT AS CALLED BY POINTER 
      GO TO (100,200,300,400,500,600,700) PTR 
  
  
  100 PRINT 9000
 9000 FORMAT(2X,'THE FOLLOWING TAPES HAVE EXCESSIVE ERRORS AND SHOULD'
     , ,' BE CLEANED'/'  AND/OR VERIFIED AS SOON AS POSSIBLE.') 
      GO TO 2                                                            R2FHWMO
  
  
  200 PRINT 9002, TYPORD
 9002 FORMAT (33X,'  BLOCKS     RD-PE    WR-PE      CORRECTED MF',/ 
     .,'  VSN     DATE     JOB   DT ',A4,' READ   WRTN' 
     .,'  RCV URV  RCV URV    RD     WR ID')
      GO TO 2                                                            R2FHWMO
  
  
  300 PRINT 9003
 9003 FORMAT (25X,'TOTAL       BLOCKS   ' 
     .,'    RD-PE      WR-PE',/ 
     .,'  VSN    PERIOD COVERED  MOUNT    READ    WRTN' 
     .,'   RCV  URV   RCV  URV')
      GO TO 2                                                            R2FHWMO
  
  
  400 PRINT 9004
 9004 FORMAT (2X,40H*** UNRECOVERED PARITY ERRORS *** 
     .,/,25X,'TOTAL       BLOCKS   '
     .,'    RD-PE      WR-PE',/ 
     .,'  VSN    PERIOD COVERED  MOUNT    READ    WRTN' 
     .,'   RCV  URV   RCV  URV')
      GO TO 2                                                            R2FHWMO
  
  500 PRINT 9005
 9005 FORMAT(2X,'THE FOLLOWING GRAPH REPRESENTS THE ''ADJUSTED'' ERROR '
     .  ,'RATE FOR ALL DRIVES'/'  WHICH HAD ERRORS LOGGED AGAINST THEM' 
     .   ,' FOR TAPES WHICH DID NOT HAVE'/'  EXCESSIVE ERRORS.'// 
     .    '   NOTE --- USAGE HAS NOT BEEN TAKEN INTO ACCOUNT ---'/) 
      GO TO 5 
  
  600 PRINT 9006
 9006 FORMAT (25X,'TOTAL       BLOCKS   ' 
     .,'    RD-PE      WR-PE    CORRECTED',/
     .,'  VSN    PERIOD COVERED  MOUNT    READ    WRTN' 
     .,'   RCV  URV   RCV  URV   RD    WR') 
      GO TO 2 
  
  700 PRINT 9007
 9007 FORMAT(30X,'TOTAL   STRPS  WR  STRPS   STRPS  RD UNRC SVR FMT',/, 
     .5X,'CSN     PERIOD COVERED   MOUNT    WRTN CHK  D-MRK    READ CHK'
     .,' READ CHK CHK') 
      GO TO 2 
  
  
 1000 CONTINUE                                                           R2FHWMO
      RETURN
      END 
      SUBROUTINE PRINT9 (LT,NW) 
* 
**        PRINT9 -- PRINT A  LINE OF DATA AS CALLED BY
*                   ROUTINES IN OVERLAY (5,0) 
* 
*       ENTRY CONDITIONS -
*       ------------------
*          LT = FORMAT STATEMENT TO BE USED 
*          NW = NUMBER OF WORDS TO BE PRINTED 
* 
*CALL,HPACOM1 
  
      DIMENSION IFORM(7,10), FMT(7) 
  
      DATA (IFORM(I,1), I=1,7,1)  / 
     .10H(1X,R6,1X,,10HA8,1X,R7,1,10HX,R6,I6.0,,10HI7.0,2(I5.,10H0,I4.0)
     .,I6,10H.0,I7.0,2X,10H,R1)         / 
  
  
      DATA (IFORM(I,2), I=1,6,1) /
     .10H(1X,R6,1X,,10HA8,1H-,A8,,10HI5,2I8.0,3,10H(I6.0,I5.0,10H)) 
     .   ,10H          /
  
  
      DATA (IFORM(I,3), I=1,3,1) /10H(A10)     ,10H          ,10H 
     +   /
  
  
      DATA (IFORM(I,4), I=1,3,1) /10H(2X,7A10,A,10H6)        ,10H 
     +   /
  
      DATA (IFORM(I,5),I=1,6,1)  /
     .10H(1X,'TOTAL,10H VSN COUNT,10H = ',I5)  ,10H          ,10H 
     .   ,10H          /
  
  
      DATA (IFORM(I,6),I=1,6,1) / 
     .10H(1X,'VSN =,10H ',R6,2X,A,10H8,1H-,A8,',10H  HAD ',I6,10H,' ERRO
     .RS.,10H')        /
  
      DATA (IFORM(I,7), I=1,6,1)  / 
     .10H(1X,'INSUF,10HFICENT DAT,10HA TO EVALU,10HATE UNITS.,10H',A1)
     .   ,10H          /
  
*     WRITE BAD UNIT MESSAGE
  
      DATA (IFORM(I,8),I=1,6,1) / 
     .10H(1X,'PLEAS,10HE RUN TAPE,10H DIAGNOSTI,10HC ON UNIT ,10H',A4)
     .   ,10H          /
  
      DATA (IFORM(I,9),I=1,6,1) / 
     .10H(/,1X,' TO,10HTAL ERROR ,10HCOUNT FOR ,10HALL TAPES ,10HIN THIS
     . RU,10HN = ',I8) /
  
      DATA (IFORM(I,10),I=1,7,1) /
     .10H(1X,A10,1X,10H,A8,1H-,A8,10H,I5,1X,I7,,10H1X,I3,1X,I,10H6,1X,I7
     .,1X,10H,I3,1X,I4,,10H2(1X,I3)) /
  
      IF (LINE .LE. PLF) GO TO 5                                         R2FHWMO
      CALL HEADER                                                        R2FHWMO
      CALL PRHEAD9(5)                                                    R2FHWMO
    5 CONTINUE                                                           R2FHWMO
                                                                         R2FHWMO
      LINE = LINE + 1 
      DO 8 J=1,7
       FMT(J)=IFORM(J,LT) 
  8   CONTINUE
      PRINT FMT, (PL(J),J=1,NW) 
  
      DO 50 K = 1,NW
   50 PL(K) = 1H
      RETURN
      END 
      SUBROUTINE RDATE9 
* 
**       RDATE9 GETS DATE FROM CURRENT MESSAGE RECORD 
*             CONVERTS JULIAN DATE INTO CALENDER DATE,
* 
*         DATA AREAS
*         --------------------- 
*         IMON   - (12)/LOCAL TO SUBROUTINE/TABLE OF DAYS OF
*                  EACH MONTH IN THE YEAR.
*         IT     - (1)/LOCAL TO SUBROUTINE/TEMPORARY USAGE. 
*         NYEAR  - (1)/LOCAL TO SUBROUTINE/FORMAL PARAMETER OF
*                  YEAR IN BINARY FORM BIASED BY 1970 AT ENTRY, 
*                  AND THE CALENDER DATE IN CODED FORM AT EXIT. 
*         NDAY   - (1)/LOCAL TO SUBROUTINE/FORMAL PARAMETER OF
*                  JULIAN DAY IN BINARY FORM. 
*         JYEAR  - (1)/LOCAL TO SUBROUTINE/YEAR IN BINARY FORM
*                  BIASED BY 1900.
*         KM     - (1)/LOCAL TO SUBROUTINE/COUNTER TO SET THE MONTH 
*                  OF THE YEAR. 
* 
*        EXIT CONDITION 
*        -------------- 
*        CALENDER DAY ENCODED IN COMMON WORD ( IYEAR ), 
*        AND SAVED IN BUFFER ARRAY (SEBUF (23) )
*CALL,HPACOM1 
  
  
      DIMENSION IMON(12)
      DATA (IMON(I),I=1,12) /31,28,31,30,31,30,31,31,30,31,30,31/ 
*       *********************************************************** 
  
  
*          SKIP CONVERSION IF SAME AS PREVIOUS DAY. 
* 
      IF (NDAY .NE. IFLD(7)) GO TO 5
      IF (NYEAR .EQ. IFLD(6)) GO TO 900 
* 
*        CURRENT YEAR AND CURRENT JULIAN DAY
    5 NYEAR = IFLD(6) 
      NDAY = IFLD(7)
      IMON(2)=28
      IT=NYEAR-2
      JDAY = NDAY 
*        TEST FOR LEAP YEAR 
   10 IT = IT-4 
      IF(IT.EQ.0)IMON(2)=29 
      IF (IT .GT. 0) GO TO 10 
* 
      DO 20 KM=1,12 
      IF(JDAY.LE.IMON(KM)) GO TO 50 
      JDAY = JDAY - IMON(KM)
   20 CONTINUE
   50 JYEAR=NYEAR+70
      IF (JYEAR .GT. 99) JYEAR = JYEAR - 100
      ENCODE (8,100,IYEAR) JYEAR,KM,JDAY
  100 FORMAT (I2.2,2('/',I2.2)) 
*           CURRENT MONTH    *******
      FLAGS(6) = KM 
* 
*          FORMAT THE TIME FOR PRINTING 
      ENCODE (8,200,IFLD(20)) IFLD(FTIME),IFLD(FTIME+1),IFLD(FTIME+2) 
  200 FORMAT (I2.2,2(1H.,I2.2) )
  900 RETURN
      END 
      SUBROUTINE TAPREP9
* 
***       DESCRIPTION 
*         ----------- 
*         SUBROUTINE TAPREP9 GENERATES THE FOLLOWING MAGNETIC 
*         TAPE MEDIA REPORTS. 
*         1) TAPE USAGE DETAIL REPORT BY JOB
*            USAGE HISTORY AND PARITY ERROR STATISTICS BY EACH JOB
*            ARE LISTED.
*         2) SUMMARY REPORT 
*            USAGE AND PARITY ERROR STATISTICS FOR EACH TAPE VSN
*            ARE LISTED.
*         3) LIST OF TAPES RATED BY PARITY ERROR RATE 
* 
*         SOURCE DATA FOR THIS REPORT IS ONE OF THE FOLLOWING 
*         FOUR CASES. 
*         1) ALL TAPE ERRORS FROM OLD HISTORY FILE
*         2) ALL TAPE ERRORS FROM NEW HISTORY FILE
*         3) ALL TAPE ERRORS FROM CURRENT SEF FILE
*         4) ALL TAPE ERRORS OF THE GIVEN VSN FROM NEW HISTORY FILE 
*            (OR OLD HISTORY FILE IF NO NEW HISTORY FILE CREATED, 
*             OR CURRENT SEF FILE IF NO HISTORY FILES SPECIFIED)
*         5) TAPE ERRORS SELECTED BY (HW) HISTORY WINDOW PARAMETER       R2FHWMO
* 
*         EXTRACT AND PROCESS FOLLOWING MAGNETIC TAPE ENTRIES.
*         1) CUMULATIVE STATUS ENTRIES
*         2) ENTRIES OF THE FOLLOWING ERRORS
*            ERR CODE     MESSAGE 
*            040B      READ PARITY ERROR
*            041B      WRITE PARITY ERROR 
*            200B      RD-PE OP-MODE
*            201B      RD-PE NON-STOP 
*            202B      RD-PE BKSP READ
*            207B      FIRST TIME RD-PE 
*            210B      FIRST TIME WR-PE 
* 
*         3) TAPE ERRORS WITH THE FOLLOWING ERROR CODES ARE ALSO
*            REPORTED AS "BAD TAPE, UN-RECOVERED ERROR" IN THIS 
*            TAPE MEDIA REPORT. 
*            217B      PERMANENT ERASE ERROR
*            240B      MORE THAN 25 FEET OF BLANK TAPE
*            243B      FALSE READ END-OF-OPERATION, GAP CANT LOCATE 
*            260B      BAD TAPE, CANT WRITE FROM LOAD POINT 
* 
*         EXTRACTED TAPE ERROR ENTRIES ARE SORTED BY
*         MAJOR KEY -   TAPE VSN
*            .      -   RECORD TYPE 
*            .      -   DAY 
*         MINOR KEY -   JOB NAME
* 
*         HPA PARAMETER T  UNCONDITIONALLY TURNS ON THE SUMMARY 
*         REPORT AND THAT OF TAPES RATED BY PARITY ERROR RATE.
*         BUT, WHETHER TO PRINT THE TAPE MEDIA USAGE DETAIL REPORT
*         OR NOT DEPENDS ON THE HPA PARAMETER D.
* 
*         ENTRY CONDITIONS
*         ----------------
*         SOURCE DATA AND TYPE OF REPORTS TO MAKE ARE DEFINED BY
*         HPA PARAMETER T AND D,
*         FILE TAPE8 IS TO BE USED AS SCRATCH FILE. 
* 
*         EXIT CONDITIONS 
*         --------------- 
*         SPECIFIED TAPE MEDIA REPORTS HAVE BEEN GENERATED, 
*         THE ORIGINAL CONTENTS OF SEF FILE(TAPE4) HAS BEEN LOST, 
*         TAPE4(SEF FILE) AND TAPE8 HAVE BEEN REWOUND.
* 
*         DATA AREAS
*         ----------
*         IDX    - ARRAY TO HOLD INDEX VALUE TO SELECT EACH DATA
*                  ITEM IN ARRAY PRIM AND SECO
*         PRIM   - ARRAY TO HOLD DATA FOR ONE LINE OF TAPE MEDIA
*                  DETAIL REPORT
*         SECO   - ARRAY TO HOLD DATA FOR ONE LINE OF TAPE MEDIA
*                  SUMMARY REPORT 
*         IHDR   - VALUE TO SELECT PROPER REPORT HEADER 
*         HCF(5) - VALUE TO SELECT PROPER REPORT SUB-HEADER 
*         FEOF(SCR1)   - FLAG TO INDICATE EOF STATUS OF FILE
*         FVSN   - FLAG TO INDICATE CHANGE IN TAPE VSN
*         FRTP   - FLAG TO INDICATE CHANGE IN RECORD TYPE 
*         FDAY   - FLAG TO INDICATE CHANGE IN DAY 
*         JJOB   - FLAG TO INDICATE CHANGE IN JOB NAME
*         IYEAR  - HOLD DATE FORMATTED FOR PRINT OUT AS XX/XX/XXBB
*                  SET BY ROUTINE UNJUL VIA ROUTINE RDATE 
*         PL  - HOLD ONE LINE OF DATA TO PRINT IN VARIOUS REPORTS 
*         IFLD   - ARRAY TO HOLD PARSED SEF RECORD
* 
*         CALLED BY 
*         --------- 
*         PROGRAM HPA9.                                                  R2FHWMO
* 
*         CALLS 
*         ----- 
*         SETFLDS - PARSE SEF RECORD INTO ARRAY IFLD
*         RDATE9  - GET FORMATTED DATE FROM CURRENT SEF RECORD           R2FHWMO
*         PRINT9 - PRINT A LINE OF DATA FOR VARIOUS REPORTS 
* 
*CALL,HPACOM1 
*CALL HPACOM9 
      EQUIVALENCE  (IDX(01),IRT   ),
     .             (IDX(02),IVSN  ),
     .             (IDX(03),IDAYTO),
     .             (IDX(04),IRTRY ,IDAYFM), 
     .             (IDX(05),IMOUNT),
     .             (IDX(06),IBLKR ),
     .             (IDX(07),IBLKW ),
     .             (IDX(08),IRPRCV),
     .             (IDX(09),IRPURV),
     .             (IDX(10),IWPRCV),
     .             (IDX(11),IWPURV),
     .             (IDX(12),IJOB  ),
     .             (IDX(13),IDTEST),
     .             (IDX(14),ICH   ),
     .             (IDX(15),IEQ   ),
     .             (IDX(16),IUNIT ),
     .             (IDX(17),IRDCOR),
     .             (IDX(18),IWRCOR) 
  
      DIMENSION ACCEST(31,2)                                             R2FHWMO
                                                                         R2FHWMO
      CALL LOVCAP ('SETFLDS') 
  
      DO 50 I=1,31                                                       R2FHWMO
      COUNT(I,1) = COUNT(I,2) = 0 
   50 ACCEST(I,1) = ACCEST(I,2) = 0                                      R2FHWMO
                                                                         R2FHWMO
      FVSN=FDAY=JEST=JJOB=NEST=TSTERR=NXEST=NENTRYS=0                    R2FHWMO
      CALL RMREWND (SCR1) 
      CALL RMREWND (SCR2) 
  
  
*     SET PARAMETERS TO CONTROL PRINT-OUT.
  
      IHDR=15 
  
*     CLEAR ARRAY FOR DETAIL/SUMMARY REPORT DATA. 
  
  
      DO 72 I = 1,18
      PRIM(I)=SECO(I)=0 
   72 CONTINUE
  
  
*     READ OUT FIRST ENTRY FROM INPUT FILE SEF. 
  
  
      CALL RMREWND (SCR3) 
   80 CALL RMREAD (SCR3,SEFREC,LENGTH)
      IF ((SEFREC(3) .AND. MASK(48)) .EQ. L" CONTINU") GO TO 80 
      CALL SETFLDS ('IFLD') 
      CALL RDATE9 
      MTY = SEFREC(1) .AND. O"7777" 
*          AFFIX CONTINUATION REEL NUMBER 
      REEL = SHIFT (IFLD(26),48) .OR. IFLD(25)
  
*   MASK OUT EXTRANEOUS BITS - KEEP VSN AND CONTINUATION REEL NUMBER
      IF (RTY .EQ. O"47") REEL = SHIFT (IFLD(22),36) .AND.
     .  O"7777 0000 7777 7777 7777" 
  
      IF (FLAGS(25) .EQ. 0) IEST = IFLD(FEST) 
      IF (FLAGS(25) .NE. 0) IEST = IFLD(FHUID)
      SECO(IDAYFM)=IYEAR
      SVDATE = IFLD(FJDAY).OR.(SHIFT(IFLD(FC7),9))
      MAXDATE = MINDATE = SVDATE
      TMFMDAY = TMTODAY = IYEAR 
  
  
*     CHECK - IF END-OF-FILE CONDITION OF INPUT FILE IS REACHED,
*           - IF THERE ARE CHANGE IN ANY OF THE FOLLOWING KEYWORDS
*              TAPE VSN,
*              EST ORDINAL                                               HPA404S
*              DAY, 
*              JOB NAME.
* 
  
  
  100 IF(FEOF(SCR3).EQ.3HYES) GO TO 200 
      IF(FVSN.EQ.1)  GO TO 200
      IF(FDAY.EQ.1)  GO TO 200
      IF(JJOB.EQ.1)  GO TO 200
      IF(JEST .EQ. 1) GO TO 200                                          HPA404S
  
  
*     ACCUMULATE CURRENT DATA INTO ARRAY PRIM.
  
  
  102 CONTINUE                                                           HPA404S
      PRIM(IVSN) = REEL 
*     SAVE EARLIEST AND LATEST DATES
      ITEMP = IFLD(FJDAY).OR.(SHIFT(IFLD(FC7),9)) 
      IF(ITEMP.LT.MINDATE) GO TO 1210 
      IF(ITEMP.GT.MAXDATE) GO TO 1250 
      GO TO 1300
 1210 CONTINUE
      TMFMDAY = IYEAR 
      MINDATE = ITEMP 
      GO TO 1300
 1250 CONTINUE
      TMTODAY = IYEAR 
      MAXDATE = ITEMP 
 1300 PRIM(IDAYTO) = IYEAR
      PRIM(IJOB  )=IFLD(FJOB) 
      IF (FLAGS(25) .EQ. 0)ENCODE(10,1000,PRIM(IDTEST))IFLD(FDT),IEST 
      IF (FLAGS(25) .NE. 0)ENCODE(10,1010,PRIM(IDTEST))IFLD(FDT),IEST 
      PRIM(IEQ   )=IFLD(FCON) 
  
  
  
*     CHECK FOR CORRECTED READ/WRITE ERRORS 
      IF ((MTY .NE. O"2450") .AND. (MTY .NE. O"2451")) GO TO 103
      IF (MTY .EQ. O"2450") THEN
        IF (RTY .NE. O"47") PRIM(IRDCOR) = PRIM(IRDCOR) + IFLD(24)
        IF (RTY .EQ. O"47") PRIM(IRDCOR) = PRIM(IRDCOR) + IFLD(21)
      ENDIF 
      IF (MTY .EQ. O"2451") THEN
        IF (RTY .NE. O"47") PRIM(IWRCOR) = PRIM(IWRCOR) + IFLD(24)
        IF (RTY .EQ. O"47") PRIM(IWRCOR) = PRIM(IWRCOR) + IFLD(21)
      ENDIF 
      GO TO 110 
  
*     CHECK FOR THE CUMULATIVE STATUS ENTRY.
  103 IF (MTY .NE. O"60") GO TO 104 
      IBLKRO = PRIM(IBLKR)
      IBLKWO = PRIM(IBLKW)
      RTY = SHIFT(SEFREC(1),18) .AND. O"777"
      IF ((RTY.EQ.O"30") .OR. (RTY.EQ.O"33") .OR. (RTY.EQ.O"55")) THEN
         PRIM(IBLKR) = ((SHIFT(IFLD(42),12) .AND. O"17 0000") .OR.
     .                  (SHIFT(IFLD(43), 4) .AND. O"00 7760") .OR.
     .                  (SHIFT(IFLD(44),-4) .AND. O"00 0017"))
         PRIM(IBLKW) = ((SHIFT(IFLD(41), 8) .AND. O"17 7400") .OR.
     .                  (SHIFT(IFLD(42),-4) .AND. O"00 0377"))
      ELSEIF (RTY.EQ.O"47") THEN
          PRIM(IBLKW) = SHIFT(IFLD(24),-4) .AND. O"17 7777" 
          PRIM(IBLKR) = ((SHIFT(IFLD(25),12) .AND. O"00 7777") .OR. 
     .                (SHIFT(IFLD(24),12) .AND. O"17 0000"))
      ELSE
      PRIM(IBLKR)=PRIM(IBLKR)+OR(IFLD(40),SHIFT(AND(IFLD(39),O"17"),12))
      PRIM(IBLKW)=PRIM(IBLKW) 
     .+OR(AND(SHIFT(IFLD(39),-4),O"377"),SHIFT(AND(IFLD(38),O"377"),8)) 
      ENDIF 
  
*     WHEN THERE ARE TWO SUCCESSIVE USAGE MESSAGES, 
*     ADD THE OLD AND NEW BLOCK VALUES
      IF ((RTY .EQ. RTYOLD) .AND. (MTY .EQ. MTYOLD)) THEN 
        PRIM(IBLKW) = PRIM(IBLKW) + IBLKWO
        PRIM(IBLKR) = PRIM(IBLKR) + IBLKRO
        IBLKWO = IBLKRO = 0 
      ENDIF 
      GO TO 110 
  
  
*     PROCESS PARITY ERROR ENTRY. 
*        1) SUMMARIZE RETRY COUNT 
*        2) SUMMARIZE PARITY ERROR COUNT
  
  
  104 IF (RTY .EQ. O"47")   IFLD(29) = IFLD(22) .AND. O"1"
      IF (IFLD(16) .EQ. 0)  PRIM(IRTRY) = PRIM(IRTRY) + IFLD(21)
      TSTERR=1
      IF (IFLD(29) .EQ. 0) GO TO 106
  
  
*     SET WRITE PARITY ERROR COUNTS 
  
  
      IF((IFLD(16).EQ.0).AND.(MTY.NE.O"210")) PRIM(IWPRCV)=PRIM(IWPRCV)+
     +1 
      IF(IFLD(16).EQ.1)                  PRIM(IWPURV)=PRIM(IWPURV)+1
      GO TO 110 
  
  
*     SET READ PARITY ERROR COUNTS
  
  
  106 IF((IFLD(16).EQ.0))  PRIM(IRPRCV)=PRIM(IRPRCV)+1
      IF(IFLD(16).EQ.1)  PRIM(IRPURV)=PRIM(IRPURV)+1
  
  
*     CURRENT ENTRY HAS BEEN PROCESSED, 
*     READ IN THE NEXT ENTRY. 
  
  
  110 CALL RMREAD (SCR3,SEFREC,LENGTH)
      IF ((SEFREC(3) .AND. MASK(48)) .EQ. L" CONTINU") GO TO 110
      CALL SETFLDS ('IFLD') 
      CALL RDATE9 
      MTYOLD = MTY
      RTYOLD = RTY
      MTY = SEFREC(1) .AND. O"7777" 
      RTY = SHIFT (SEFREC(1),18) .AND. O"777" 
*          AFFIX CONTINUATION REEL NUMBER 
      REEL = SHIFT (IFLD(26),48) .OR. IFLD(25)
  
*   MASK OUT EXTRANEOUS BITS - KEEP CONT REEL NUMBER AND VSN ONLY 
      IF (RTY .EQ. O"47") REEL = SHIFT (IFLD(22),36) .AND.
     .  O"7777 0000 7777 7777 7777" 
  
      IF (FLAGS(25) .NE. 0) GO TO 130 
      IF (((IEST.EQ.IFLD(FEST)) .AND. (PRIM(IVSN).EQ.REEL)) .AND. 
     .(FEOF(SCR3).NE.3HYES)) GO TO 150                                   R2FHWMO
      OLDEST = IEST 
      IEST = IFLD(FEST) 
      GO TO 140 
  
  130 IF (((IEST.EQ.IFLD(FHUID)) .AND. (PRIM(IVSN).EQ.REEL)) .AND.
     .(FEOF(SCR3) .NE. 3HYES)) GO TO 150
      OLDEST = IEST 
      IEST = IFLD(FHUID)
  
  140 CONTINUE
      IF (TSTERR.NE.0) NEST = NEST + 1
      TSTERR = 0
  150 CONTINUE                                                           R2FHWMO
  
*     CHECK TO SEE IF ANY OF THE FOLLOWING KEY-WORDS HAVE CHANGED.
*     AND IF SO, SET THE CORRESPONDING FLAG TO 1 ACCORDINGLY. 
*     KEY WORD - END-OF-FILE OF INPUT FILE
*                TAPE VSN 
*                RECORD TYPE
*                DAY
*                JOB NAME 
*                EST ORDINAL                                             HPA404S
  
      IF (FLAGS(25) .EQ. 0)ENCODE(10,1000,NEWEST)IFLD(FDT),IEST 
      IF (FLAGS(25) .NE. 0)ENCODE(10,1010,NEWEST)IFLD(FDT),IEST 
      FVSN=FDAY=JEST=JJOB=0                                              HPA404S
      IF (PRIM(IVSN) .NE. REEL) FVSN = 1
      IF(PRIM(IDAYTO).NE.IYEAR)      FDAY=1 
      IF(PRIM(IJOB  ).NE.IFLD(FJOB)) JJOB=1 
      IF(PRIM(IDTEST) .NE. NEWEST) JEST = 1                              HPA404S
      GO TO 100 
  
*     ONE OR MORE OF THE KEY WORDS HAVE CHANGED.
*     CALCULATE PARITY ERROR RATE AND AVARAGE RETRY COUNT, AND
*     PRINT OUT ONE LINE OF TAPE USAGE DETAIL REPORT AS REQUIRED BY 
*     THE HPA PARAMETER D.
  
  
  200 CONTINUE
      IF((FROG(5).EQ.L"D").OR.(FROG(5).EQ.L"DS").OR.(FROG(5).EQ.L"SD")) 
     .                                    GO TO 201 
      GO TO 210 
  
  201 CONTINUE
      CALL LOAPR (1,PRIM(IVSN),PRIM(IDAYTO),PRIM(IJOB),PRIM(IDTEST),     R2FHWMO
     .PRIM(IBLKR),PRIM(IBLKW),PRIM(IRPRCV),PRIM(IRPURV))                 R2FHWMO
      PL(9) = PRIM(IWPRCV)                                               R2FHWMO
      PL(10) = PRIM(IWPURV)                                              R2FHWMO
      PL(11) = PRIM(IRDCOR) 
      PL(12) = PRIM(IWRCOR) 
      PL(13) = MFID 
      IF ((SHIFT(PL(3),12).AND.MASK(6)) .NE. L" ")PL(3)=SHIFT(PL(3),-6) 
  
      IF (HCF(5) .NE. 2) THEN 
         HCF(5) = 2 
         CALL HEADER
         CALL PRHEAD9 (5) 
      ENDIF 
  
*     PRINT ONE LINE OF USAGE DETAIL REPORT.
  
      CALL PRINT9(1,13)                                                  R2FHWMO
  
*     INCREMENT MOUNT COUNT 
  
  210 PRIM(IMOUNT) = PRIM(IMOUNT) + 1 
      CALL RMWRITE (SCR1,PRIM,18) 
  
*     BUILD DATA FOR SUMMARY REPORT - 
*     ADD DATA IN ARRAY PRIM(I) TO THOSE IN ARRAY SECO(I).
  
      DO 212 I = IRT,IDAYTO,1 
  212 SECO(I)=PRIM(I) 
  
      DO 214 I=IMOUNT,IWPURV,1
      SECO(I)=SECO(I)+PRIM(I) 
  214 CONTINUE
      SECO(IRDCOR) = SECO(IRDCOR) +  PRIM(IRDCOR) 
      SECO(IWRCOR) = SECO(IWRCOR) +  PRIM(IWRCOR) 
  
*     EXCLUDE CORRECTED READ/WRITE ERRORS FROM CALCULATION
      IF ((MTY.EQ. O"2450") .OR. (MTY .EQ. O"2451")) GO TO 218
* 
      PRUS = PRIM(IBLKR)+PRIM(IBLKW)
      IF(PRUS.LT.1000) PRUS = 1000
      IF (NXEST.EQ.0) GO TO 217                                          R2FHWMO
      DO 216 I = 1,NXEST                                                 R2FHWMO
      IF (OLDEST .NE. ACCEST(I,1)) GO TO 216                             R2FHWMO
      ACCEST(I,2) = ACCEST(I,2) +                                        R2FHWMO
     .((PRIM(IRPRCV)*2+PRIM(IWPRCV)*2+PRIM(IRPURV)+PRIM(IWPURV)*5)
     .*1000/PRUS) 
      GO TO 218                                                          R2FHWMO
  216 CONTINUE                                                           R2FHWMO
  217 IF (NXEST .EQ. 31) GO TO 218                                       R2FHWMO
      NXEST = NXEST +1                                                   R2FHWMO
      ACCEST(NXEST,1) = OLDEST                                           R2FHWMO
      ACCEST(NXEST,2) = ((PRIM(IRPRCV)*2+PRIM(IWPRCV)*2+PRIM(IRPURV)+    R2FHWMO
     .PRIM(IWPURV)*5)*1000/PRUS)                                         R2FHWMO
  
*     CLEAR ARRAY PRIM(I) FOR THE NEXT DETAIL REPORT. 
  
  218 DO 219 I = 1,18,1 
  219 PRIM(I) = 0                                                        R2FHWMO
  
*     CHECK TO SEE IF TAPE VSN HAS CHANGED. 
  
      IF ((FVSN.EQ.0).AND.(FEOF(SCR3).NE.3HYES)) GO TO 300               R2FHWMO
  
*     EXCLUDE CORRECTED READ/WRITE ERRORS FROM CALCULATION
      IF ((MTY.EQ. O"2450") .OR. (MTY .EQ. O"2451")) GO TO 220
  
*     TAPE VSN HAS CHANGED OR EOF HAS OCCURRED                           R2FHWMO
*     SAVE DATA FOR SUMMARY REPORT AND WRITE IT ONTO
*     THE SCRATCH FILE SUMMARY, AND 
*     PREPARE ARRAY SECO(I) FOR THE NEXT SUMMARY REPORT.
  
      ERRCNT=(SECO(IRPRCV)+3*SECO(IRPURV)+SECO(IWPRCV))*NEST
      SECO(16)=NEST 
      NEST = 0                                                           R2FHWMO
                                                                         R2FHWMO
*        IF VSN EXTRACT NOT SELECTED
      IF((AERRSUM.EQ.0).OR.(AENTRYS.EQ.0)) GO TO 220
      IF(FROG(10).EQ.3HOFF) 
     .   SECO(IEQ) = (ERRCNT/SQRT(AERRSUM/(AENTRYS*2.)))*100
  220 CONTINUE
      SECO(IDAYFM) = TMFMDAY
      SECO(IDAYTO) = TMTODAY
      CALL RMWRITE (SCR2,SECO,18) 
  
*     EXCLUDE CORRECTED READ/WRITE ERRORS FROM CALCULATION
      IF ((MTY.EQ. O"2450") .OR. (MTY .EQ. O"2451")) GO TO 280
  
      IF (NXEST .EQ.0) GO TO 280                                         R2FHWMO
      DO 270 I = 1,NXEST                                                 R2FHWMO
      IF(SECO(IEQ) .GE. 300) GO TO 270
      IF (NENTRYS .EQ. 0) GO TO 260                                      R2FHWMO
      DO 250 IMV = 1,NENTRYS                                             R2FHWMO
      IF (ACCEST(I,1) .NE. COUNT(IMV,1)) GO TO 250                       R2FHWMO
      COUNT(IMV,2) = COUNT(IMV,2) + ACCEST(I,2)                          R2FHWMO
      GO TO 270                                                          R2FHWMO
  250 CONTINUE                                                           R2FHWMO
      DO 255 IMV = 1,NENTRYS                                             R2FHWMO
      IF (ACCEST(I,1) .GT. COUNT(IMV,1)) GO TO 255                       R2FHWMO
      TEMPA = COUNT(IMV,1)                                               R2FHWMO
      TEMPB = COUNT(IMV,2)                                               R2FHWMO
      COUNT (IMV,1) = ACCEST(I,1)                                        R2FHWMO
      COUNT (IMV,2) = ACCEST(I,2)                                        R2FHWMO
      ACCEST(I,1) = TEMPA                                                R2FHWMO
      ACCEST(I,2) = TEMPB                                                R2FHWMO
  255 CONTINUE                                                           R2FHWMO
  260 CONTINUE                                                           R2FHWMO
      IF (NENTRYS .EQ. 31) GO TO 270                                     R2FHWMO
      NENTRYS = NENTRYS + 1                                              R2FHWMO
      COUNT(NENTRYS,1) = ACCEST(I,1)                                     R2FHWMO
      COUNT(NENTRYS,2) = ACCEST(I,2)                                     R2FHWMO
  270 ACCEST(I,1) = ACCEST(I,2) = 0                                      R2FHWMO
      NXEST = 0                                                          R2FHWMO
  280 CONTINUE                                                           R2FHWMO
                                                                         R2FHWMO
      DO 290 I = IRT,IWPURV,1                                            R2FHWMO
  290 SECO(I) = 0                                                        R2FHWMO
      SECO(IRDCOR) = 0
      SECO(IWRCOR) = 0
      SECO(IEQ) = 0 
  
*     RESET DAY-FROM
  
      SECO(IDAYFM)=IYEAR
      SVDATE = IFLD(FJDAY).OR.(SHIFT(IFLD(FC7),9))
      MAXDATE = MINDATE = SVDATE
      TMFMDAY = TMTODAY = IYEAR 
  
      IF ((FROG(5).EQ.L"D").OR.(FROG(5).EQ.L"DS").OR.(FROG(5).EQ.L"SD"))
     .   CALL PRINT9(3,1) 
  
*     CHECK IF THE END-OF-FILE OF INPUT FILE IS REACHED.
  
  300 IF (FEOF(SCR3) .NE. 3HYES) GO TO 102                               R2FHWMO
  
  800 CALL UOVCAP ('SETFLDS') 
  
*     REWIND TAPE AND EXIT
  
      CALL RMREWND (SCR3) 
* 
      CALL RMFILEM (SCR2) 
      CALL RMFILEM (SCR2) 
      CALL RMREWND (SCR2) 
      CALL RMFILEM (SCR1) 
      CALL RMFILEM (SCR1) 
      CALL RMREWND (SCR1) 
      RETURN
  
 1000 FORMAT(4X,R2,1X,O3) 
1010  FORMAT(4X,R2,I4)
      END 
      SUBROUTINE WTT9 
*                                                                        R2FHWMO
**       WTT9 GENERATES MEDIA REJECTION AND UNIT EVALUATION REPORTS.     R2FHWMO
* 
*        DATA AREAS 
*        ---------- 
*        FROG(10) = VSN 
* 
*        CALLS
*        -----
*        PRINT9   - PRINT DATA
* 
*CALL,HPACOM1 
*CALL HPACOM9 
*     DIMENSION IGTITL(4), IYTITL(2), IXTITL(2) 
      DIMENSION IVAL(31,2), XVAL(64)
  
      EQUIVALENCE  (IDX(01),IRT   ),
     .             (IDX(02),IVSN  ),
     .             (IDX(03),IDAYTO),
     .             (IDX(04),IRTRY ,IDAYFM), 
     .             (IDX(05),IMOUNT),
     .             (IDX(06),IBLKR ),
     .             (IDX(07),IBLKW ),
     .             (IDX(08),IRPRCV),
     .             (IDX(09),IRPURV),
     .             (IDX(10),IWPRCV),
     .             (IDX(11),IWPURV),
     .             (IDX(12),IJOB  ),
     .             (IDX(13),IDTEST),
     .             (IDX(14),ICH   ),
     .             (IDX(15),IEQ   ),
     .             (IDX(16),IUNIT ),
     .             (IDX(17),IRDCOR),
     .             (IDX(18),IWRCOR) 
  
*     DATA (IGTITL(I),I=1,4)  / 
*    .10H     UNIT ,10HRELATIVE E,10HRROR INDIC,10HATOR      /
*     IYTITL(1) = 10HPROBLEM
*     IYTITL(2) = 10H LEVEL 
*     IXTITL(1) = 10H    LOGICA 
*     IXTITL(2) = 10HL UNIT 
  
      SUM = 0                                                            R2FHWMO
      IHDR = 21                                                          R2FHWMO
      HCF(5) = 1
      CALL HEADER 
      CALL PRHEAD9 (5)
  
      PRINT 200 
  200 FORMAT(9X,'---------------------------------------------------',
     ./,9X,'THREE ERRORS AND ASSOCIATED VSNS HAVE BEEN EXCLUDED', 
     ./,9X,'FROM FURTHER TAPE MEDIA SUMMARIZATION:',
     ./,20X,'GCR SINGLE-TRACK CORRECTED READ;', 
     ./,20X,'GCR SINGLE-TRACK CORRECTED WRITE;',
     ./,20X,'66X/67X LATE DATA MESSAGES.',
     ./,9X,'---------------------------------------------------',/) 
  
      PL(1) = AENTRYS 
      CALL PRINT9 (5,1) 
      IF(AENTRYS.LT.100) PRINT 3000 
 3000 FORMAT(1X,'100 TAPE VSNS ARE REQUIRED FOR MEDIA EVALUATION')
      IF(AERRSUM.LT.100) PRINT 3010 
 3010 FORMAT(1X,'TOO FEW ERRORS TO EVALUATE MEDIA ')
      IF((AENTRYS.LT.100).OR.(AERRSUM.LT.100)) RETURN 
* 
*     TAPE MEDIA REJECTION CRITERIA PROCESSING
  
      CALL RMREWND (SCR2) 
  500 CALL RMREAD (SCR2,SECO,LENGTH)
      IF (FEOF(SCR2) .EQ. 3HYES) GO TO 700
      PL(1)=SECO(IVSN)
      PL(2) = SECO(IDAYFM)
      PL(3) = SECO(IDAYTO)
      PL(4) = SECO(IRPRCV)+SECO(IRPURV)+SECO(IWPRCV)+SECO(IWPURV) 
      SUM = SUM + PL(4) 
      IF(SECO(IEQ) .GE. 300) CALL PRINT9(6,4) 
*      PROCESSING FOR REMOVING BAD TAPES FROM ERROR COUNT ON UNITS
      GO TO 500 
  
  700 CONTINUE
      PL(1) = SUM                                                        R2FHWMO
      CALL PRINT9(9,1)                                                   R2FHWMO
                                                                         R2FHWMO
  
*      CALL CHART ROUTINE FOR EQUIPMENT RANKING 
  
      IF (NENTRYS .EQ. 0) RETURN                                         R2FHWMO
      DO 800 I = 1,NENTRYS                                               R2FHWMO
      IVAL(I,1) = COUNT(I,2)                                             R2FHWMO
      XVAL(I) = COUNT(I,1)                                               R2FHWMO
  800 CONTINUE
  
*      SEE IF CHART IS NEEDED 
  
      IXMAX = NENTRYS                                                    R2FHWMO
      SUM = 0                                                            R2FHWMO
      DO 810 I = 1,IXMAX
  810 SUM = SUM + IVAL(I,1) 
      AVG = SUM/IXMAX 
      PL(1) = 10H 
      ALIMIT = 15 
      IF (AVG .LE. ALIMIT) CALL PRINT9(7,1) 
      IF (AVG .LE. ALIMIT) RETURN 
  
*     TO RESTORE VERTICAL GRAPH, DELETE NEXT 3 LINES. 
      HCF(5) = 5
      CALL HEADER 
      CALL PRHEAD9 (5)
  
      CALL XOVCAP ('GRAPH9',COUNT,NENTRYS)
      CALL UOVCAP ('GRAPH9')
  
*     CALL HEADER 
* 
*     PRINT 1 
*   1 FORMAT(2X,'THE FOLLOWING GRAPH REPRESENTS THE ''ADJUSTED'' ERROR '
*    ,  ,'RATE FOR ALL DRIVES'/'  WHICH HAD ERRORS LOGGED AGAINST THEM' 
*    ,   ,' FOR TAPES WHICH DID NOT HAVE'/'  EXCESSIVE ERRORS.'//'  WHEN
*    , '  ,'EXAMINING THE GRAPH, THE UNIT(S) WITH THE HIGHEST PLOT SHOUL
*    ,D BE'/'  WORKED ON FIRST.') 
*     LINE = LINE + 5 
*     IX = IXMIN = 1
*     CALL CHART9 (IGTITL,IYTITL,IXTITL,IXMAX,IXMIN,IX,IVAL,XVAL) 
  
*     TEST FOR UNIT WITH EXCESSIVE ERRORS 
  
      ASUM = AMEAN = 0
  
*     COMPUTE ARITHMETIC MEAN 
  
      DO 850 I =1,IXMAX 
  850 ASUM = ASUM + IVAL(I,1) 
      AXMAX = IXMAX 
      AMEAN = ASUM/AXMAX
  
*      COMPUTE STANDARD DISTROBUTION
  
      ASUM = 0
      DO 860 I = 1,IXMAX
  860 ASUM = ASUM + ((IVAL(I,1)-AMEAN)**2)
      ASD = SQRT(ASUM/AXMAX)
  
*     COMPUTE SCORE FOR EACH DEVICE 
  
      DO 870 I = 1,IXMAX
      ASCORE = (IVAL(I,1)-AMEAN)/ASD
      IF(ASCORE .LT. 2.00) GO TO 870
      IF(FLAGS(25) .EQ. 0) ENCODE(10,1000,PL(1)) XVAL(I)
      IF(FLAGS(25) .NE. 0) ENCODE(10,1010,PL(1)) XVAL(I)
      CALL PRINT9(8,1)
* 
  870 CONTINUE
      RETURN
1000  FORMAT(O2,8X) 
1010  FORMAT(I4,6X) 
      END 
      OVCAP.
      SUBROUTINE GRAPH9 (ARRAY,NENTRYS) 
* 
**       DESCRIPTION
*        -----------
*        GRAPH9 DEVELOPS AND PRINTS A HORIZONTAL GRAPH
*               AS DEFINED BY THE CALLING ROUTINE.
* 
*        ENTRY CONDITIONS 
*        ---------------- 
*        ARRAY - CONTAINS THE VALUES TO BE GRAPHED. 
*        NENTRY - MAXIMUM NUMBER OF VALUES TO BE GRAPHED. 
* 
*        EXIT CONDITIONS
*        ---------------
*        LINE HAS BEEN UPDATED TO REFLECT THE NUMBER
*             OF HORIZONTAL GRAPH LINES PRINTED.
* 
*        CALLS
*        -----
*        NONE 
  
*CALL HPACOM1 
  
      DIMENSION ARRAY(31,2),IZ(14)
  
      DATA (IZ(I),I=1,14) / 
     .1,2,4,5,10,20,25,50,100,200,250,500,1000,2000/
  
      DATA NDVSN,STAR / 60,1H* /
  
*        FIND LARGEST VALUE IN ARRAY
      XMAX = 0
      DO 210 I=1,NENTRYS
      IF (ARRAY(I,2) .GT. XMAX) XMAX = ARRAY(I,2) 
  210 CONTINUE
  
      DO 350 I=1,14 
      IF (NDVSN * IZ(I) .LT. XMAX) GO TO 350
      DELTAX = IZ(I)
      GO TO 360 
  350 CONTINUE
  
*        PRINT GRAPH TITLE
  360 PRINT 1000
      LINE = LINE + 1 
  
*        PRINT Y-AXIS TITLE 
      PRINT 1010
      LINE = LINE + 1 
  
*        PRINT GRAPH
      DO 500 I=1,NENTRYS
      IEST = ARRAY(I,1) 
      IF (FLAGS(25) .EQ. 0) ENCODE(10,1100,IORD) IEST 
      IF (FLAGS(25) .NE. 0) ENCODE(10,1110,IORD) IEST 
      NSTARS = ARRAY(I,2)/DELTAX + 0.5
      IF (NSTARS .GT. 0) GO TO 480
      PRINT 1020,IORD 
      GO TO 490 
  480 PRINT 1030,IORD,(STAR,J=1,NSTARS) 
  490 LINE = LINE + 1 
  500 CONTINUE
  
*        PRINT GRAPH BOTTOM LINE AND X INDICES
      DO 550 I=1,6
  550 PL(I) = 10 * I * DELTAX 
      PRINT 1040,(PL(I),I=1,6)
  
*        PRINT X TITLE
      PRINT 1050
      RETURN
 1000 FORMAT (19X,'UNIT RELATIVE ERROR INDICATOR')
 1010 FORMAT (2X,'UNIT')
 1020 FORMAT(2X,A4,2H .)
 1030 FORMAT(2X,A4,2H .,60A1) 
 1040 FORMAT (7X,6('+.........'),'+',/,7X,'O',6I10) 
 1050 FORMAT (7X,' PROBLEM LEVEL',//) 
 1100 FORMAT(1X,O3.0,6X)
 1110 FORMAT(I4.0,6X) 
      END 
