*DECK HPA33 
      OVCAP.
      SUBROUTINE HPA33
*             CONTROL PROGRAM FOR SECONDARY OVERLAY (3,3) 
* 
*CALL,HPACOM1 
  
      IF (FROG(6) .NE. L"T") GO TO 10 
      CALL SECOND (CP)
      PRINT 9,CP
    9 FORMAT ( ' ENTER HPA33, SECOND = ',F10.3) 
   10 CONTINUE
  
      IF (RTY .EQ. O"47") GO TO 700 
      GO TO (50,50,50,50,500,50,50,50,50,500) OVCALL
* 
*           MESSAGES NOT PROCESSED, GET NEXT RECORD 
   50 CALL GNR3 
      CALL SETEM3(1)
      GO TO 1000
  
  
*            MAGNETIC TAPE ENTRIES
  500 CALL AN3MT3 
      GO TO 1000
  
  700 CONTINUE
      CALL AN3CT3 
      GO TO 1000
 1000 CONTINUE
      END 
      SUBROUTINE AN3CT3 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE AN3CT3 CALLS VARIOUS SUBROUTINES TO PROCESS
*         SEF INPUT RECORDS FOR CARTRIDGE TAPE DEVICES AND DEVELOP
*         UNIT ANALYSIS REPORT AND DETAIL LIST REPORT.
* 
*         ENTRY CONDITIONS
*         ----------------
*         ENTERED WHEN THE SEF ERROR FILE IS POSITIONED AT THE
*         FIRST INPUT RECORD FOR CARTRIDGE TAPE DEVICES.
* 
*         EXIT CONDITIONS 
*         --------------- 
*         EXIT WHEN THE SEF INPUT RECORD FOR CARTRIDGE TAPE DEVICE
*         IS EXHAUSTED. 
* 
*         DATA AREAS AND FILES
*         --------------------
*         DATA AREAS
*         RCFD   - (1)/COMMON BLOCK/REPORT CONTROL FLAG FOR DETAIL
*                  LIST REPORT. 
*         TWIC   - (1)/COMMON BLOCK/FLAG TO IDENTIFY THE
*                  DUPLICATE CONDITIONS OF SEF INPUT RECORDS. 
*         FLAGS(20)-/COMMON BLOCK/CELL TO HOLD BLOCKS READ FOR THIS 
*                    RECORD.  SET BY DRUSE3.
*         FLAGS(21)-/COMMON BLOCK/CELL TO HOLD BLOCKS WRITTEN FOR 
*                    THIS RECORD.  SET BY DRUSE3. 
*         PRUK    - (2)/COMMON BLOCK/ARRAY TO SUM USAGE FOR THIS
*                    EQUIPMENT FOR PRINTING IN ERDIST3. 
*                    PRUK(1) - BLOCKS READ(INPUT) 
*                    PRUK(2) - BLOCKS WRITTEN(OUTPUT) 
*                    PRUK(3) - MFID 
* 
*         CALLED BY 
*         --------- 
*             PROGRAM HPA33 
* 
*         CALLS 
*         ----- 
*         INISET3  - DO INITIAL PREPARATIONS FOR UNIT ANALYSIS
*                     REPORTS.
*         STOJN3   - SAVE JOB NAME AND TIME VALUES FOR UNIT 
*                     ANALYSIS REPORTS. 
*         DL3CT3   - COLLECTS ALL DATA FOR DETAIL LIST REPORT FOR 
*                     MAGNETIC/CARTRIDGE TAPE DEVICES AND SAVE THEM 
*                     IN TAPE8. 
*         PRINT    - PRINT A LINE OF DATA ON VARIOUS REPORTS. 
*         ERDIST3  - REPORT UNIT ERROR DISTRIBUTION BY JOB NMAE,
*                     TIME AND ERROR TYPES. 
* 
*CALL HPACOM1 
*CALL HPACOM2 
*CALL HPACOM3 
      DIMENSION SUM(217,5,2)
      EQUIVALENCE (SUM(1,1,1),STOR(1,1))
  
      DIMENSION QDENS(1), TYPC(1), TDENS(3) 
      DATA (TYPC(I),I=1,1) /6H 5680 / 
  
*    TDENS IS SET TO DIMENSION 3 TO ACCOMODATE DOUBLE DENSITY CARTRIDGE 
*    TAPE IF NEEDED IN THE FUTURE 
  
      DATA (TDENS(I),I=1,2) /10H     38000,10H          / 
      DATA TFL /0/
  
      CALL LOVCAP ('ACCUM3')
  
   50 CONTINUE
      CALL INISET3
      TMOUNT = 0
  
      IHDR = 8
*     SET UP DETAIL HEADERS 
      MPR (1,1) = O"57" 
      MPR(1,2) = 5
      MPR(2,1) = O"60"
      MPR(2,2) = 12 
      MPR(3,1) = O"2447"
      MPR(3,2) = 5
      MPR(4,1) = O"2452"
      MPR(4,2) = 13 
      MPR(5,1) = O"4677"
      MPR(5,2) = 5
  
*         INITIALIZE AND PRINT UNIT ID. 
      TYPID = 10HTAPE-UNIT
  
*       DENSITY ACCUM ARRAY 
      DO 11 K=1,1 
   11 QDENS(K) = 0
  
*         STORE JOB NAME, TIME
  100 IF (RCFA .EQ. 2HON) CALL STOJN3 
  
*         CONTROLLER-TYPE POINTER 
      IFLD(28) = 1
      HDATA(5) = TYPC(1)
  
*          DERIVE DENSITY 
      IF ((MTY .LT. O"2450") .OR. (MTY .GT. O"2452")) GO TO 101 
      QDENS(1) = QDENS(1) + IFLD(21)
      GO TO 120 
  
  101 CONTINUE
      IDEN = 1
      TDENS(3) = IDEN 
  
*        ACCUMULATE DENSITY SUMMARY IF ERROR MESSAGE TYPE 
      IF (FLAGS(8) .LT. O"10") QDENS(IDEN) = QDENS(IDEN) + 1
  
      IF (RCFA .EQ. 3HOFF) GO TO 200
  
*         COLLECT BLOCKS TRANSFERRED IF CUMULATIVE STATUS - EC=60B
      IF (MTY .NE. O"60") GO TO 140 
      DO 112 I=1,10 
         IF (PRUK(3,I) .EQ. 0) GO TO 114
         IF (PRUK(3,I) .EQ. MFID) GO TO 116 
  112 CONTINUE
*        TABLE FULL 
      IF (TFL .GT. 4) GO TO 210 
         TFL = TFL + 1
         PRINT 1000 
      GO TO 210 
  114 PRUK(3,I) = MFID
  116 CONTINUE
*         BLOCKS READ 
         PRUK(1,I) = PRUK(1,I) + FLAGS(20)
*         BLOCKS WRITTEN
         PRUK(2,I) = PRUK(2,I) + FLAGS(21)
*        TOTAL MOUNTS 
      TMOUNT = TMOUNT + 1 
      GO TO 200 
  
*        SUM CORRECTED READ/WRITE AND LATE DATA MESSAGES
*        AFFIX REEL NUMBER (IF MULTI-REEL)
  120 CONTINUE
*        SUM GCR SINGLE-TRACK CORRECTED READ ERRORS 
      IF (MTY .EQ. O"2450") CALL ACCUM3 (IFLD(21),3)
*        SUM GCR SINGLE-TRACK CORRECTED WRITE ERRORS
      IF (MTY .EQ. O"2451") CALL ACCUM3 (IFLD(21),4)
*        LATE DATA MSGS ARE NOT POSSIBLE SO DO NOT CHECK FOR 2452.
      GO TO 200 
  
*        SUM RECOVERED ERRORS 
  140 CONTINUE
      REEL = SHIFT(IFLD(22),36) .AND. O"7777 7777 7777" 
      IF (IFLD(16) .EQ. 0) CALL ACCUM3 (REEL,2) 
  
*        SUM UNRECOVERED ERRORS 
      IF (IFLD(16) .NE. 0) CALL ACCUM3 (REEL,1) 
  
*        GENERATE A CARTRIDGE DETAIL REPORT 
  200 IF (RCFD .EQ. 2HON) CALL DL3CT3 (TDENS) 
  
*        GET THE NEXT SEF RECORD
  210 CALL GNR3 
      CALL SETEM3(1)
  
*         IF EQUIP CHANGE 
       IF(TWIC.LT.3) GO TO 800
       GO TO 100
  
*   **************************************************
  
  800 IF (RCFA .EQ. 3HOFF) GO TO 820
  
*        GENERATE A CARTRIDGE ANALYSIS REPORT 
      CALL XOVCAP ('ERDIST3',0,0) 
      CALL UOVCAP ('ERDIST3') 
      CALL LOVCAP ('PRSUM3')
* 
*        PRINT TOTAL MOUNTS 
      PL(1) = TMOUNT
      IF (TMOUNT .NE. 0) CALL PRINT33 (2,1) 
  
      HCF(1) = 0
* 
*         PRINT CONTROLLER TYPE 
      PL(1) = HDATA(5)
      CALL PRINT33 (9,1)
* 
*        CHECK FOR DENSITY ERRORS 
      DO 801 I=1,1
  801 IF (QDENS(I) .NE. 0) GO TO 802
      GO TO 804 
  802 CONTINUE
* 
*        PRINT QTY AT DENSITY 
      I = 1 
      PL(1) = TDENS(I)
      PL(2) = QDENS(I)
      CALL PRINT33 (5,2)
  
*        PRINT SUMMARY OF RECOVERED ERRORS
  804 IF (SUM(1,2,2) .EQ. 0) GO TO 808
      HCF(5) = 3
      CALL PHEAD33(5) 
      HDATA(1) = 10H   VSN
      CALL PRSUM3(2,6)
      HCF(5) = 4
      CALL PHEAD33(5) 
  
*        PRINT SUMMARY OF UNRECOVERED ERRORS
      IF (LINE+6 .LE. PLF) GO TO 808
      CALL HEADER 
  808 CONTINUE
      IF (SUM(1,1,2) .EQ. 0) GO TO 810
      HCF(5) = 7
      CALL PHEAD33(5) 
      HDATA(1) = 10H   VSN
      CALL PRSUM3(1,6)
  
*        PRINT SUMMARY OF CORRECTED READ/WRITE AND LATE DATA MSGS 
  810 CALL PRSUM3 (3,17)
      CALL PRSUM3 (4,18)
      CALL UOVCAP ('PRSUM3')
  
  820 IF (FEOF(SEF) .EQ. 3HYES) GO TO 900 
      IF(TWIC.GT.1)GO TO 50 
  
  900 CONTINUE
      CALL UOVCAP ('ACCUM3')
  
      RETURN
  
 1000 FORMAT(1X,' .. BLOCKS READ/WRITTEN TABLE FULL .. AN3CT3 --')
      END 
      SUBROUTINE AN3MT3 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE AN3NT3 CALLS VARIOUS SUBROUTINES TO PROCESS
*         SEF INPUT RECORDS FOR MAGNETIC TAPE DEVICES AND DEVELOP 
*         UNIT ANALYSIS REPORT AND DETAIL LIST REPORT.
* 
*         ENTRY CONDITIONS
*         ----------------
*         ENTERED WHEN THE SEF ERROR FILE IS POSITIONED AT THE
*         FIRST INPUT RECORD FOR MAGNETIC TAPE DEVICES. 
* 
*         EXIT CONDITIONS 
*         --------------- 
*         EXIT WHEN THE SEF INPUT RECORD FOR MAGNETIC TAPE DEVICE 
*         IS EXHAUSTED. 
* 
*         DATA AREAS AND FILES
*         --------------------
*         DATA AREAS
*         RCFD   - (1)/COMMON BLOCK/REPORT CONTROL FLAG FOR DETAIL
*                  LIST REPORT. 
*         TWIC   - (1)/COMMON BLOCK/FLAG TO IDENTIFY THE
*                  DUPLICATE CONDITIONS OF SEF INPUT RECORDS. 
*         FLAGS(20)-/COMMON BLOCK/CELL TO HOLD BLOCKS READ FOR THIS 
*                    RECORD.  SET BY DRUSE3.
*         FLAGS(21)-/COMMON BLOCK/CELL TO HOLD BLOCKS WRITTEN FOR 
*                    THIS RECORD.  SET BY DRUSE3. 
*         PRUK    - (2)/COMMON BLOCK/ARRAY TO SUM USAGE FOR THIS
*                    EQUIPMENT FOR PRINTING IN ERDIST3. 
*                    PRUK(1) - BLOCKS READ(INPUT) 
*                    PRUK(2) - BLOCKS WRITTEN(OUTPUT) 
*                    PRUK(3) - MFID 
* 
*         CALLED BY 
*         --------- 
*             PROGRAM HPA33 
* 
*         CALLS 
*         ----- 
*         INISET3  - DO INITIAL PREPARATIONS FOR UNIT ANALYSIS
*                   REPORTS.
*         STOJN3 - SAVE JOB NAME AND TIME VALUES FOR UNIT ANA-
*                   LYSIS REPORTS.
*         DL3NT3 - COLLECTS ALL DATA FOR DETAIL LIST REPORT FOR 
*                   MAGNETIC TAPE DEVICES AND SAVE THEM IN TAPE8. 
*         PRINT   - PRINT A LINE OF DATA ON VARIOUS REPORTS.
*         ERDIST3   - REPORT UNIT ERROR DISTRIBUTION BY JOB NAME, 
*                   TIME AND ERROR TYPES. 
* 
*CALL,HPACOM1 
*CALL,HPACOM2 
*CALL HPACOM3 
  
      DIMENSION SUM(217,5,2)
      EQUIVALENCE (SUM(1,1,1),STOR(1,1))
  
      DIMENSION QDENS(6), TYPC(7), TDENS(10)
      DATA (TYPC(I),I=1,7) /5H 698 , 8H 66X-MTS, 8H 67X-ATS, 8H 66X-BID,
     .                      5H 65X , 5H FSC , 6H ISMT  /
      DATA (TDENS(I),I=1,6) /10H        LO,10H        HI,10H        HY, 
     .                       10H        HD,10H        PE,10H        GE/ 
      DATA TFL /0/
  
      CALL LOVCAP ('ACCUM3')
  
   50 CONTINUE
      CALL INISET3
      TMOUNT = 0
  
      IHDR = 8
*     SET UP DETAIL HEADERS 
      IBUMP = 0                                                          R2FTAPE
      IF (FROG(18) .EQ. 3HYES) IBUMP = 1                                 R2FTAPE
      MPR (1,1) = O"57" 
      MPR(1,2) = 9 + IBUMP                                               R2FTAPE
      MPR(2,1) = O"60"
      MPR(2,2) = 12 
      MPR(3,1) = O"2447"
      MPR(3,2) = 9 + IBUMP                                               R2FTAPE
      MPR(4,1) = O"2452"
      MPR(4,2) = 13 
      MPR(5,1) = O"4577"
      MPR(5,2) = 16 - IBUMP 
      MPR(6,1) = O"4677"
      MPR(6,2) = 9 + IBUMP
  
      IF ((RTY .GE. O"34") .AND. (RTY .LE. O"37")) GO TO 60 
  
*     SELECT ISMT (RTY 30B), FSC (RTY 33B) AND CMTS (RTY 55B) HEADERS 
      MPR(1,2) = 14 + IBUMP 
      MPR(3,2) = 14 + IBUMP 
      IF (RTY.EQ.O"30") MPR(1,2) = 16 - IBUMP 
      IF (RTY.EQ.O"30") MPR(3,2) = 16 - IBUMP 
   60 CONTINUE                                                           R2FTAPE
  
*         INITIALIZE AND PRINT UNIT ID. 
      TYPID = 10HTAPE-UNIT
  
*       DENSITY ACCUM ARRAY 
      DO 11 K=1,6 
   11 QDENS(K) = 0
  
*         STORE JOB NAME, TIME
  100 IF (RCFA .EQ. 2HON) CALL STOJN3 
  
*         CONTROLLER-TYPE POINTER 
      IFLD(28) = IFLD(28) + 1 
      IF (RTY .EQ. O"33") IFLD(28) = 6
      IF (RTY.EQ.O"30") IFLD(28) = 7
      IF (RTY .EQ. O"55") IFLD(28) = 1
      HDATA(5) = TYPC(IFLD(28)) 
                                                                         R2FTAPE
*          DERIVE DENSITY 
*          DENSITY NOT KNOWN FOR ALL LATE DATA MESSAGES 
      IF ((MTY .LT. O"2450") .OR. (MTY .GT. O"2452")) GO TO 101 
      IF ((MTY .EQ. O"2452") .AND. (IFLD(27) .EQ. 0)) GO TO 120 
      QDENS(6) = QDENS(6) + IFLD(24)
      GO TO 120 
  101 CONTINUE
      IF (RTY .EQ. O"55") GO TO 103 
      GO TO (103,900,900,103,104,105,106,108) RTY - O"27" 
                                                                         R2FTAPE
*          DENSITY FOR FSC/ISMT/CMTS TAPE DRIVES DETERMINED BY NORM 
  103 IDEN = IFLD(31) 
      GO TO 110 
  
*           DENSITY FOR 667 TAPE DRIVES 
  104 IDEN = (SHIFT(IFLD(34),-6) .AND. 3) + 2 
      GO TO 110 
  
*           DENSITY FOR 669 TAPE DRIVES 
  105 IDEN = (SHIFT(IFLD(34),-6) .AND. 3) + 3 
      GO TO 110                                                          R2FTAPE
                                                                         R2FTAPE
*          DENSITY FOR 677 TAPE DRIVES                                   R2FTAPE
  106 IDEN = 2
      IF ((SHIFT(IFLD(39),-8) .AND. 1) .EQ. 0) IDEN = 3 
      GO TO 110                                                          R2FTAPE
                                                                         R2FTAPE
*          DENSITY FOR 679 TAPE DRIVES                                   R2FTAPE
  108 TEMPDEN = (SHIFT(IFLD(39),-3) .AND. 3) + 3
      IDEN = TEMPDEN
      IF (TEMPDEN .EQ. 5) IDEN = 4
      IF (TEMPDEN .LT. 5) IDEN = 5
      GO TO 110                                                          R2FTAPE
                                                                         R2FTAPE
  110 CONTINUE                                                           R2FTAPE
      TDENS(10) = IDEN                                                   R2FTAPE
                                                                         R2FTAPE
*        ACCUMULATE DENSITY SUMMARY IF ERROR MESSAGE TYPE                R2FTAPE
      IF (FLAGS(8) .LT. O"10") QDENS(IDEN) = QDENS(IDEN) + 1
                                                                         R2FTAPE
      IF (RCFA .EQ. 3HOFF) GO TO 200
  
*         COLLECT BLOCKS TRANSFERRED IF CUMULATIVE STATUS - EC=60B
      IF (MTY .NE. O"60") GO TO 140 
      DO 112 I=1,10 
         IF (PRUK(3,I) .EQ. 0) GO TO 114
         IF (PRUK(3,I) .EQ. MFID) GO TO 116 
  112 CONTINUE
*        TABLE FULL 
      IF (TFL .GT. 4) GO TO 210 
         TFL = TFL + 1
         PRINT 1000 
      GO TO 210 
  114 PRUK(3,I) = MFID
  116 CONTINUE
*         BLOCKS READ 
         PRUK(1,I) = PRUK(1,I) + FLAGS(20)
*         BLOCKS WRITTEN
         PRUK(2,I) = PRUK(2,I) + FLAGS(21)
*        TOTAL MOUNTS 
      IF ((IFLD(FJOB) .NE. PREC(FJOB)) .OR. (IFLD(25) .NE. PREC(25))) 
     .   TMOUNT = TMOUNT + 1
      GO TO 200 
  
*        SUM CORRECTED READ/WRITE AND LATE DATA MESSAGES
*        AFFIX REEL NUMBER (IF MULTI-REEL)
  120 CONTINUE
      IF (IFLD(26) .GT. 0) IFLD(25) = SHIFT(IFLD(26),48) .OR. IFLD(25)
*        SUM GCR SINGLE-TRACK CORRECTED READ ERRORS 
      IF (MTY .EQ. O"2450") CALL ACCUM3 (IFLD(25),3)
*        SUM GCR SINGLE-TRACK CORRECTED WRITE ERRORS
      IF (MTY .EQ. O"2451") CALL ACCUM3 (IFLD(25),4)
*        SUM LATE DATA MESSAGES 
      IF (MTY .EQ. O"2452") CALL ACCUM3 (IFLD(25),5)
      GO TO 200 
  
*        SUM RECOVERED ERRORS 
  140 CONTINUE
      IF (IFLD(16) .EQ. 0) CALL ACCUM3 (IFLD(25),2) 
  
*        SUM UNRECOVERED ERRORS 
      IF (IFLD(16) .NE. 0) CALL ACCUM3 (IFLD(25),1) 
  
*        GENERATE A TAPE DETAIL REPORT
  200 IF (RCFD .EQ. 2HON) CALL DL3MT3 (TDENS) 
  
*        GET THE NEXT SEF RECORD
  210 CALL GNR3 
      CALL SETEM3(1)
  
*         IF EQUIP CHANGE 
       IF(TWIC.LT.3) GO TO 800
       GO TO 100
  
*   **************************************************
  
  800 IF (RCFA .EQ. 3HOFF) GO TO 820
  
*        GENERATE A TAPE ANALYSIS REPORT
      CALL XOVCAP ('ERDIST3',0,0) 
      CALL UOVCAP ('ERDIST3') 
      CALL LOVCAP ('PRSUM3')
* 
*        PRINT TOTAL MOUNTS 
      PL(1) = TMOUNT
      IF (TMOUNT .NE. 0) CALL PRINT33 (2,1)                              R2FTAPE
  
      HCF(1) = 0
* 
*         PRINT CONTROLLER TYPE 
      PL(1) = HDATA(5)
      CALL PRINT33 (9,1)
* 
*        CHECK FOR DENSITY ERRORS                                        R2FTAPE
      DO 801 I=1,6
  801 IF (QDENS(I) .NE. 0) GO TO 802                                     R2FTAPE
      GO TO 804 
  802 CONTINUE                                                           R2FTAPE
* 
*        PRINT QTY AT DENSITY 
      I = 1 
      IF (PREC(FDT) .EQ. R"NT") I = 4 
      PL(1) = TDENS(I)
      PL(2) = TDENS(I+1)
      PL(3) = TDENS(I+2)
      PL(4) = QDENS(I)
      PL(5) = QDENS(I+1)
      PL(6) = QDENS(I+2)
      CALL PRINT33 (10,6) 
  
*        PRINT SUMMARY OF RECOVERED ERRORS
  804 IF (SUM(1,2,2) .EQ. 0) GO TO 808
      HCF(5) = 3
      CALL PHEAD33(5) 
      HDATA(1) = 10H   VSN
      CALL PRSUM3(2,6)
      HCF(5) = 4
      CALL PHEAD33(5) 
  
*        PRINT SUMMARY OF UNRECOVERED ERRORS
      IF (LINE+6 .LE. PLF) GO TO 808
      CALL HEADER 
  808 CONTINUE
      IF (SUM(1,1,2) .EQ. 0) GO TO 810
      HCF(5) = 7
      CALL PHEAD33(5) 
      HDATA(1) = 10H   VSN
      CALL PRSUM3(1,6)
  
*        PRINT SUMMARY OF CORRECTED READ/WRITE AND LATE DATA MESSAGES 
  810 CALL PRSUM3 (3,17)
      CALL PRSUM3 (4,18)
      CALL PRSUM3 (5,19)
      CALL UOVCAP ('PRSUM3')
  
  820 IF (FEOF(SEF) .EQ. 3HYES) GO TO 900 
      IF(TWIC.GT.1)GO TO 50 
  
  900 CALL UOVCAP ('ACCUM3')
  
      RETURN
  
 1000 FORMAT(1X,' .. BLOCKS READ/WRITTEN TABLE FULL .. AN3MT3 --')
      END 
      SUBROUTINE DL3CT3 (TDENS) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE DL3CT3 COLLECTS ALL DATA FOR DETAIL LIST 
* 
*         ENTRY CONDITIONS
*         ----------------
*         DATA AREAS SHARED - 
*         IFLD(64), SEFREC(8) 
* 
*         DEFINITIONS:          CST/ACS 
*                      -------------------------- 
*          IFLD(21) =     SEF RECORD WD 4 
*          IFLD(22) =     SEF RECORD WD 5 
*          IFLD(23) =     SEF RECORD WD 6 
*          IFLD(24) =     SEF RECORD WD 7 
*          IFLD(25) =     SEF RECORD WD 8 
* 
*         DATA AREAS AND FILES
*         --------------------
*         DATA AREAS
*         IFLD  -  (64)/COMMON BLOCK/AREA TOHOLD THE UNPACKED DATA
*                  OF THE CURRENT SEF INPUT RECORD IN SEFREC. 
*         PL - (57)/COMMON BLOCK/AREA TO HOLD ONE LOGICAL RECORD
*                  OF DATA TO BE WRITTEN INTO FILE TAPE8. 
*         IYEAR  - (1)/COMMON BLOCK/TEMPORARY USAGE.
*         CALLED BY 
*         --------- 
*          AN3CT3 
* 
*CALL HPACOM1 
*CALL HPACOM2 
      DIMENSION TDENS(3)
  
*         SKIP ROUTINE FOR CUMULATIVE STATUS IF NO ( ST ) PARAMETER 
  
      IF (FLAGS(8) .LT. O"40") GO TO 10 
      IF (FROG(8) .EQ. 3HOFF) GO TO 900 
  
   10 CONTINUE
      IERCDBD = 1H
  
      IFLD(13) = IFLD(FUN) .AND. O"17"
      CALL UCHEK33
  
      IF (FLAGS(4) .EQ. 3HOFF) GO TO 900
*          SET READ / WRITE FIELD 
      IRW = 4H W
      IF ((IFLD(22) .AND. O"1") .NE. 1) IRW = 4H R
  
*          FORCE (WRITE-EST) TO UNIT EST IF WRITE ERROR 
      IF (IRW .EQ. 4H W  ) IFLD(27) = IFLD(FEST)
  
      REEL = SHIFT(IFLD(22),36) .AND. O"7777 7777 7777" 
*        AFFIX REEL NUMBER (IF MULTI-REEL)
      REELCNT = SHIFT(IFLD(22),48) .AND. O"7777"
  
*        SET RECOVERY 
      RECVR = 4H YES
      IF (IFLD(FC13) .EQ. 1) RECVR = 4H  NO 
  
      IDEN=TDENS(3) 
  
*     CHECK FOR CORRECTED READ/WRITE AND LATE DATA MESSAGES 
      IF ((MTY .GE. O"2450") .AND. (MTY .LE. O"2452")) GO TO 200
  
*     CHECK FOR CUMULATIVE STATUS 
      IF (MTY .EQ. O"60") GO TO 190 
  
*          DEVICE TYPE IS ACS OR CTS
*          LOAD DATA FOR PRINTING DETAIL REPORTS
  
      PL(1) = IFLD(20)
      PL(2) = IFLD(FJOB)
      PL(3) = IFLD(FCHAN) 
      PL(4) = IFLD(FCON)
      PL(5) = IFLD(13)
      PL(6) = REEL
      PL(7) = IRW 
      PL(8) = IFLD(21) .AND. O"7777 7777" 
      PL(9) = TDENS(IDEN) 
      PL(10) = RECVR
      PL(11) = SHIFT(IFLD(21),12) .AND. O"7777" 
      PL(12) = SHIFT(IFLD(21),36) .AND. O"7777" 
      PL(13) = SHIFT(IFLD(22),57) .AND. O"777"
      PL(14) = IFLD(FEST) 
      PL(15) = MFID 
  
      PL(20) = SHIFT(IFLD(21),24) .AND. O"7777" 
      PL(21) = SHIFT(IFLD(23),12) .AND. O"7777" 
  
*     LOAD SENSE BYTES 0 THRU 13
  
      PL(26) = SHIFT(IFLD(23),44) .AND. Z"FF" 
      PL(27) = SHIFT(IFLD(23),52) .AND. Z"FF" 
      PL(28) = SHIFT(IFLD(24),8) .AND. Z"FF"
      PL(29) = SHIFT(IFLD(24),16) .AND. Z"FF" 
      PL(30) = SHIFT(IFLD(24),24) .AND. Z"FF" 
      PL(31) = SHIFT(IFLD(24),32) .AND. Z"FF" 
      PL(32) = SHIFT(IFLD(24),40) .AND. Z"FF" 
      PL(33) = SHIFT(IFLD(24),48) .AND. Z"FF" 
      PL(34) = SHIFT(IFLD(25),8) .AND. Z"FF"
      PL(35) = SHIFT(IFLD(25),16) .AND. Z"FF" 
      PL(36) = SHIFT(IFLD(25),24) .AND. Z"FF" 
      PL(37) = SHIFT(IFLD(25),32) .AND. Z"FF" 
      PL(38) = SHIFT(IFLD(25),40) .AND. Z"FF" 
      PL(39) = SHIFT(IFLD(25),48) .AND. Z"FF" 
  
*     LOAD CCC STATUS AND SENSE BYTES 14 THRU 32
  
      PL(22) = SHIFT(NFLD(24),12) .AND. O"7777" 
      PL(23) = SHIFT(NFLD(24),24) .AND. O"7777" 
      PL(24) = SHIFT(NFLD(24),36) .AND. O"7777" 
      PL(25) = SHIFT(NFLD(24),48) .AND. O"7777" 
  
      PL(40) = SHIFT(NFLD(21),8) .AND. Z"FF"
      PL(41) = SHIFT(NFLD(21),16) .AND. Z"FF" 
      PL(42) = SHIFT(NFLD(21),24) .AND. Z"FF" 
      PL(43) = SHIFT(NFLD(21),32) .AND. Z"FF" 
      PL(44) = SHIFT(NFLD(21),40) .AND. Z"FF" 
      PL(45) = SHIFT(NFLD(21),48) .AND. Z"FF" 
      PL(46) = SHIFT(NFLD(22),8) .AND. Z"FF"
      PL(47) = SHIFT(NFLD(22),16) .AND. Z"FF" 
      PL(48) = SHIFT(NFLD(22),24) .AND. Z"FF" 
      PL(49) = SHIFT(NFLD(22),32) .AND. Z"FF" 
      PL(50) = SHIFT(NFLD(22),40) .AND. Z"FF" 
      PL(51) = SHIFT(NFLD(22),48) .AND. Z"FF" 
      PL(52) = SHIFT(NFLD(23),8) .AND. Z"FF"
      PL(53) = SHIFT(NFLD(23),16) .AND. Z"FF" 
      PL(54) = SHIFT(NFLD(23),24) .AND. Z"FF" 
      PL(55) = SHIFT(NFLD(23),32) .AND. Z"FF" 
      PL(56) = SHIFT(NFLD(23),40) .AND. Z"FF" 
      PL(57) = SHIFT(NFLD(23),48) .AND. Z"FF" 
  
*        GET THE NEXT SEF RECORD
      CALL GNR3 
      CALL SETEM3(1)
      IF (FEOF(SEF) .EQ. 3HYES) GO TO 100 
      IF (IFLD(18) .NE. R" CONTINU") THEN 
*       SET SKIPGNR SO AN3CT3 DOES NOT DO A GNR3 CALL 
        SKIPGNR = 1 
        GO TO 100 
      ENDIF 
  
*     LOAD ERPA CODE TEXT 
  
      PL(16) = IFLD(22) 
      PL(17) = IFLD(23) 
      PL(18) = IFLD(24) 
      PL(19) = IFLD(25) 
  
*         PRINT ACS/CTS DETAIL - 80 COLUMN FORMAT ONLY
  
  100 CONTINUE
      CALL PRINT33(102,25)
      DO 120 I=1,32 
  120 PL(I) = PL(I + 25)
      CALL PRINT33(104,32)
  
      DO 150 I=1,57 
  150 PL(I) = 10H 
      GO TO 900 
* 
*      PROCESS ACS/CTS CUMULATIVE STATUS DETAIL MESSAGE 
* 
  190 CONTINUE
      CALL LOAPR(1,IFLD(20),IFLD(FJOB),IFLD(FCHAN),IFLD(FCON),IFLD(13), 
     .             REEL,FLAGS(20),FLAGS(21))
      CALL LOAPR (9,0,0,0,0,0,MFID,SP,SP) 
      CALL PRINT33 (111, 14)
      GO TO 900 
* 
*          PROCESS CORRECTED READ/WRITE AND LATE DATA MESSAGES
* 
  200 CALL LOAPR(1,IFLD(20),IFLD(FJOB),IFLD(FCHAN),IFLD(FCON),IFLD(13), 
     .             REEL,REELCNT,MFID) 
      PL(9) = IFLD(21)
      CALL PRINT33 (103,9)
      GO TO 900 
  
*          EXIT FROM THIS SUBROUTINE
  
  900 CONTINUE
      RETURN
      END 
      SUBROUTINE DL3MT3 (TDENS) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE DL3NT3 COLLECTS ALL DATA FOR DETAIL LIST 
* 
*         ENTRY CONDITIONS
*         ----------------
*         DATA AREAS SHARED - 
*         IFLD(64), SEFREC(8) 
* 
*         DEFINITIONS: 66X/MTS AND 67X/ATS      CST 
*                      ------------------------------ 
*          IFLD(21) =     RETRY COUNT 
*          IFLD(22) =  GENERAL STATUS WORD 1
*          IFLD(23) =     FAILING FUN CODE
*          IFLD(24) =     BLOCK COUNT AT TIME OF ERROR
*          IFLD(25) =     REEL ID (VSN) 
*          IFLD(26) =     CONTINUATION REEL NUMBER
*          IFLD(27) =     EST ORDINAL OF WRITING UNIT 
*          IFLD(28) =     CONTROLLER TYPE 
*          IFLD(29) =     1=WRITE, 0=READ 
*          IFLD(30) =  GENERAL STATUS WORD 2    WPE 
*          IFLD(31) =  DETAIL STATUS 1          RPE 
*          IFLD(32) =  DETAIL STATUS 2          MDI 
*          IFLD(33) =  DETAIL STATUS 3          --- 
*          IFLD(34) =  DETAIL STATUS 4          CS1 
*          IFLD(35) =  DETAIL STATUS 5          TEL/REL 
*          IFLD(36) =  DETAIL STATUS 6          --- 
*          IFLD(37) =  DETAIL STATUS 7          --- 
*          IFLD(38) =  DETAIL STATUS 8          CS2 
*          IFLD(39) =  UNIT STATUS 1            CS3 
*          IFLD(40) =  UNIT STATUS 2            CS4 
*          IFLD(41) =  UNIT STATUS 3            CS5 
*          IFLD(42) =  UNIT STATUS 4            CS6 
*          IFLD(43) =  UNIT STATUS 5            CS7 
*          IFLD(44) =  UNIT STATUS 6            CS8 
* 
* 
*         DATA AREAS AND FILES
*         --------------------
*         DATA AREAS
*         IFLD  -  (64)/COMMON BLOCK/AREA TOHOLD THE UNPACKED DATA
*                  OF THE CURRENT SEF INPUT RECORD IN SEFREC. 
*         PL - (32)/COMMON BLOCK/AREA TO HOLD ONE LOGICAL RECORD
*                  OF DATA TO BE WRITTEN INTO FILE TAPE8. 
*         IYEAR  - (1)/COMMON BLOCK/TEMPORARY USAGE.
*         CALLED BY 
*         --------- 
*          AN3MT3                                                        R2FTAPE
* 
*CALL,HPACOM1 
*CALL,HPACOM2 
  
      DIMENSION TDENS(10) 
  
*         SKIP ROUTINE FOR CUMULATIVE STATUS IF NO ( ST ) PARAMETER 
  
      IF (FLAGS(8) .LT. O"40") GO TO 10 
      IF (FROG(8) .EQ. 3HOFF) GO TO 900 
  
   10 CONTINUE
      IERCDBD = 1H
                                                                         R2FTAPE
      IFLD(13) = IFLD(FUN) .AND. O"17"
      CALL UCHEK33                                                       R2FTAPE
  
      IF (FLAGS(4) .EQ. 3HOFF) GO TO 900                                 R2FTAPE
*          SET READ / WRITE FIELD 
      IRW = 3H W                                                         R2FTAPE
      IF (IFLD(29) .NE. 1) IRW = 3H R 
                                                                         R2FTAPE
*          FORCE (WRITE-EST) TO UNIT EST IF WRITE ERROR                  R2FTAPE
      IF (IRW .EQ. 3H W ) IFLD(27) = IFLD(FEST) 
                                                                         R2FTAPE
  
      REEL = IFLD(25) .AND. O"7777 7777 7777" 
  
*        SET RECOVERY 
      RECVR = 4H YES                                                     R2FTAPE
      IF (IFLD(FEST+1) .EQ. 1) RECVR = 4H  NO 
  
      IDEN=TDENS(10)                                                     R2FTAPE
  
*     CHECK FOR CORRECTED READ/WRITE AND LATE DATA MESSAGES 
      IF ((MTY .GE. O"2450") .AND. (MTY .LE. O"2452")) GO TO 200
  
      IF (RTY .EQ. O"55") GO TO 90
      GO TO (150,900,900,90,60,60,70,70) RTY - O"27"
* 
*          PROCESS DETAIL MESSAGE FOR 66X                                R2FTAPE
* 
   60 IF (MTY .EQ. O"60") GO TO 80
*          INSERT GENERAL STATUS WORD 2 INTO 66X/MTS IFLD ARRAY 
*          SO 66X AND 67X RECORDS CAN BE PROCESSED IDENTICALLY
      DO 65 I = 1,8 
      II = 38 - I 
   65 IFLD(II+1) = IFLD(II) 
      IFLD(30) = IFLD(44) 
      GO TO 72
  
* 
*          PROCESS DETAIL MESSAGE FOR 67X                                R2FTAPE
* 
   70 IF (MTY .EQ. O"60") GO TO 80
      IF ((IFLD(36) .AND. O"100") .NE. 0) IERCDBD = 1H* 
   72 CONTINUE
      CALL LOAPR(1,IFLD(20),IFLD(FJOB),IFLD(FCHAN),IFLD(FCON),IFLD(13), 
     .             REEL,IRW,IFLD(24)) 
      CALL LOAPR(9,TDENS(IDEN),IERCDBD,RECVR,IFLD(21),IFLD(23), 
     .             IFLD(27),IFLD(FEST),MFID)
      IF (FROG(18) .EQ. 3HYES) GO TO 75                                  R2FTAPE
      CALL LOAPR(17,IFLD(22),IFLD(30),IFLD(31),IFLD(32),IFLD(33), 
     .              IFLD(34),IFLD(35),IFLD(36)) 
      CALL PRINT33 (105,24) 
      GO TO 76                                                           R2FTAPE
   75 CALL PRINT33 (106,16) 
      CALL LOAPR(1,IFLD(22),IFLD(30),IFLD(31),IFLD(32),IFLD(33),         R2FTAPE
     .             IFLD(34),IFLD(35),IFLD(36))
      CALL PRINT33 (108,8)                                               R2FTAPE
*                                                                        R2FTAPE
   76 IF (FLAGS(11) .EQ. 3HOFF) GO TO 900                                R2FTAPE
  
*          PROCESS EXTENDED DETAIL MESSAGE: 
*          -FOR 66X, DETAIL STATUS 7 AND 8
*          -FOR 67X, DETAIL STATUS 7 AND 8, UNIT STATUS 1 THRU 6
      CALL LOAPR(1,IFLD(37),IFLD(38),IFLD(39),IFLD(40),IFLD(41),
     .             IFLD(42),IFLD(43),IFLD(44))
      NWORDS = 2
      IF (RTY .GT. O"35") NWORDS = 8
      IF (FROG(18) .NE. 3HYES) CALL PRINT33 (101,NWORDS)
      IF (FROG(18) .EQ. 3HYES) CALL PRINT33 (108,NWORDS)
      GO TO 900 
                                                                         R2FTAPE
*          PROCESS CUMULATIVE STATUS DETAIL MESSAGE FOR 66X OR 67X       R2FTAPE
   80 THRU = SHIFT (IFLD(35),-6)
      THRL = IFLD(35) .AND. O"77" 
      CALL LOAPR(1,IFLD(20),IFLD(FJOB),IFLD(FCHAN),IFLD(FCON),IFLD(13), 
     .             REEL,FLAGS(20),FLAGS(21))
      CALL LOAPR(9,IFLD(30),IFLD(31),IFLD(32),THRU,THRL,MFID,SP,SP) 
      CALL PRINT33 (111,14) 
      GO TO 900 
  
* 
*          DEVICE TYPE IS FSC 
* 
*          RE-UNPACK LAST WORD OF 2ND FSC RECORD
   90 CONTINUE
      IF (MTY .EQ. O"60") GO TO 190 
      NFLD(43) = SHIFT(SEFREC(8), 5) .AND. O"37"
      IF (RTY .EQ. O"55") THEN
         NFLD(43) = SHIFT(SEFREC(8), 4) .AND. O"17" 
         NFLD(44) = SHIFT(SEFREC(8),12) .AND. O"377"
      ENDIF 
      NFLD(45) = SHIFT(SEFREC(8),24) .AND. O"7777"
      NFLD(46) = SHIFT(SEFREC(8),36) .AND. O"7777"
      NFLD(47) = SHIFT(SEFREC(8),48) .AND. O"7777"
  
*          SHUFFLE SENSE BYTE DATA INTO CONSECUTIVE IFLD LOCATIONS
      DO 92 I = 1,6 
      II = I + 1
   92 IFLD(41+I) = IFLD(41+II)
      DO 94 I = 1,9 
   94 IFLD(47+I) = NFLD(32+I) 
  
*          LOAD FSC DATA FOR PRINTING DETAIL REPORTS
      CALL LOAPR(1,IFLD(20),IFLD(FJOB),IFLD(FCHAN),IFLD(FCON),IFLD(13), 
     .             REEL,IRW,IFLD(24)) 
      CALL LOAPR(9,NFLD(47),TDENS(IDEN),RECVR,IFLD(21),NFLD(44),
     .             IFLD(27),IFLD(FEST),MFID)
      CALL LOAPR(17,NFLD(43),IFLD(22),IFLD(30),IFLD(32),NFLD(45), 
     .              NFLD(46),IFLD(33),IFLD(34)) 
      CALL LOAPR(25,IFLD(35),IFLD(36),IFLD(37),IFLD(38),IFLD(39), 
     .              IFLD(40),IFLD(41),IFLD(42)) 
      CALL LOAPR(33,IFLD(43),IFLD(44),IFLD(45),IFLD(46),IFLD(47), 
     .              IFLD(48),IFLD(49),IFLD(50)) 
      CALL LOAPR(41,IFLD(51),IFLD(52),IFLD(53),IFLD(54),IFLD(55), 
     .              IFLD(56),SP,SP) 
      IF (FROG(18) .EQ. 3HYES) GO TO 98 
  
*          PRINT FSC DETAIL - 132 COLUMNS - D/DX PARAMETER
      CALL PRINT33(112,46)
      IF (FLAGS(11) .NE. 3HOFF) GO TO 100 
      GO TO 900 
  
*          PRINT FSC DETAIL - 80 COLUMNS - D/DX AND R PARAMETERS
   98 CALL PRINT33(113,46)
      IF (FLAGS(11) .NE. 3HOFF) GO TO 110 
      GO TO 900 
  
*          PRINT FSC DETAIL EXTENDED - 132 COLUMNS - DX PARAMETER 
  100 PTR = 24
      DO 105 II = 1,3 
       PTR = PTR + 8
         DO 104 I = 1,8 
         SHFTCNT = 7 - I + 1
         K = I * 8 - 8
            DO 104 J = 1,8
  104       PL(J+K) = SHIFT(IFLD(PTR+J),-SHFTCNT) .AND. 1 
  105 CALL PRINT33(200+II,64) 
      GO TO 900 
  
*         PRINT FSC DETAIL EXTENDED - 80 COLUMNS - DX AND R PARAMETERS
  110 PTR = 26
      DO 115 II = 1,4 
      PTR = PTR + 6 
         DO 114 I = 1,8 
         SHFTCNT = 7 - I + 1
         K = I * 6 - 6
            DO 114 J = 1,6
  114       PL(J+K) = SHIFT(IFLD(PTR+J),-SHFTCNT) .AND. 1 
  115 CALL PRINT33(203+II,48) 
      GO TO 900 
* 
*         DEVICE TYPE IS ISMT 
* 
  150 CONTINUE
      IF (MTY.EQ.O"60") GO TO 190 
*         LOAD ISMT DATA
      ADPTNUM = 10H 
      CALL LOAPR (1,IFLD(20),IFLD(FJOB),IFLD(FCHAN),IFLD(FCON), 
     .            IFLD(13),REEL,IRW,IFLD(24)) 
      CALL LOAPR (9,ADPTNUM,TDENS(IDEN),RECVR,IFLD(21),IFLD(23),
     .            IFLD(27),IFLD(FEST),MFID) 
      PL(17) = 10H
      PL(18) = IFLD(22) 
      PL(19) = IFLD(30) 
      PL(20) = IFLD(32) 
*         ISMT ADAPTOR ERRORS 
      IF (MTY.LT.O"4400") GO TO 152 
      IF (FROG(18).EQ.3HYES) CALL PRINT33(115,20) 
      IF (FROG(18).NE.3HYES) CALL PRINT33(114,20) 
      GO TO 900 
*         LOAD SENSE BYTES 01-07
  152 CONTINUE
      DO 155  I = 1,8 
      PL(20+I) = IFLD(32+I) 
  155 CONTINUE
      IF (FROG(18).EQ.3HYES) GO TO 160
*         PRINT ISMT DETAIL - 132 COLUMN - D/DX PARAMETER 
      CALL PRINT33(114,28)
      IF (FLAGS(11).NE.3HOFF) GO TO 170 
      GO TO 900 
*         PRINT ISMT DETAIL - 80 COLUMN - D/DX PARAMETER
  160 CONTINUE
      CALL PRINT33(115,28)
      IF (FLAGS(11).NE.3HOFF) GO TO 170 
      GO TO 900 
*         PRINT ISMT DETAIL EXTENDED - 132 COLUMN - DX PARAMETER
*         EXTENDED SENSE BYTES
  170 CONTINUE
      PL(4) = IFLD(41)
      DO 175  I = 1,6 
      PL(4+I) = IFLD(42+I)
  175 CONTINUE
      PL(11) = NFLD(33) 
      PL(12) = 10H
      DO 180  I = 1,5 
      PL(12+I) = NFLD(33+I) 
  180 CONTINUE
      PL(18) = 10H
      PL(19) = NFLD(39) 
      PL(20) = NFLD(40) 
      PL(21) = NFLD(41) 
      DO 185  I = 1,6 
      PL(21+I) = NFLD(42+I) 
  185 CONTINUE
      IF (FROG(18).EQ.3HYES) CALL PRINT33(110,27) 
      IF (FROG(18).NE.3HYES) CALL PRINT33(109,27) 
      GO TO 900 
  
* 
*         PROCESS ISMT, FSC AND CMTS CUMULATIVE STATUS DETAIL MESSAGE 
* 
  190 CONTINUE
      CALL LOAPR(1,IFLD(20),IFLD(FJOB),IFLD(FCHAN),IFLD(FCON),IFLD(13), 
     .             REEL,FLAGS(20),FLAGS(21))
      CALL LOAPR (9,0,0,0,0,0,MFID,SP,SP) 
      CALL PRINT33 (111, 14)
      GO TO 900 
  
* 
*          PROCESS CORRECTED READ/WRITE AND LATE DATA MESSAGES
* 
  200 CALL LOAPR(1,IFLD(20),IFLD(FJOB),IFLD(FCHAN),IFLD(FCON),IFLD(13), 
     .             REEL,IFLD(26),MFID)
      PL(9) = IFLD(24)
      CALL PRINT33 (103,9)
      GO TO 900 
  
  
*          EXIT FROM THIS SUBROUTINE
  
  900 RETURN
      END 
      SUBROUTINE PHEAD33 (ST) 
* 
**     PHEAD33 PRINTS HEADINGS FOR REPORTS DEVELOPED
*      BY HPA33 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) - FLAGS TO CONTROL SUB-HEADER PRINT 
*        HDATA(5) = 5 WORDS OF (A) FORMAT DATA USED IN PRINT. 
*        TYPEST = CURRENT EST 
*        TYPEDT = CURRENT DEVICE TYPE 
*        TYPEID = CURRENT DEVICE NOMENCLATURE (DISK,TAPE,ETC.)
* 
*         CALLED BY 
*         --------- 
*         PRINT33 - AUTOMATICALLY, WHEN NEW PAGE IS INITIATED.
*         HPA33  ROUTINES THAT NEED TO CALL SUBHEADER.
* 
*CALL HPACOM1 
*CALL,HPACOM2 
  
      P = ST
*       TEST IF PRINT FLAG IS OFF                                       000170
      IF (FLAGS(4) .EQ. 3HOFF) GO TO 1000                               000180
      GO TO 5 
    2 LINE = LINE + 1 
    5 LINE = LINE + 1 
                                                                        000210
      IF (P .GT. 5) GO TO 1000                                          000220
  
    6 PTR = HCF(P)
      IF ((PTR.LE.0).OR.(PTR.GT.16)) GO TO 1000 
      P = P + 1 
  
*        JUMP TO PRINT AS CALLED BY POINTER 
      GO TO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,150,160) PTR
* 
   10 PRINT 11,TYPORD,TYPDT,ORD,TYPID 
   11 FORMAT (4H DT ,A4,6H - ** ,R2,1X,A4,3H **,
     .4X,3H.. ,A10,'  DATA  ..')
      GO TO 5 
  
*         CONTROLLER/MESSAGE TYPE HEADER                                 R2FTAPE
   20 PRINT 21,HDATA(5),
     .SEBUF(27),SEBUF(28),SEBUF(29) 
   21 FORMAT (/,1X,10HCONTROLLER,A8,2X,12HMSG-TYPE >>>, 
     .2A10,A8,3H<<<,/)
      LINE = LINE + 2 
      GO TO 2                                                           000560
  
*        SUBHEADER FOR RECOVERED ERRORS - UNIT ANALYSIS REPORT
   30 PRINT 31
   31 FORMAT (/,1X,39H*** VSNS WITH MOST RECOVERED ERRORS ***)
      GO TO 5 
  
*        SUBHEADER FOR RECOVERED VSN TOTAL - UNIT ANALYSIS REPORT 
   40 PRINT 41,HDATA(2) 
   41 FORMAT(/,1X,38H*** TOTAL VSNS WITH RECOVERED ERRORS =,I4,4H ***)
      GO TO 5 
  
*         SUBHEADER FOR ACS/CTS DETAIL REPORT - 80 COLUMNS
   50 PRINT 51
   51 FORMAT (3X,'DATE',30X,'R',22X,'RTY     WR  RD  MF'/,5X, 
     .'TIME     JOB    CH EQ UN  REEL  W   BLOCK     DENS RCV CNT', 
     .' FCN EST EST ID'/1X,7(10H----------),8H--------) 
      GO TO 2 
  
*        DATE CHANGE - DETAIL REPORT
   60 PRINT 61, SEBUF(23) 
   61 FORMAT (1X,A8)
      GO TO 6 
                                                                         R2FTAPE
*        SUBHEADER FOR UNRECOVERED ERRORS - UNIT ANALYSIS REPORT
   70 CONTINUE
      PRINT 71
   71 FORMAT(/,1X,36H*** VSNS WITH UNRECOVERED ERRORS ***)
      GO TO 5 
                                                                         R2FTAPE
   80 CONTINUE
      GO TO 1000
                                                                         R2FTAPE
*         SUBHEADER FOR 66X/67X DETAIL REPORT - 132 COLUMNS 
   90 PRINT 91                                                           R2FTAPE
   91 FORMAT (3X,'DATE',30X,'R',22X,'RTY     WR  RD  MF', 
     .14X,'HARDWARE STATUS',/,5X,'TIME     JOB    CH EQ UN  REEL ', 
     .' W  BLOCK      DENS RCV CNT FCN EST EST ID   G1   G2   D1 ', 
     .'  D2   D3   D4   D5   D6',/,1X,12(10H----------))
      GO TO 2                                                            R2FTAPE
                                                                         R2FTAPE
*        SUBHEADER FOR 66X/67X DETAIL REPORT - 80 COLUMNS                R2FTAPE
  100 PRINT 101                                                          R2FTAPE
  101 FORMAT (3X,'DATE',30X,'R',22X,'RTY     WR  RD  MF',/, 
     .5X,'TIME     JOB    CH EQ UN  REEL  W  BLOCK      DENS RCV CNT',
     .' FCN EST EST ID',/,1X,7(10H----------),7H-------)
      GO TO 2                                                            R2FTAPE
                                                                         R2FTAPE
  110 CONTINUE
      GO TO 1000
  
*        SUBHEADER FOR 66X/67X CUMULATIVE STATUS REPORT - 80 COLUMNS     R2FTAPE
  120 PRINT 121                                                          R2FTAPE
  121 FORMAT (3X,'DATE',30X,'--BLOCKS--',14X,'THRESHOLDS',6X,'MF',
     ./,4X,'TIME     JOB    CH EQ UN  REEL  READ..WRITE      WPE  RP',
     .'E  FLT  TEL  REL ID',/,1X,7(10H----------),8H--------) 
      GO TO 2                                                            R2FTAPE
                                                                         R2FTAPE
*        SUBHEADER FOR CORRECTED READ/WRITE AND LATE DATA MESSAGES
  130 PRINT 131 
  131 FORMAT (3X,'DATE',30X,' REEL   MF   ERROR',/, 
     .5X,'TIME     JOB    CH EQ UN  REEL   NUM.   ID   COUNT',/,
     .1X,5(10H----------),4H----) 
      GO TO 2 
  
*         SUBHEADER FOR FSC DETAIL REPORT - 132 COLUMNS 
  140 PRINT 141 
  141 FORMAT (3X,'DATE',29X,'R',8X,'ADAP',10X,'RTY     WR  RD  MF', 
     .' CW     HARDWARE STATUS AND 24 SENSE BYTES'/4X,'TIME     JOB    '
     .,'CH EQ UN  REEL  W  BLOCK NUM  DENS RCV CNT FCN EST EST ID RV  ',
     . '     GS1    GS2    DS1 170-DI FSC-DI'/1X,11(10H----------), 
     . 8H--------)
      GO TO 2 
  
*         SUBHEADER FOR FSC DETAIL REPORT - 80 COLUMNS
  150 PRINT 151 
  151 FORMAT (2X,'DATE',29X,'R',8X,'ADAP',10X,'RTY     WR  RD  MF CW'/, 
     .3X,'TIME     JOB    CH EQ UN  REEL  W  BLOCK NUM  DENS RCV CNT',
     .' FCN EST EST ID RV'/1X,7(10H----------),8H--------)
      GO TO 2 
  
*         SUBHEADER FOR ISMT DETAIL REPORT - 132 COLUMN 
  160 PRINT 161 
  161 FORMAT(3X,'DATE',29X,'R',8X,'ADAP',10X,'RTY     WR  RD  MF',
     .'  HARDWARE STATUS',/,4X,'TIME     JOB    ' 
     .,'CH EQ UN  REEL  W  BLOCK NUM  DENS RCV CNT FCN EST EST ID'
     . ,'   GS1  GS2  DS1',8X,'SENSE BYTES',/,1X,12(10H----------)) 
      GO TO 2 
 1000 RETURN
      END 
      SUBROUTINE PRINT33 (LT,NW)
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE PRINT33 PRINTS A LINE OF DATA IN VARIOUS REPORTS 
*         BY TRACKING LINE COUNTS AND STARTS NEW PAGE IF NEEDED.
* 
*         ENTRY CONDITIONS
*         ----------------
*         LT   - DEFINES THE FORMAT STATEMENT TO BE USED, 
*         NW   - DEFINES THE NUMBER OF WORDS TO BE PRINTED. 
* 
*         DATA AREAS SHARED - 
*         LINE, RCF, PL(32) 
* 
*         EXIT CONDITIONS 
*         --------------- 
*         DATA AREAS SHARED - 
*         LINE
* 
*         DATA AREAS
*         ----------
*         LINE   - (1)/COMMON BLOCK/NUMBER OF LINES PRINTED SO FAR
*                  IN A PAGE. 
*         IFORM  - (12,60)/COMMON BLOCK/AREA TO HOLD THE EXECUTION
*                  TIME FORMAT STATEMENTS FOR VARIOUS REPORTS.
*                  COLUMN NUMBER SELECTS A SET OF FORMAT STATEMENT
*                  AND THE MAXIMUN LENGTH OF ONE STATEMENT IS 12
*                  WORDS LONG.
*         PL - (32)/COMMON BLOCK/AREA TO HOLD A LIST OF PRINT 
*                  DATA LOADED BY THE CALLING ROUTINE.
*         CALLS 
*         ----- 
*         HEADER - INITIALIZE EACH PAGE OF VARIOUS REPORTS. 
*         PHEAD - PRINT SUB-HEADER IN VARIOUS REPORT. 
* 
*CALL,HPACOM1 
  
*          * * * * * * * * * * * * * * * * * * * * * *
      DIMENSION IFORM (5,11),  FORM2 (12,15),  FSC (8,24),  FMT (12)
      DIMENSION ICMTS (8,24)
* 
*        FORMAT FOR TOTAL MOUNTS
      DATA (IFORM(I,2), I=1,4,1) /
     .10H(5X,I9,4X,,10H'TOTAL MOU,10HNTS')     ,10H          /
  
  
*       FORMAT FOR DENSITY SUMMARY - ANALYSIS REPORT 5680 ACS/CTS TAPE
      DATA (IFORM(I,5),I=1,5,1)      /
     .10H(/,6X,' QT,10HY AT DENSI,10HTY  >>>>>',10H,R9/,28X,I,10H9) 
     .   /
*       FORMAT FOR CONTROLLER TYPE - ANALYSIS REPORT                     R2FTAPE
      DATA (IFORM(I,9),I=1,4,1)      /
     .10H(/,6X,' CO,10HNTROLLER T,10HYPE >>>>>',10H,A10)     /
  
*       FORMAT FOR DENSITY SUMMARY - ANALYSIS REPORT                     R2FTAPE
      DATA (IFORM(I,10),I=1,5,1)      / 
     .10H(/,6X,' QT,10HY AT DENSI,10HTY  >>>>>',10H,3R9/,28X,,10H3I9) 
     .   /
* 
* 
* 
*       **********************************************
* 
*         ...START OF (FORM2) ARRAY FOR LARGE FORMATS ... 
* 
*        ... THESE ARE CALLED WITH FORMAT PARAMETER BIASED
*            BY +100, IN PRINT CALL . 
* 
*        ************************************************ 
* 
* 
*        FORMAT FOR 132 COLUMN 66X/67X EXTNDED DETAIL MESSAGE - 2ND LINE
      DATA (FORM2(I,1),I=1,6,1)  /
     .10H(79X,8(1H/,10H,O4.0),1H/,10H)         ,10H          ,10H 
     .   ,10H          /
  
*       FORMAT FOR 80 COLUMN ACS/CTS DETAIL MESSAGE 1ST 3 LINES 
      DATA (FORM2(I,2),I=1,12,1)   /
     .10H(3X,A9,R8,,10H3(X,O2),X,,10HR6,A4,I7.0,10H,R8,A5,I3,,10H3(X,O3)
     .,2X,10H,R1/5X,4A1,10H0/5X,'GS  ,10H1- 2  ',2(,10HO4,'/'),15,10HX,'
     .CCC STA,10HTUS  ',4(O,10H4.0,'/')) /
  
*        FORMAT FOR CORRECTED READ/WRITE AND LATE DATA MESSAGES 
      DATA (FORM2(I,3),I=1,6,1) / 
     .10H(3X,A8,1X,,10HR8,3(1X,O2,10H),1X,R6,I5,10H.0,5X,R1,3,10HX,I5)
     .   ,10H          /
  
  
*       FORMAT FOR 80 COLUMN ACS/CTS DETAIL MESSAGE LAST 2 LINES
      DATA (FORM2(I,4),I=1,12,1)   /
     .10H(5X,'SB  0,10H- 7  ',8(Z,10H2.0,'/'),3,10HX,'SB  8-1,10H5  ',8(
     .Z2.,10H0,'/')/5X,,10H'SB 16-23',10H,2X,8(Z2.0,10H,'/'),3X,',10HSB 
     .24-32  ,10H',8(Z2.0,',10H/'))      /
  
*        FORMAT FOR 132 COLUMN 66X,67X DETAIL MESSAGE 
      DATA (FORM2(I,5),I=1,12,1) /
     .10H(3X,A8,1X,,10HR8,3(1X,O2,10H),1X,R6,A3,10H,I6.0,4X,R,10H4,A1,1X
     .,A5,10H,I3,3(1X,O, 10H3),2X,R1,1,10HX,8(1H/,O4,10H.0),1H/)  ,10H
     .        ,10H          ,10H          / 
  
*        FORMAT FOR 80 COLUMN 66X/67X DETAIL MESSAGE - 1ST LINE 
      DATA (FORM2(I,6),I=1,12,1)   /
     .10H(3X,A8,1X,,10HR8,3(1X,O2,10H),1X,R6,A3,10H,I6.0,4X,R,10H4,A1,1X
     .,A5,10H,I3,3(1X,O, 10H3),2X,R1) ,10H          ,10H          ,10H
     .        ,10H          ,10H          / 
                                                                         R2FTAPE
*        FORMAT FOR 80 COLUMN 66X/67X DETAIL MESSAGE - 2ND LINE 
*        FORMAT FOR 80 COLUMN 66X/67X EXTENDED DETAIL - 3RD LINE
      DATA (FORM2(I,8),I=1,6,1)   / 
     .10H(36X,8(1H/,10H,O4.0),1H/,10H)         ,10H          ,10H 
     .   ,10H          /
* 
*         FORMAT FOR 132 COLUMN ISMT EXTENDED DETAIL REPORT 
      DATA(FORM2(I,9),I=1,8,1)/ 
     .10H(80X,3(1H/,10H,A2),8(1H/,10H,Z2),1H/,A,10H2,2(1H/,Z2,10H),/,80X
     .,3(,10H1H/,Z2)  ,,10H1H/,A2,9(1,10HH/,Z2))   /
*         FORMAT FOR 80 COLUMN ISMT EXTENDED DETAIL REPORT
      DATA(FORM2(I,10),I=1,8,1)/
     .10H(37X,3(1H/,10H,A2),8(1H/,10H,Z2),1H/,A,10H2,2(1H/,Z2,10H),/,37X
     .,3(,10H1H/,Z2),  ,10H1H/,A2,9(1,10HH/,Z2))   /
                                                                         R2FTAPE
*        FORMAT FOR 80 COLUMN 66X/67X CUMULATIVE STATUS MESSAGE          R2FTAPE
      DATA (FORM2(I,11),I=1,6,1)   /
     .10H(2X,A8,1X,,10HR8,3(1X,O2,10H),1X,R6,2I,10H6.0,4X,5(1,10HH/,O4.0
     .),1,10HH/,1X,R1)  / 
  
*        FORMAT FOR 132 COLUMN FSC DETAIL MESSAGE 
      DATA (FORM2(I,12),I=1,12,1)   / 
     .10H(2X,A8,1X,,10HR8,3(1X,O2,10H),1X,R6,A3,10H,I6.0,1X,O,10H4,R4,1X
     .,A5,10H,I3,3(1X,O,10H3),2X,R1,1,10HX,I2,3X,5(,10H1H/,2X,O4),10H,2(
     ./83X,12,10H(1H/,Z2))),10H          /
  
*        FORMAT FOR 80 COLUMN FSC DETAIL MESSAGE
      DATA (FORM2(I,13),I=1,12,1)   / 
     .10H(1X,A8,1X,,10HR8,3(1X,O2,10H),1X,R6,A3,10H,I6.0,1X,O,10H4,R4,1X
     .,A5,10H,I3,3(1X,O, 10H3),2X,R1,1,10HX,I2/,43X,,10H5(1H/,2X,O,10H4)
     .,2(/,43X,10H,12(1H/,Z2,10H)))       / 
* 
*         FORMAT FOR 132 COLUMN ISMT DETAIL REPORT
      DATA (FORM2(I,14),I=1,10,1)/
     .10H(2X,A8,1X,,10HR8,3(1X,O2,10H),1X,R6,A3,10H,I6.0,A5,R,10H4,1X,A5
     .,I3,10H,3(1X,O3),,10H2X,R1,A2,3,10H(O4,1H/),2,10HX,7(Z2,1H/,10H),Z
     .2)     /
*         FORMAT FOR 80 COLUMN ISMT DETAIL REPORT 
      DATA (FORM2(I,15),I=1,11,1)/
     .10H(1X,A8,1X,,10HR8,3(1X,O2,10H),1X,R6,A3,10H,I6.0,A5,R,10H4,1X,A5
     .,I3,10H,3(1X,O3),,10H2X,R1,A3,/,10H,39X,3(O4,,10H1H/),2X,7(,10HZ2,
     .1H/),Z2,10H)         /
  
*        FSC SENSE BYTE DATA
      DATA (FSC(I,1),I=1,8,1)/
     .                      10HCOMMAND RJ,10HINTERVN RQ,10HBUS OUT CK,10
     .HEQIPMNT CK,                      10HDATA CK   ,10HOVERRUN   ,10HW
     .ORD CNT 0,10HDATA CNVTR/
      DATA (FSC(I,2),I=1,8,1)/
     .                      10HNOISE     ,10HTU STAT A ,10HTU STAT B ,10
     .HSEVEN TRCK,                      10HLOAD POINT,10HWRITE STAT,10HF
     .ILE PRTCT,10HNOT CAPBLE/
      DATA (FSC(I,3),I=1,8,1)/
     .                      10HTIE BIT 7 ,10HTIE BIT 6 ,10HTIE BIT 5 ,10
     .HTIE BIT 4 ,                      10HTIE BIT 3 ,10HTIE BIT 2 ,10HT
     .IE BIT 1 ,10HTIE BIT 0 /
      DATA (FSC(I,4),I=1,8,1)/
     .                      10HVRC       ,10HLRC/TKS ER,10HSKEW ERROR,10
     .HCRC/EDC   ,                      10HENV/ECC   ,10H1600 CPI  ,10HB
     .ACKWARD  ,10HC/P CMPARE/
      DATA (FSC(I,5),I=1,8,1)/
     .                      10H          ,10HREJ TPE UN,10HEOT       ,10
     .HW DRVER ER,                      10H          ,10HLOOP W/R  ,10HT
     .PE UN CK ,10H          /
      DATA (FSC(I,6),I=1,8,1)/
     .                      10H          ,10H          ,10HW TMRK CK ,10
     .HID BRST CK,                      10HSTART R CK,10HPRTIAL REC,10HP
     .OSTAMBLE ,10H          /
      DATA (FSC(I,7),I=1,8,1)/
     .                      10HSEVEN TRCK,10HW CURR ER ,10HDUAL DNSTY,10
     .HNOT1600CPI,                      10HTPE UN CPI,10HTPE UN IPS,10HT
     .PE UN IPS,10HTPE UN IPS/
      DATA (FSC(I,8),I=1,8,1)/
     .                      10HLAMP FAILR,10HTPE BTM L ,10HTPE BTM R ,10
     .HRESET KEY ,                      10HDATA SEC E,10HERASE HD E,10HA
     .IR PRSSRE,10HLOAD FAILR/
      DATA (FSC(I,9),I=1,8,1)/
     .                      10HIBG DTECTD,10H          ,10H          ,10
     .HBRD BCK CK,                      10HCT BRST CK,10H          ,10HE
     .RD BCK CK,10HVEL RTY/RS/
      DATA(FSC(I,10),I=1,8,1)/
     .                      10H6250CPI CR,10HVEL W CHNG,10HCHL BUF CK,10
     .HCRC ERROR ,                      10H6250CPIOPT,10H          ,10H 
     .         ,10HTCU UN RES/
      DATA(FSC(I,11),I=1,8,1)/
     .                      10HCOM ST REJ,10H          ,10HCNT ST REJ,10
     .HTM BCK CK ,                      10HDYN REV CK,10HTACH FAILR,10H 
     .         ,10HVELOCTY CK/
      DATA(FSC(I,12),I=1,8,1)/
     .                      10H          ,10H          ,10H          ,10
     .H          ,                      10H          ,10H          ,10H 
     .         ,10H          /
      DATA(FSC(I,13),I=1,8,1)/
     .                      10H          ,10H          ,10H          ,10
     .H          ,                      10H          ,10H          ,10H 
     .         ,10H          /
      DATA(FSC(I,14),I=1,8,1)/
     .                      10H9T NRZI   ,10H7T NRZI   ,10HTCU ID    ,10
     .HTCU ID    ,                      10HTCU ID    ,10HTCU ID    ,10HT
     .CU ID    ,10HTCU ID    /
      DATA(FSC(I,15),I=1,8,1)/
     .                      10HTCU ID    ,10HTCU ID    ,10HTCU ID    ,10
     .HTCU ID    ,                      10HTCU ID    ,10HTCU ID    ,10HT
     .CU ID    ,10HTCU ID    /
      DATA(FSC(I,16),I=1,8,1)/
     .                      10HTPE UN ID ,10HTPE UN ID ,10HTPE UN ID ,10
     .HTPE UN ID ,                      10HTPE UN ID ,10HTPE UN ID ,10HT
     .PE UN ID ,10HTPE UN ID /
      DATA(FSC(I,17),I=1,8,1)/
     .                      10HTPE UN ID ,10HTPE UN ID ,10HTPE UN ID ,10
     .HTPE UN ID ,                      10HTPE UN ID ,10HTPE UN ID ,10HT
     .PE UN ID ,10HTPE UN ID /
      DATA(FSC(I,18),I=1,8,1)/
     .                      10HCHL SWTCH ,10HTCU FEATRE,10HTCU FEATRE,10
     .HTCU FEATRE,                      10HTCU LVL   ,10HTCU LVL   ,10HT
     .CU LVL   ,10HTCU LVL   /
      DATA(FSC(I,19),I=1,8,1)/
     .                      10HPWR/AIR CK,10HTPE UN CD ,10HTPE UN CD ,10
     .HTPE UN CD ,                      10HTPE UN LVL,10HTPE UN LVL,10HT
     .PE UN LVL,10HTPE UN LVL/
      DATA(FSC(I,20),I=1,8,1)/
     .                      10HEND UN 7  ,10HEND UN 6  ,10HEND UN 5  ,10
     .HEND UN 4  ,                      10HEND UN 3  ,10HEND UN 2  ,10HE
     .ND UN 1  ,10HEND UN 0  /
      DATA(FSC(I,21),I=1,8,1)/
     .                      10HEND UN F  ,10HEND UN E  ,10HEND UN D  ,10
     .HEND UN C  ,                      10HEND UN B  ,10HEND UN A  ,10HE
     .ND UN 9  ,10HEND UN 8  /
      DATA(FSC(I,22),I=1,8,1)/
     .                      10HLOAD BUTTN,10HLREEL TURN,10HRREEL TURN,10
     .HTPR PRESNT,                      10HREELS LOAD,10HLOAD REWND,10HL
     .OAD CMPLT,10HLOAD CHECK/
      DATA(FSC(I,23),I=1,8,1)/
     .                      10HFLD REP ID,10HFLD REP ID,10HFLD REP ID,10
     .HFLD REP ID,                      10HFLD REP ID,10HFLD REP ID,10HF
     .LD REP ID,10HFLD REP ID/
      DATA(FSC(I,24),I=1,8,1)/
     .                      10HFLD REP ID,10HFLD REP ID,10HFLD REP ID,10
     .HFLD REP ID,                      10HFLD REP ID,10HFLD REP ID,10HF
     .LD REP ID,10HFLD REP ID/
  
*        CMTS SENSE BYTE DATA 
      DATA (ICMTS(I,1),I=1,8,1)/
     .10HCOMMAND RJ,10HINTERVN RQ,10HBUS OUT CK,10HEQIPMNT CK,
     .10HDATA CK   ,10HOVERRUN   ,10HWORD CNT 0,10HSPARE      / 
      DATA (ICMTS(I,2),I=1,8,1)/
     .10HNOISE     ,10HTU STAT A ,10HTU STAT B ,10HSPARE     ,
     .10HLOAD POINT,10HWRITE STAT,10HFILE PRTCT,10HNOT CAPBLE / 
      DATA (ICMTS(I,3),I=1,8,1)/
     .10HTIE BIT 7 ,10HTIE BIT 6 ,10HTIE BIT 5 ,10HTIE BIT 4 ,
     .10HTIE BIT 3 ,10HTIE BIT 2 ,10HTIE BIT 1 ,10HTIE BIT 0  / 
      DATA (ICMTS(I,4),I=1,8,1)/
     .10HR/W VRC   ,10HTKS ER/LRC,10HSKEW ERROR,10HEDC/CRC   ,
     .10HENV/ECC   ,10H1600 CPI  ,10HBACKWARD  ,10HC/P CMPARE / 
      DATA (ICMTS(I,5),I=1,8,1)/
     .10HMICRO HW E,10HREJ TPE UN,10HTPE INDCTE,10HWRITE VRC ,
     .10HVAL TP MRK,10HLOOP W/R  ,10HTPE UN CK ,10HERR TRK P  / 
      DATA (ICMTS(I,6),I=1,8,1)/
     .10HNEW SYS =0,10HNEW SYS =1,10HW TMRK CK ,10HID BRST CK,
     .10HSTART R CK,10HPRTIAL REC,10HPOSTAMBLE ,10HSPARE      / 
      DATA (ICMTS(I,7),I=1,8,1)/
     .10HSPARE     ,10HW CURR ERR,10HDUAL DNSTY,10HNOT1600CPI,
     .10HTPE UN CPI,10HTPE UN IPS,10HTPE UN IPS,10HTPE UN IPS / 
      DATA (ICMTS(I,8),I=1,8,1)/
     .10HLAMP FAILR,10HTPE BOTTOM,10HDSP ERROR ,10HRESET KEY ,
     .10HDSE       ,10HHD FAILURE,10HMICRO P CK,10HLOAD FAILR / 
      DATA (ICMTS(I,9),I=1,8,1)/
     .10HIBG DTECTD,10HDATA C/R C,10HSPARE     ,10HERD BCK CK,
     .10HCT BRST CK,10HSLOW BEGIN,10HSLOW END  ,10HVEL RET/RS / 
      DATA(ICMTS(I,10),I=1,8,1)/
     .10H6250CPI CR,10HVEL W CHNG,10HCHL BUF CK,10HCRC 3 ERR ,
     .10H6250CPIOPT,10HSPARE = 0 ,10HSPARE = 1 ,10HTCU UN RES / 
      DATA(ICMTS(I,11),I=1,8,1)/
     .10HCOM ST REJ,10HSPARE     ,10HCNT ST REJ,10HREC UNDTCD,
     .10HDYN REV CK,10HTACH FAILR,10HSPARE     ,10HVELOCTY CK / 
      DATA(ICMTS(I,12),I=1,8,1)/
     .10HB BUS PE  ,10HSPARE     ,10HLOW IC PAR,10HHI IC PAR ,
     .10HMICRO HW E,10HROS PE    ,10HSPARE     ,10HSPARE      / 
      DATA(ICMTS(I,13),I=1,8,1)/
     .10HBUS OUT CK,10HBUS OUT CK,10HINP SEQ ER,10HOUT SEQ ER,
     .10HOTAG PULSE,10HO TAG SEQ ,10HO TAG FREQ,10HIO TAG CNT / 
      DATA(ICMTS(I,14),I=1,8,1)/
     .10H9T NRZI   ,10H7T NRZI   ,10HTCU SN    ,10HTCU SN    ,
     .10HTCU SN    ,10HTCU SN    ,10HTCU SN    ,10HTCU SN     / 
      DATA(ICMTS(I,15),I=1,8,1)/
     .10HTCU SN    ,10HTCU SN    ,10HTCU SN    ,10HTCU SN    ,
     .10HTCU SN    ,10HTCU SN    ,10HTCU SN    ,10HTCU SN     / 
      DATA(ICMTS(I,16),I=1,8,1)/
     .10HTPE UN SN ,10HTPE UN SN ,10HTPE UN SN ,10HTPE UN SN ,
     .10HTPE UN SN ,10HTPE UN SN ,10HTPE UN SN ,10HTPE UN SN  / 
      DATA(ICMTS(I,17),I=1,8,1)/
     .10HTPE UN SN ,10HTPE UN SN ,10HTPE UN SN ,10HTPE UN SN ,
     .10HTPE UN SN ,10HTPE UN SN ,10HTPE UN SN ,10HTPE UN SN  / 
      DATA(ICMTS(I,18),I=1,8,1)/
     .10H2 CH SW   ,10HTCU FEATRE,10HTCU FEATRE,10HTCU FEATRE,
     .10HTCU LVL   ,10HTCU LVL   ,10HTCU LVL   ,10HTCU LVL    / 
      DATA(ICMTS(I,19),I=1,8,1)/
     .10HDATA STR M,10HSPARE     ,10HCOMPRESS F,10HCOMPRESS S,
     .10HTPE UN LVL,10HTPE UN LVL,10HTPE UN LVL,10HTPE UN LVL / 
      DATA(ICMTS(I,20),I=1,8,1)/
     .10HEND UN 7  ,10HEND UN 6  ,10HEND UN 5  ,10HEND UN 4  ,
     .10HEND UN 3  ,10HEND UN 2  ,10HENE UN 1  ,10HEND UN 0   / 
      DATA(ICMTS(I,21),I=1,8,1)/
     .10HEND UN F  ,10HEND UN E  ,10HEND UN D  ,10HEND UN C  ,
     .10HEND UN B  ,10HEND UN A  ,10HEND UN 9  ,10HEND UN 8   / 
      DATA(ICMTS(I,22),I=1,8,1)/
     .10HLOAD BUTTN,10HMREEL TURN,10HFREEL TURN,10HTPR PRESNT,
     .10HREELS LOAD,10HLOAD REWND,10HLOAD CMPLT,10HLOAD CHECK / 
      DATA(ICMTS(I,23),I=1,8,1)/
     .10HMTC SEQ ID,10HMTC SEQ ID,10HMTC SEQ ID,10HMTC SEQ ID,
     .10HMTC SEQ ID,10HMTC SEQ ID,10HMTC SEQ ID,10HMTC SEQ ID / 
      DATA(ICMTS(I,24),I=1,8,1)/
     .10HMTC FRS   ,10HMTC FRS   ,10HMTC FRS   ,10HMTC FRS   ,
     .10HMTC FRS   ,10HMTC FRS   ,10HMTC FRS   ,10HMTC FRS    / 
  
*        FORMATS FOR 132 COLUMN FSC SENSE BYTE DATA 
   22 FORMAT(' SENSE BYTE DATA'//' BYTE  ',I1,4X,Z2,1X,7(' BYTE ',
     .  I2.0,4X,Z2,1X)/8(' ------------- '))
  
   24 FORMAT(8(1X,A10,2X,O1,1X))
  
   26 FORMAT(/8(' BYTE ',I2.0,4X,Z2,1X)/8(' ------------- ')) 
  
*        FORMATS FOR 80 COLUMN FSC SENSE BYTE DATA
   32 FORMAT(' SENSE BYTE DATA'//' BYTE  ',I1,3X,Z2,5(' BYTE ',I2.0,
     . 3X,Z2))
  
   34 FORMAT(6(1X,A10,1X,O1,))
  
   36 FORMAT(/6(' BYTE ',I2.0,3X,Z2)) 
  
*       **************************************************
  
*      IF CURRENT DETAILS - NOT TO BE PRINTED - RETURN. 
      IF (FLAGS(4) .EQ. 3HOFF) GO TO 100
  
*        AVOID PAGE HEADERS FOR FSC AND CMTS DX SENSE BYTE FORMATS
      IF (LT .GE. 200) GO TO 20 
  
*        EVOKE NEW PAGE HEADERS FOR EACH FSC AND CMTS DX MESSAGE
*        IF LINE=11, HEADERS ALREADY PRINTED BY UCHEK33 FOR NEW EST/MTY 
      IF ((RTY .NE. O"33") .AND. (RTY .NE. O"55")) GO TO 2
      IF ((MTY .EQ. O"60") .OR. ((MTY.GE.O"2450").AND.(MTY.LE.O"2452")))
     .     GO TO 2
      IF ((FLAGS(11).NE.3HOFF).AND.(LINE.GT.11).AND.(IHDR.EQ.8)) GO TO 3
  
    2 CONTINUE
      IF(LINE.LE.PLF) GO TO 5 
  
*   ENSURE SUFFICIENT NUMBER OF LINES AVAILABLE FOR MULTI-LINE OUTPUTS
*   LT 102 AND 103 WILL ALWAYS BE PRINTED TOGETHER SO CHECK 102 ONLY
      IF ((LT .EQ. 102) .AND. (LINE .LE. (PLF + 5))) GO TO 5
      IF ((LT .EQ. 112) .AND. (LINE .LE. (PLF + 3))) GO TO 5
      IF ((LT .EQ. 113) .AND. (LINE .LE. (PLF + 4))) GO TO 5
*        PREVENT NEW PAGE IF SEF STATUS INCOMPLETE                       R2FTAPE
      IF ((LT .EQ. 101) .OR. (LT .EQ. 104) .OR. ((LT .GE. 107) .AND.
     .   (LT .LE. 110))) GO TO 5
*        INSERT DATE IF NEW HEADER FOR DETAIL REPORTS                    R2FTAPE
    3 CONTINUE
      HCF(4) = 6
      CALL HEADER 
      CALL PHEAD33 (1)                                                  000720
    5 CONTINUE
      LINE=LINE+1 
      IF (LT .EQ. 102) LINE = LINE + 2
      IF (LT .EQ. 104) LINE = LINE + 1
      IF (LT .EQ. 112) LINE = LINE + 2
      IF (LT .EQ. 113) LINE = LINE + 3
      IF (LT .GE. 100) GO TO 10 
      DO 8 J=1,5
       FMT(J)=IFORM(J,LT) 
 8    CONTINUE
      PRINT FMT, (PL(J),J=1,NW) 
      GO TO 100 
* 
*      PRINT WITH FORMAT OF 100 OR MORE 
   10 LFM = LT - 100
      DO 12 J=1,12
       FMT(J)=FORM2(J,LFM)
 12   CONTINUE
      PRINT FMT, (PL(J),J=1,NW) 
      GO TO 100 
  
*      PRINT WITH FORMATS OF MORE THAN 200 - FSC SENSE BYTE DATA
   20 LFM = LT - 200
      LINE = LINE + 10
      GO TO (21,25,27,31,35,37,39) LFM
  
   21 PRINT 22, (J-33,IFLD(J),J=33,40)
      IF(RTY.EQ.O"33")PRINT 24,  ((FSC(I,J),PL(I*8+J-8),J=1,8),I=1,8) 
      IF(RTY.EQ.O"55")PRINT 24,((ICMTS(I,J),PL(I*8+J-8),J=1,8),I=1,8) 
      GO TO 100 
  
   25 PRINT 26, (J-33,IFLD(J),J=41,48)
      IF(RTY.EQ.O"33")PRINT 24,  ((FSC(I,J),PL(I*8+J-16),J=9,16),I=1,8) 
      IF(RTY.EQ.O"55")PRINT 24,((ICMTS(I,J),PL(I*8+J-16),J=9,16),I=1,8) 
      GO TO 100 
  
   27 PRINT 26, (J-33,IFLD(J),J=49,56)
      IF(RTY.EQ.O"33")PRINT 24,  ((FSC(I,J),PL(I*8+J-24),J=17,24),I=1,8)
      IF(RTY.EQ.O"55")PRINT 24,((ICMTS(I,J),PL(I*8+J-24),J=17,24),I=1,8)
      GO TO 100 
  
   31 PRINT 32, (J-33,IFLD(J),J=33,38)
      IF (RTY.EQ.O"33")PRINT 34,  ((FSC(I,J),PL(I*6+J-6),J=1,6),I=1,8)
      IF (RTY.EQ.O"55")PRINT 34,((ICMTS(I,J),PL(I*6+J-6),J=1,6),I=1,8)
      GO TO 100 
  
   35 PRINT 36, (J-33,IFLD(J),J=39,44)
      IF(RTY.EQ.O"33")PRINT 34,  ((FSC(I,J),PL(I*6+J-12),J=7,12),I=1,8) 
      IF(RTY.EQ.O"55")PRINT 34,((ICMTS(I,J),PL(I*6+J-12),J=7,12),I=1,8) 
      GO TO 100 
  
   37 PRINT 36, (J-33,IFLD(J),J=45,50)
      IF(RTY.EQ.O"33")PRINT 34,  ((FSC(I,J),PL(I*6+J-18),J=13,18),I=1,8)
      IF(RTY.EQ.O"55")PRINT 34,((ICMTS(I,J),PL(I*6+J-18),J=13,18),I=1,8)
      GO TO 100 
  
   39 PRINT 36, (J-33,IFLD(J),J=51,56)
      IF(RTY.EQ.O"33")PRINT 34,  ((FSC(I,J),PL(I*6+J-24),J=19,24),I=1,8)
      IF(RTY.EQ.O"55")PRINT 34,((ICMTS(I,J),PL(I*6+J-24),J=19,24),I=1,8)
      GO TO 100 
  
  100 DO 110 K = 1,NW 
  110 PL(K) = 1H
  
      RETURN
      END 
      SUBROUTINE UCHEK33
**
*             UCHEK33 - ROUTINE USED BY DETAIL SUBROUTINES, TO
*                   TEST FOR CHANGES IN MESSAGE THAT WILL AFFECT
*                   SUBHEADER PRINT.  WHEN CHANGE OCCURS, MODIFY
*                   POINTERS AND CALL PHEAD33 FOR NEW HEADING 
*                   OF DEVICE AND MESSAGE TYPE. 
* 
*        ENTRY CONDITIONS 
*       ------------------- 
*       CURRENT MESSAGE IN PROCESS IS IN (IFLD) 
*     - FOR START OF REPORT, (SVEST) FLAG HAS BEEN PRESET,
*       BY ANALYZER ROUTINES, TO ( -1) TO INDICATE
*       ORIGINAL ENTRY. 
* 
*       EXIT CONDITIONS 
*       ----------------
*       CURRENT APPLICABLE SUB-HEADERS ARE PRINTED , AND FLAGS
*       FOR TEST CHANGES IN NEXT MESSAGE ARE SAVED. 
* 
*       DATA AREAS
*        -----------
*        SVMTY - SAVE MESSAGE TYPE IN PROCESS 
* 
*CALL HPACOM1 
*CALL,HPACOM2 
  
      CALL DREPT3 
  
*       JUMP IF NOT INITIAL ENTRY FOR THIS UNIT 
      IF ( FLAGS(12) .NE. 7HNEW-EST ) GO TO 200 
  
*             INITIALIZE
      FLAGS(12) = 1H
      SVMTY = IFLD(FMTY)
      PDATE = SEBUF(21) 
      CALL HEADER 
      CALL FLIP3
      HCF(4) = 6
      CALL PHEAD33 (1)
      GO TO 500 
  
*         TEST CHANGE IN MESSAGE TYPE 
  200 IF (SVMTY .NE. MTY) GO TO 300 
  
*       TEST CHANGE OF DATE 
      IF (PDATE .EQ. SEBUF(23)) GO TO 500 
                                                                         R2FTAPE
*        INSERT DATE CHANGE FOR SAME MESSAGE                             R2FTAPE
  250 PDATE = SEBUF(23)                                                  R2FTAPE
      HDATA(3) = PDATE                                                   R2FTAPE
      HCF(4) = 6
  
*         AVOID PRINTING DATE CHANGE FOR FSC/CMTS DX
      IF (((RTY.EQ.O"33").OR.(RTY.EQ.O"55")) .AND. (FLAGS(11).NE.3HOFF) 
     ..AND. (MTY .NE. O"60").AND.((MTY.LT.O"2450").OR.(MTY.GT.O"2452")))
     .       GO TO 500
      IF ((LINE+1) .GT. PLF) GO TO 400
      CALL PHEAD33 (4)
      GO TO 500                                                          R2FTAPE
                                                                         R2FTAPE
*         PRINT NEW HEADER FOR NEW MESSAGE                               R2FTAPE
  300 PDATE = SEBUF(23) 
      HDATA(3) = PDATE
      SVMTY = MTY 
*     SET SUBHEADER CONTROLS
      CALL FLIP3                                                         R2FTAPE
      HCF(4) = 6
  
*         EVOKE NEW PAGE HEADERS FOR FSC AND CMTS DX MESSAGES 
      IF (((RTY.EQ.O"33").OR.(RTY.EQ.O"55")) .AND. (FLAGS(11).NE.3HOFF) 
     ..AND. (MTY .NE. O"60").AND.((MTY.LT.O"2450").OR.(MTY.GT.O"2452")))
     .       GO TO 400
      IF ((LINE+7) .GT. PLF) GO TO 400
      CALL PHEAD33 (2)
      GO TO 500 
  
  400 CALL HEADER                                                        R2FTAPE
      CALL PHEAD33 (1)
  
  500 RETURN
      END 
          IDENT  INTEM33
          LCC OVCAP.
          ENTRY  INTEM33
OVLNO     SET    3
          USE    /LINK/ 
LINKET    BSS    1
LINKEM    BSS    1
          USE    *
  
INTEM33   BSS    1
          SX6    ET 
          SA6    LINKET 
          SX6    EC 
          SA6    LINKEM 
          JP     INTEM33
          EJECT 
*CALL COMHPAERT 
          END 
