*DECK HPA38                                                              HPA38
      OVCAP.
      SUBROUTINE HPA38
*                                                                        HPA38
**        CONTROL PROGAM FOR ROUTINES IN OVERLAY (3,8)                   HPA38
*         HPA38 PROCESSES 810/815/825/830/840/845/850/855/860 MEMORY ERR
*         RECORD TYPE: 13B. 
*         ERROR CODE: 322B - MEMORY ERRORS, READ 2 RECORDS AT A TIME. 
*         ERROR CODE: 314B - SECDED ERRORS, READ 1 RECORD  AT A TIME. 
*                                                                        HPA38
*CALL,HPACOM1                                                            HPA38
*CALL,HPACOM2 
  
      IF (FROG(6) .NE. L"T") GO TO 10 
      CALL SECOND (CP)
      PRINT 9,CP
    9 FORMAT ( ' ENTER HPA38, SECOND = ',F10.3) 
   10 CONTINUE
*                                                                        HPA38
*         INITIALIZE ANALYSIS ARRAYS                                     HPA38
      CALL INISET3                                                       HPA38
      CALL DREPT3 
      PNTAN = 0 
      LINE = 60                                                          HPA403J
*                                                                        HPA38
*         CHECK FOR CORRECT ERROR CODES                                  HPA38
  100 CONTINUE
      IF(MTY .EQ. O"314") GO TO 400 
      IF (MTY.NE.O"322") GO TO 900
  
*         SET FLAG FOR MEMORY SUMMARY 
      PNTAN = 1 
      IF((RCFA.NE.3HOFF).OR.(RCFD.NE.3HOFF)) CALL  AN8M23(0)
      GO TO 900                                                          HPA38
  
*     CALL SECDED DETAIL ROUTINE IF D PARAMETER SELECTED
  400 IF ((RCFA .EQ. 2HON) .OR. (RCFD .EQ. 2HON)) THEN
         IF (IFLD(36) .NE. O"3410") CALL DL8SEC1
         IF (IFLD(36) .EQ. O"3410") CALL DL8SEC2
      ENDIF 
      GO TO 900 
  
*         GET NEXT RECORD                                                HPA38
  900 CALL GNR3 
      CALL SETEM3(1)
      IF (TWIC .LT. 6) THEN 
         IF (PREC(FMTY) .EQ. O"322") CALL AN8M23(2) 
         LINE = 60
      ENDIF 
      IF (TWIC .GE. 2) GO TO 100
  
*         CALL TO PRINT ANALYSIS                                         HPA38
      IF (PNTAN.EQ.1) GO TO 950 
      IF (RCFA .EQ. 2HON) THEN
         PL(63) = 1 
         CALL XOVCAP ('ERDIST3',0,0)
         CALL UOVCAP ('ERDIST3')
      ENDIF 
      GO TO 1000
  
  950 IF(RCFA.NE.3HOFF) CALL AN8M23(1)
      PNTAN = 0 
      GO TO 1000
  
*         EXIT ALL RECORD TYPE 13B HAVE BEEN PROCESSED                   HPA38
 1000 CONTINUE                                                           HPA38
      END                                                                HPA38
      SUBROUTINE AN8M23(PNTAN)                                           HPA403J
*                                                                        HPA38
**        DESCRIPTION                                                    HPA38
*         -----------                                                    HPA38
*         SUBROUTINE AN8M23 PROCESSES THE M1/M2/M3/M3CR/PIM3 MEMORY ERR.
*                                                                        HPA38
*         CALLED BY - HPA38                                              HPA38
*         ---------                                                      HPA38
*                                                                        HPA38
*         DATA AREAS                                                     HPA38
*         ----------                                                     HPA38
*                                                                        HPA38
*        IFLD/NFLD DEFINITIONS
*                                                                        HPA38
*         IFLD(21) = 1ST REGISTER, BITS 0 THRU 15                        HPA38
*             (22) = 1ST REGISTER, BITS 16 THRU 31                       HPA38
*             (23) = 1ST REGISTER, BITS 32 THRU 47                       HPA38
*             (24) = 1ST REGISTER, BITS 48 THRU 59                       HPA38
*             (25) = 2ND REGISTER, BITS 00 THRU 15                       HPA38
*             (26) = 2ND REGISTER, BITS 16 THRU 31                       HPA38
*             (27) = 2ND REGISTER, BITS 32 THRU 47                       HPA38
*             (28) = 2ND REGISTER, BITS 48 THRU 59                       HPA38
*             (29) = 3RD REGISTER, BITS 00 THRU 15                       HPA38
*             (30) = 3RD REGISTER, BITS 16 THRU 31                       HPA38
*             (31) = 3RD REGISTER, BITS 32 THRU 47                       HPA38
*             (32) = 3RD REGISTER, BITS 48 THRU 59                       HPA38
*             (33) = 4TH REGISTER, BITS 00 THRU 15                       HPA38
*             (34) = 4TH REGISTER, BITS 16 THRU 31                       HPA38
*             (35) = 4TH REGISTER, BITS 32 THRU 47                       HPA38
*             (36) = 4TH REGISTER, BITS 48 THRU 59                       HPA38
*             (37) = 1ST REGISTER, BITS 60 THRU 63                       HPA38
*             (38) = 1ST REGISTER, REGISTER ID                           HPA38
*             (39) = 2ND REGISTER, BITS 60 THRU 63                       HPA38
*             (40) = 2ND REGISTER, REGISTER ID                           HPA38
*             (41) = 3RD REGISTER, BITS 60 THRU 63                       HPA38
*             (42) = 3RD REGISTER, REGISTER ID                           HPA38
*             (43) = 4TH REGISTER, BITS 60 THRU 63                       HPA38
*             (44) = 4TH REGISTER, REGISTER ID                           HPA38
*             (45) = SYMPTOM CODE 
                                                                         HPA403J
*         NFLD(21) = 5TH REGISTER, BITS 00 THRU 15                       HPA403J
*             (22) = 5TH REGISTER, BITS 16 THRU 31                       HPA403J
*             (23) = 5TH REGISTER, BITS 32 THRU 47                       HPA403J
*             (24) = 5TH REGISTER, BITS 48 THRU 59                       HPA403J
*             (25) = 6TH REGISTER, BITS 00 THRU 15                       HPA403J
*             (26) = 6TH REGISTER, BITS 16 THRU 31                       HPA403J
*             (27) = 6TH REGISTER, BITS 32 THRU 47                       HPA403J
*             (28) = 6TH REGISTER, BITS 48 THRU 59                       HPA403J
*             (29) = 7TH REGISTER, BITS 00 THRU 15
*             (30) = 7TH REGISTER, BITS 16 THRU 31
*             (31) = 7TH REGISTER, BITS 32 THRU 47
*             (32) = 7TH REGISTER, BITS 48 THRU 59
*             (33) = 8TH REGISTER, BITS 00 THRU 15
*             (34) = 8TH REGISTER, BITS 16 THRU 31
*             (35) = 8TH REGISTER, BITS 32 THRU 47
*             (36) = 8TH REGISTER, BITS 48 THRU 59
*             (37) = 5TH REGISTER, BITS 60 THRU 63                       HPA403J
*             (38) = 5TH REGISTER, REGISTER ID                           HPA403J
*             (39) = 6TH REGISTER, BITS 60 THRU 63                       HPA403J
*             (40) = 6TH REGISTER, REGISTER ID                           HPA403J
*             (41) = 7TH REGISTER, BITS 60 THRU 64
*             (42) = 7TH REGISTER, REGISTER ID
*             (43) = 8TH REGISTER, BITS 60 THRU 64
*             (44) = 8TH REGISTER, REGISTER ID
*                                                                        HPA38
*         BELOW ARE THE OCTAL EQUIVALANTS FOR THE REGISTER NUMBERS       HPA38
*         IN THE ORDER IN WHICH THE APPEAR IN THE SEF RECORDS.           HPA403J
*                                                                        HPA38
*         REGISTER   OCTAL                                               HPA38
*            10    =  020B                                               HPA403J
*            00    =  000B                                               HPA403J
*            12    =  022B
*            20    =  040B                                               HPA403J
*            A0    =  240B                                               HPA38
*            A4    =  244B                                               HPA38
*            A8    -  250B                                               HPA38
*            21    =  041B
*                                                                        HPA38
*         THE DATA AREAS BELOW DEFINE WHERE THE DATA IS STORED FOR THE   HPA38
*         ANALYSIS FINAL REPORTING.                                      HPA38
*                                                                        HPA38
*         STOR(1,J) = FAILURES BY BANK (J) - QUAD 0                      HPA38
*         STOR(2,J) = FAILURES BY BANK (J) - QUAD 1                      HPA38
*         STOR(3,J) = FAILURES BY BANK (J) - QUAD 2                      HPA38
*         STOR(4,J) = FAILURES BY BANK (J) - QUAD 3                      HPA38
*                                                                        HPA38
*         STOR(10,J) THRU (68,J) = THE SUMMARY OF ERRORS BY TYPE         HPA38
*         WHERE:                                                         HPA38
*             J = 1  ERROR COUNT                                         HPA38
*             J = 2  ADDRESS                                             HPA38
*             J = 3  TYPE                                                HPA38
*             J = 4  BANK                                                HPA38
*             J = 5  BIT
*             J = 6  PAK/QUAD                                            HPA38
*             J = 7  PAC LOC                                             HPA38
*                                                                        HPA38
*CALL,HPACOM1                                                            HPA38
*CALL,HPACOM2                                                            HPA38
*CALL,HPACOM3                                                            HPA38
      COMMON /SECDED2/ STORSEC(50,6)
      DIMENSION REG(8)
      DATA ((STORSEC(I,J),I=1,50),J=1,6) /300*0/
      DATA IOUERR /2HNO/
  
      DO 10 I = 1,7 
      REG(I) = 0
   10 CONTINUE
      IF (PNTAN .EQ. 2) GO TO 550 
  
*      IF PNTAN (PRINT ANALYSIS) IS SET, THEN PRINT IT
      IF (PNTAN.NE.0) GO TO 600 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     PROCESS THE SUPPORTIVE STATUS BUFFER FAULT SYMPTOM CODE FROM DFT
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
*     DFT REVISION NUMBER 
      VERSION = IFLD(FUN) 
      IF ((VERSION .GE. 4) .AND. ((IFLD(19) .AND. O"1000") .NE. 0)) THEN
         IF (RCFD .NE. 2HON) GO TO 900
         TAG1 = SHIFT(SEFREC(5),12) .AND. O"7777" 
         PRINT 2,VERSION,SEFREC(4),TAG1 
    2    FORMAT (/,11X,'DFT REVISION ',I2,' FAULT SYMPTOM CODE = ', 
     .             R10,R2)
  
*        REPORT WHEN DFT SUPPORTIVE STATUS BUFFER DATE/TIME IS INVALID
         IF ((IFLD(19) .AND. O"4000") .NE. 0) THEN
            PRINT 4 
    4       FORMAT (11X,'DFT-REPORTED WALL CLOCK TIME INTEGRITY HAS ',
     .                  'BEEN LOST')
            LINE = LINE + 1 
         ENDIF
  
         PRINT 6
    6    FORMAT (1X,7(10H----------),9H---------) 
         LINE = LINE + 3
         GO TO 900
      ENDIF 
  
      VALFLG = 3HOFF
      FLAG = 0                                                           HPA403J
      REG(1) = IFLD(38) 
      REG(2) = IFLD(40) 
      REG(3) = IFLD(42) 
      REG(4) = IFLD(44) 
      IF(NFLD(FJOB) .NE. R" CONTINU") GO TO 13
      REG(5) = NFLD(38) 
      REG(6) = NFLD(40) 
      REG(7) = NFLD(42) 
      REG(8) = NFLD(44) 
  
   13 CONTINUE
      IF((REG(1).EQ.O"020").AND.(REG(2).EQ.O"000")) GO TO 20
      IF (RCFD .EQ. 3HOFF) GO TO 900
      PRINT 16,SEBUF(23),IFLD(20) 
   16 FORMAT (1X,A8,2X,A8,' UNRECOGNIZABLE MEMORY REGISTERS ',
     .          'LOGGED FOR REPORTING.')
      FLAG = 2
      CALL DL8M23 (FLAG, ID)
      GO TO 900 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     PROCESS THE MEMORY REGISTERS (8 MAXIMUM)
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
   20 DO 500 I = 1, 8 
      K = 4 * I 
  
      IF (REG(I) .EQ. Z"10") GO TO 30 
      IF (REG(I) .EQ. Z"12") GO TO 45 
      IF (REG(I) .EQ. Z"20") GO TO 50 
      IF (REG(I) .EQ. Z"A0") GO TO 60 
      IF (REG(I) .EQ. Z"A4") GO TO 70 
      IF (REG(I) .EQ. Z"A8") GO TO 80 
      IF (REG(I) .EQ. Z"21") GO TO 500
      IF (REG(I) .EQ. Z"00") GO TO 500
  
*         REGISTER 10 (ELEMENT ID)
*         PROCESS CONTENTS FOR HEADER 
  
   30 CONTINUE
      IFLD(24) = SHIFT(IFLD(24),4) .OR. IFLD(37)
      IELEM = SHIFT(IFLD(23),-8) .AND. Z"FF"
      MODEL = PL(64) = IFLD(23) .AND. Z"FF" 
      IF ((HX(1) .NE. IELEM) .OR. (HX(2) .NE. MODEL) .OR. 
     .    (HX(3) .NE. IFLD(24))) LINE = PLF + 1 
      HX(1) = IELEM 
      HX(2) = MODEL 
      HX(3) = IFLD(24)
  
      IHDR = 42 
      HCF(2) = 4
      IF (RCFA .EQ. 2HON) CALL STOJN3 
  
      SYMPTOM = IFLD(45) .AND. 7
      ICORR = 3H
      IF ((SYMPTOM .GE. 3) .AND. (SYMPTOM .LE. 6)) THEN 
         IF (SYMPTOM .EQ. 3) ICORR = 3HYES
         IF (SYMPTOM .GE. 4) ICORR = 3H NO
      ELSE
         IF ((SHIFT(IFLD(39),-1) .AND. 1) .EQ. 1) ICORR = 3HYES 
         IF ((SHIFT(IFLD(39),-2) .AND. 1) .EQ. 1) ICORR = 3H NO 
      ENDIF 
  
*     ASSIGN MODEL TYPE 
      ID = MODEL
      IF ((ID .GE. Z"10") .AND. (ID .LE. Z"12")) ID = 2HM1
      IF ((ID .GE. Z"13") .AND. (ID .LE. Z"16")) ID = 4HM1CR
      IF  (ID .EQ. Z"31") ID = 4HM3CR 
      IF  ((ID .EQ. Z"34") .OR. (ID .EQ. Z"35")) ID = 4HPIM3
      GO TO 500 
  
  
*         REGISTER 12 (OPTIONS INSTALLED) 
*         PROCESS CONTENTS FOR HEADER 
  
   45 CONTINUE
      IFLD(32) = SHIFT(IFLD(32),4) .OR. IFLD(41)
      IF ((HX(5) .NE. IFLD(29)) .OR. (HX(6) .NE. IFLD(30)) .OR. 
     .    (HX(7) .NE. IFLD(31)) .OR. (HX(8) .NE. IFLD(32))) 
     .    LINE = PLF + 1
      HX(5) = IFLD(29)
      HX(6) = IFLD(30)
      HX(7) = IFLD(31)
      HX(8) = IFLD(32)
  
*     MEMORY SIZE FOR M1 AND M1CR 
  
      IF ((ID .NE. 2HM1) .AND. (ID .NE. 4HM1CR)) GO TO 500
      MFLD = SHIFT(IFLD(17+K),44) 
      MCHIP = SHIFT(IFLD(17+K),-3).AND.1
      IF (MCHIP .NE. 0) GO TO 500 
      DO 48  L = 1,8
      IMEM = SHIFT(MFLD,L).AND.1
      IF(IMEM.EQ.0) GO TO 48
      MSIZE = L 
      IF (MCHIP .NE. 0) GO TO 500 
   48 CONTINUE
      GO TO 500 
                                                                         HPA403J
*         REGISTER 20 (ENVIRONMENT CONTROL) 
*         PROCESS CONTENTS FOR HEADER 
  
   50 CONTINUE
      IFLD(36) = SHIFT(IFLD(36),4) .OR. IFLD(43)
      IF ((HX(9)  .NE. IFLD(33)) .OR. (HX(10) .NE. IFLD(34)) .OR. 
     .    (HX(11) .NE. IFLD(35)) .OR. (HX(12) .NE. IFLD(36))) 
     .    LINE = PLF + 1
      HX(9)  = IFLD(33) 
      HX(10) = IFLD(34) 
      HX(11) = IFLD(35) 
      HX(12) = IFLD(36) 
  
*     NON-INTERLEAVED MODE
  
      IMODE = SHIFT(IFLD(17+K),-13).AND.1 
      IF(IMODE.EQ.1) MODE = 10HNONINTRLVD 
  
*         REGISTER 21 (O. S. BOUNDS)
*         PROCESS CONTENTS FOR HEADER 
  
      IF (REG(8) .EQ. Z"21") THEN 
   55 NFLD(36) = SHIFT(NFLD(36),4) .OR. NFLD(43)
      IF ((HX(13) .NE. NFLD(33)) .OR. (HX(14) .NE. NFLD(34)) .OR. 
     .    (HX(15) .NE. NFLD(35)) .OR. (HX(16) .NE. NFLD(36))) 
     .    LINE = PLF + 1
      HX(13)  = NFLD(33)
      HX(14) = NFLD(34) 
      HX(15) = NFLD(35) 
      HX(16) = NFLD(36) 
      ENDIF 
  
      IF (REG(7) .EQ. Z"21") THEN 
      NFLD(32) = SHIFT(NFLD(32),4) .OR. NFLD(41)
      IF ((HX(13) .NE. NFLD(29)) .OR. (HX(14) .NE. NFLD(30)) .OR. 
     .    (HX(15) .NE. NFLD(31)) .OR. (HX(16) .NE. NFLD(32))) 
     .    LINE = PLF + 1
      HX(13) = NFLD(29) 
      HX(14) = NFLD(30) 
      HX(15) = NFLD(31) 
      HX(16) = NFLD(32) 
      ENDIF 
      GO TO 500 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     PROCESS REGISTER A0 (240B)  CEL 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
*     CHECK THE MEMORY REGISTERS FOR VALIDITY (UPPER BIT) 
   60 IF (I .LE. 4) IVALID = SHIFT(IFLD(17+K),-15) .AND. 1
      IF (I .GT. 4) IVALID = SHIFT(NFLD( 1+K),-15) .AND. 1
      IF (IVALID .EQ. 0) GO TO 500
  
      IF ((ID .EQ. 2HM1) .OR. (ID .EQ. 4HM1CR)) GO TO 65
      IF  (ID .EQ. 4HPIM3) GO TO 63 
                                                                         HPA38
*         EXTRACT THE PORT                                               HPA38
                                                                         HPA403J
      IF(I.LE.4) IPORT = AND(SHIFT(IFLD(17+K),-5),O"7") 
      IF(I.GT.4) IPORT = AND(SHIFT(NFLD(1+K),-5),O"7")
      IF ((I.LE.4).AND.(ID.EQ.4HM3CR))
     .   IPORT = AND(SHIFT(IFLD(17+K),-8),O"7") 
      IF ((I.GT.4).AND.(ID.EQ.4HM3CR))
     .   IPORT = AND(SHIFT(NFLD(1+K),-8),O"7")
      ENCODE (10,881,IPORTD) IPORT
      IPORT = IPORTD
                                                                         HPA403J
*         COMBINE THE 3 IFLDS THAT CONTAIN THE ADDRESS                   HPA403J
                                                                         HPA403J
      IF(I.LE.4) ICOMADR = ((SHIFT(IFLD(17+K),32)).OR.
     .(SHIFT(IFLD(18+K),16)).OR.IFLD(19+K)) 
      IF(I.GT.4) ICOMADR = ((SHIFT(NFLD(1+K),32)).OR. 
     .(SHIFT(NFLD(2+K),16)).OR.NFLD(3+K)) 
      GO TO 100 
  
*        EXTRACT THE PORT FOR PIM3
  
   63 IPORT = AND(SHIFT(NFLD(1+K),-4),O"7") 
      ENCODE (10,881,IPORTD) IPORT
      IPORT = IPORTD
  
* 
*         COMBINE THE 3 NFLDS THAT CONTAIN THE PIM3 ADDRESS 
* 
      ICOMADR = (SHIFT(NFLD(1+K),32)) .OR. (SHIFT(NFLD(2+K),16)) .OR. 
     .          NFLD(3+K) 
      GO TO 100 
  
   65 CONTINUE
  
*        EXTRACT THE PORT FOR M1 AND M1CR 
  
      IF(I.LE.4) IPORT = AND(SHIFT(IFLD(17+K),-9),O"3") 
      IF(I.GT.4) IPORT = AND(SHIFT(NFLD(1+K),-9),O"3")
      IF (ID.EQ.4HM1CR) GO TO 66
      IF (IPORT.EQ.0) IPORT = 4H  J 
      IF (IPORT.EQ.1) IPORT = 4H  M 
      IF (IPORT.EQ.2) IPORT = 4H  I 
      IF (IPORT.EQ.3) IPORT = 4H  O 
      GO TO 67
   66 CONTINUE
      IF (IPORT.EQ.0) IPORT = 4HREF 
      IF (IPORT.EQ.1) IPORT = 4HCPU1
      IF (IPORT.EQ.2) IPORT = 4HIOU 
      IF (IPORT.EQ.3) IPORT = 4HCPU0
   67 CONTINUE
  
*        COMBINE THE 2 IFLDS OR NFLDS THAT CONTAIN THE M1/M1CR ADDRESS
  
      IF(I.LE.4) ICOMADR = SHIFT(IFLD(17+K),16).OR.IFLD(18+K) 
      IF(I.GT.4) ICOMADR = SHIFT(NFLD(1+K),16).OR.NFLD(2+K) 
      GO TO 100 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     PROCESS REGISTER A4 (244B)  UEL1
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
*     CHECK THE MEMORY REGISTERS FOR VALIDITY (UPPER BIT) 
   70 IF (I .LE. 4) IVALID = SHIFT(IFLD(17+K),-15) .AND. 1
      IF (I .GT. 4) IVALID = SHIFT(NFLD( 1+K),-15) .AND. 1
      IF (IVALID .EQ. 0) GO TO 500
  
      IF ((ID .EQ. 2HM1) .OR. (ID .EQ. 4HM1CR)) GO TO 75
      IF  (ID .EQ. 4HPIM3) GO TO 73 
                                                                         HPA403J
*         EXTRACT THE PORT                                               HPA403J
                                                                         HPA403J
      IF (I.LE.4) IPORT = AND (SHIFT(IFLD(17+K),-5),O"7") 
      IF (I.GT.4) IPORT = AND(SHIFT(NFLD(1+K),-5),O"7") 
      IF ((I.LE.4).AND.(ID.EQ.4HM3CR))
     .   IPORT = AND(SHIFT(IFLD(17+K),-8),O"7") 
      IF ((I.GT.4).AND.(ID.EQ.4HM3CR))
     .   IPORT = AND(SHIFT(NFLD(1+K),-8),O"7")
      IF ((ID .EQ. Z"30") .OR. (ID .EQ. 4HM3CR)) THEN 
         IF ((IPORT .EQ. 1) .OR. (IPORT .EQ. 3)) IOUERR = 3HYES 
      ENDIF 
      ENCODE (10,881,IPORTD) IPORT
      IPORT = IPORTD
                                                                         HPA403J
*         COMBINE THE 3 NFLDS THAT CONTAIN THE ADDRESS                   HPA403J
                                                                         HPA403J
      IF(I.LE.4) ICOMADR = ((SHIFT(IFLD(17+K),32)).OR.
     .(SHIFT(IFLD(18+K),16)).OR.IFLD(19+K)) 
      IF (I.GT.4) ICOMADR = ((SHIFT(NFLD(1+K),32)).OR.
     .(SHIFT(NFLD(2+K),16)).OR.NFLD(3+K)) 
      GO TO 100 
  
*        EXTRACT THE PORT FOR PIM3
  
   73 IPORT = AND(SHIFT(NFLD(1+K),-4),O"7") 
      IF ((IPORT .EQ. 1) .OR. (IPORT .EQ. 3)) IOUERR = 3HYES
      ENCODE (10,881,IPORTD) IPORT
      IPORT = IPORTD
  
* 
*         COMBINE THE 3 NFLDS THAT CONTAIN THE PIM3 ADDRESS 
* 
      ICOMADR = (SHIFT(NFLD(1+K),32)) .OR. (SHIFT(NFLD(2+K),16)) .OR. 
     .          NFLD(3+K) 
      GO TO 100 
  
   75 CONTINUE
  
*        EXTRACT THE PORT FOR M1 AND M1CR 
  
      IF(I.LE.4) IPORT = AND(SHIFT(IFLD(17+K),-9),O"3") 
      IF(I.GT.4) IPORT = AND(SHIFT(NFLD(1+K),-9),O"3")
      IF (ID.EQ.4HM1CR) GO TO 76
      IF (IPORT.EQ.0) IPORT = 4H  J 
      IF (IPORT.EQ.1) IPORT = 4H  M 
      IF (IPORT.EQ.2) IPORT = 4H  I 
      IF (IPORT.EQ.3) IPORT = 4H  O 
      GO TO 77
   76 CONTINUE
      IF (IPORT.EQ.0) IPORT = 4HREF 
      IF (IPORT.EQ.1) IPORT = 4HCPU1
      IF (IPORT.EQ.2) IPORT = 4HIOU 
      IF (IPORT.EQ.3) IPORT = 4HCPU0
   77 CONTINUE
  
*        COMBINE THE 2 IFLDS OR NFLDS THAT CONTAIN THE M1/M1CR ADDRESS
  
      IF(I.LE.4) ICOMADR = SHIFT(IFLD(17+K),16).OR.IFLD(18+K) 
      IF(I.GT.4) ICOMADR = SHIFT(NFLD(1+K),16).OR.NFLD(2+K) 
      GO TO 100 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     PROCESS REGISTER A8 (250B)  UEL2
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
*     CHECK THE MEMORY REGISTERS FOR VALIDITY (UPPER BIT) 
   80 IF (I .LE. 4) IVALID = SHIFT(IFLD(17+K),-15) .AND. 1
      IF (I .GT. 4) IVALID = SHIFT(NFLD( 1+K),-15) .AND. 1
      IF (IVALID .EQ. 0) GO TO 500
  
      IF ((ID .EQ. 2HM1) .OR. (ID .EQ. 4HM1CR)) GO TO 85
      IF  (ID .EQ. 4HPIM3) GO TO 83 
  
*         EXTRACT THE PORT
  
      IF (I .LE. 4) IPORT = AND (SHIFT(IFLD(17+K),-5),O"7") 
      IF (I .GT. 4) IPORT = AND (SHIFT(NFLD( 1+K),-5),O"7") 
      IF ((I .LE. 4) .AND. (ID .EQ. 4HM3CR))
     .   IPORT = AND(SHIFT(IFLD(17+K),-8),O"7") 
      IF ((I .GT. 4) .AND. (ID .EQ. 4HM3CR))
     .   IPORT = AND(SHIFT(NFLD(1+K),-8),O"7")
      IF ((ID .EQ. Z"30") .OR. (ID .EQ. 4HM3CR)) THEN 
         IF ((IPORT .EQ. 1) .OR. (IPORT .EQ. 3)) IOUERR = 3HYES 
      ENDIF 
      ENCODE (10,881,IPORTD) IPORT
      IPORT = IPORTD
  
*         COMBINE THE 3 NFLDS THAT CONTAIN THE ADDRESS
  
      IF (I .LE. 4) ICOMADR = ((SHIFT(IFLD(17+K),32)) .OR.
     .                         (SHIFT(IFLD(18+K),16)) .OR. IFLD(19+K))
      IF (I .GT. 4) ICOMADR = ((SHIFT(NFLD( 1+K),32)) .OR.
     .                         (SHIFT(NFLD( 2+K),16)) .OR. NFLD(3+K)) 
      GO TO 100 
  
*        EXTRACT THE PORT FOR PIM3
  
   83 IPORT = AND(SHIFT(NFLD(1+K),-4),O"7") 
      IF ((IPORT .EQ. 1) .OR. (IPORT .EQ. 3)) IOUERR = 3HYES
      ENCODE (10,881,IPORTD) IPORT
      IPORT = IPORTD
  
* 
*         COMBINE THE 4 IFLDS THAT CONTAIN THE PIM3 ADDRESS 
* 
      ICOMADR = (SHIFT(NFLD(1+K),32)) .OR. (SHIFT(NFLD(2+K),16)) .OR. 
     .          NFLD(3+K) 
      GO TO 100 
  
*        EXTRACT THE PORT FOR M1 AND M1CR 
  
   85 IF (I .LE. 4) IPORT = AND(SHIFT(IFLD(17+K),-9),O"3")
      IF (I .GT. 4) IPORT = AND(SHIFT(NFLD( 1+K),-9),O"3")
      IF (ID .EQ. 4HM1CR) GO TO 86
      IF (IPORT .EQ. 0) IPORT = 4H  J 
      IF (IPORT .EQ. 1) IPORT = 4H  M 
      IF (IPORT .EQ. 2) IPORT = 4H  I 
      IF (IPORT .EQ. 3) IPORT = 4H  O 
      GO TO 87
  
   86 IF (IPORT .EQ. 0) IPORT = 4HREF 
      IF (IPORT .EQ. 1) IPORT = 4HCPU1
      IF (IPORT .EQ. 2) IPORT = 4HIOU 
      IF (IPORT .EQ. 3) IPORT = 4HCPU0
  
*          COMBINE THE 2 IFLDS OR NFLDS THAT CONTAIN THE M1/M1CR ADDRESS
  
   87 IF (I .LE. 4) ICOMADR = SHIFT(IFLD(17+K),16) .OR. IFLD(18+K)
      IF (I .GT. 4) ICOMADR = SHIFT(NFLD( 1+K),16) .OR. NFLD(2+K) 
      GO TO 100 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     PREPARE THE ADDRESS, PAK, BANK, BIT AND BOARD 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
  100 VALFLG = 2HON 
      IF(ID.EQ.2HM1) GO TO 150
      IF (ID.EQ.4HM1CR) GO TO 170 
      IF (ID .EQ. 4HPIM3) GO TO 140 
                                                                         HPA403J
*         EXTRACT THE ADDRESS                                            HPA403J
                                                                         HPA403J
      IADDR = AND(SHIFT(ICOMADR,-14),O"777 7777") 
      IF (ID.EQ.4HM3CR) IADDR = AND(SHIFT(ICOMADR,-14),O"3 7777 7777")
                                                                         HPA38
*         EXTRACT THE PAK                                                HPA38
                                                                         HPA38
      IPAK = AND(SHIFT(IADDR,-19),O"3") 
      IF (ID.EQ.4HM3CR) IPAK = AND(SHIFT(IADDR,-22),O"3") 
      ENCODE(10,880,IPAKD)IPAK
                                                                         HPA38
*         EXTRACT THE BANK                                               HPA38
                                                                         HPA38
      IBANK = AND(IADDR,O"7") 
      IF(MODE.EQ.10HNONINTRLVE) IBANK = AND(SHIFT(IADDR,-10),O"7")
      GO TO 190 
  
*         EXTRACT THE ADDRESS FOR PIM3
  
  140 IADDR = AND(SHIFT(ICOMADR,-8),Z"FFF FFFF")
  
*         EXTRACT THE MODULE FOR PIM3 
  
      IF (MODEL .EQ. Z"34") IPAK = AND(SHIFT(IADDR,-23),3)
      IF (MODEL .EQ. Z"35") IPAK = AND(SHIFT(IADDR,-25),3)
      INC = IPAK + 1
      ENCODE (10,880,IPAKD) INC 
  
*         EXTRACT THE BANK FOR PIM3 
  
      IBANK = IADDR .AND. O"7"
      GO TO 190 
  
  150 CONTINUE
  
*          EXTRACT THE ADDRESS FOR M1 
  
      IADDR = AND(SHIFT(ICOMADR,-3),O"777 7777")
      IF (MCHIP.NE.0) IADDR = ICOMADR.AND.O"7777 7777"
  
*          EXTRACT THE PAK FOR M1 
  
*       M1 WITH NO PAK SELECT 
      IPAK = 4
  
      IF((MSIZE.EQ.6).OR.(MSIZE.EQ.8)) IPAK = AND(SHIFT(IADDR,-19),O"1")
      IF (MCHIP.NE.0) IPAK = AND(SHIFT(IADDR,-21),1)
      IF(IPAK.NE.4) ENCODE(10,880,IPAKD)IPAK
      IF(IPAK.EQ.4) IPAKD = 1H
  
*          EXTRACT THE BANK FOR M1
  
      IBANK = IADDR.AND.O"3"
      IF(MODE.EQ.10HNONINTRLVE) IBANK = SHIFT(IADDR,-16).AND.O"3" 
      IF(MSIZE.EQ.1) IBANK = IBANK.AND.O"1" 
      GO TO 190 
  170 CONTINUE
  
*      EXTRACT THE ADDRESS FOR M1CR 
  
      IADDR = ICOMADR.AND.O"7777 7777"
  
*      EXTRACT THE PAK FOR M1CR 
  
*      NO PAK SELECT
      IPAK = 4
      IF ((MCHIP.EQ.0).AND.(L.NE.2)) IPAK = AND(SHIFT(IADDR,-19),O"3")
      IF (MCHIP.NE.0) IPAK = AND(SHIFT(IADDR,-21),3)
      ENCODE (10,880,IPAKD) IPAK
      IF (IPAK.EQ.4) IPAKD = 1H 
  
*       EXTRACT THE BANK FOR M1CR 
  
      IBANK = IADDR.AND.O"3"
      IF (L.EQ.2) IBANK = IBANK.AND.1 
  190 CONTINUE
                                                                         HPA31B1
*     FIND THE BIT AND THE BOARD                                         HPA31B1
                                                                         HPA31B1
      PL(10) = PL(11) = PL(12) = 10H
      IF (REG(I) .EQ. Z"A0") CALL BRBIT38 (IBANK, IPAK, ID) 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     STORE DATA FOR THE ANALYSIS REPORT
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
      IF (RCFA .EQ. 3HOFF) GO TO 450
      IF (ICORR .EQ. 3H   ) GO TO 450 
  
      DO 200 II = 10, 68
      IF (STOR(II,1) .EQ. 0) GO TO 300
      IF ((STOR(II,2).EQ.IADDR) .AND. (STOR(II,3).EQ.ICORR)) GO TO 300
  200 CONTINUE
      GO TO 400 
  
  300 STOR(II,1) = STOR(II,1) + 1 
      STOR(II,2) = IADDR
      STOR(II,3) = ICORR
      STOR(II,4) = IBANK
      STOR(II,5) = PL(10) 
      STOR(II,6) = IPAKD
      STOR(II,7) = PL(12) 
  
  400 II = IPAK + 1 
      JJ = IBANK + 1
      STOR(II,JJ) = STOR(II,JJ) + 1 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     STORE DATA FOR THE DETAIL REPORT
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
  450 IF (RCFD .EQ. 3HOFF) GO TO 500
      PL(3) = IPORT 
      PL(4) = IPAKD 
      PL(5) = IBANK 
      PL(6) = IADDR 
  
      CALL DL8M23 (FLAG, ID)
  500 CONTINUE
  
*     CHECK IF THERE WERE ANY VALID REGISTERS TO REPORT 
      IF (RCFD .EQ. 3HOFF) GO TO 900
      IF (VALFLG .EQ. 3HOFF) PRINT 510,SEBUF(23),IFLD(20) 
  510    FORMAT (1X,A8,2X,A8,' THERE WERE NO VALID MEMORY REGISTERS ',
     .          'LOGGED FOR REPORTING.')
  
*     REPORT THE SYMPTOM CODE AND SNAPSHOT OF REGISTERS 
      FLAG = 1
      CALL DL8M23 (FLAG, ID)
      GO TO 900 
  
*     PRINT IO PORT ERROR MESSAGE 
  550 IF ((RCFD .EQ. 2HON) .AND. (IOUERR .EQ. 3HYES)) THEN
        IF ((LINE + 11) .GT. PLF) CALL HEADER 
        PRINT 895 
      ENDIF 
      GO TO 900 
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*     PRINT THE ANALYSIS REPORT 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
                                                                         HPA38
  600 CONTINUE                                                           HPA38
      IF (RCFA.NE.2HON) GO TO 900 
      PL(63) = 1
      CALL XOVCAP ('ERDIST3',0,0) 
      CALL UOVCAP ('ERDIST3') 
  
      HCF(1) = 7                                                         HPA38
      HCF(2) = 2                                                         HPA38
      NPAK = 0
      IF (ID .EQ. 4HPIM3) NPAK = 1
      CALL PHEAD38 (1)
                                                                         HPA38
*         PRINT THE SUMMARY OF ERRORS BY BANK AND QUAD                   HPA38
                                                                         HPA38
      DO 700 I=1,4                                                       HPA38
      DO 650 J=1,8                                                       HPA403J
      IF (STOR(I,J) .NE. 0) GO TO 670                                    HPA403J
  650 CONTINUE                                                           HPA403J
      GO TO 690                                                          HPA403J
  670 CONTINUE                                                           HPA403J
      ENCODE(10,880,HDATA(1))NPAK 
      CALL PHEAD38 (2)
      CALL LOAPR(1,STOR(I,1),STOR(I,2),STOR(I,3),STOR(I,4),              HPA38
     .           STOR(I,5),STOR(I,6),STOR(I,7),STOR(I,8)) 
      CALL PRINT38 (5,8)
  690 CONTINUE                                                           HPA403J
      NPAK = NPAK + 1 
  700 CONTINUE                                                           HPA38
      HCF(1) = 3                                                         HPA38
                                                                         HPA38
*      PRINT THE SUMMARY OF UNCORRECTED MEMORY ERRORS BY ADDRESS
      DO 750  II = 10,68
      IF (STOR(II,3).EQ.3H NO) GO TO 760
      IF (STOR(II,1).EQ.0) GO TO 850
  750 CONTINUE
      GO TO 850 
  760 CONTINUE
      IF ((LINE + 7).GE.PLF) CALL HEADER
                                                                         HPA38
      CALL PHEAD38 (1)
      DO 800 I = II,68
      IF (STOR(I,1).EQ.0) GO TO 850 
      IF (STOR(I,3).EQ.3HYES) GO TO 800 
      CALL LOAPR(1,STOR(I,1),STOR(I,2),STOR(I,4),STOR(I,6),SP,SP,SP,SP) 
      CALL PRINT38(10,4)
  800 CONTINUE                                                           HPA38
  850 CONTINUE
* 
      IF (STORSEC(1,1).EQ.0) GO TO 878
      DO 852  II = 1,50 
      IF (STORSEC(II,1).GT.1) GO TO 855 
      IF (STORSEC(II,1).EQ.0) GO TO 870 
  852 CONTINUE
      GO TO 870 
  855 HCF(1) = 9
      IF ((LINE + 7).GE.PLF) CALL HEADER
      CALL PHEAD38 (1)
*     PRINT ACCUMULATION OF POTENTIAL HARD SECDED ERRORS
      DO 860  I = II,50 
      IF (STORSEC(I,1).EQ.0) GO TO 870
      IF (STORSEC(I,1).EQ.1) GO TO 860
      PL(1) = STORSEC(I,1)
      PL(2) = STORSEC(I,2)
      PL(3) = 10H 
      PL(4) = STORSEC(I,3)
      PL(5) = STORSEC(I,4)
      PL(6) = STORSEC(I,5)
      PL(7) = STORSEC(I,6)
      CALL PRINT38(6,7) 
  860 CONTINUE
  870 CONTINUE
      DO 872  II = 1,50 
      IF (STORSEC(II,1).EQ.1) GO TO 874 
      IF (STORSEC(II,1).EQ.0) GO TO 878 
  872 CONTINUE
      GO TO 878 
  874 HCF(1) = 10 
      IF ((LINE + 7).GE.PLF) CALL HEADER
      CALL PHEAD38 (1)
*     PRINT ACCUMULATION OF POTENTIAL TRANSIENT SECDED ERRORS 
      DO 876  I = II,50 
      IF (STORSEC(I,1).EQ.0) GO TO 878
      IF (STORSEC(I,1).NE.1) GO TO 876
      PL(1) = STORSEC(I,2)
      PL(2) = STORSEC(I,3)
      PL(3) = STORSEC(I,4)
      PL(4) = STORSEC(I,5)
      PL(5) = STORSEC(I,6)
      CALL PRINT38(11,5)
  876 CONTINUE
  878 CONTINUE
      PL(63) = PL(64) = 1H
  
  880 FORMAT(O1,9X) 
  881 FORMAT (2X,O1,7X) 
  882 FORMAT (O2,8X)
  
      IF (IOUERR .EQ. 3HYES) PRINT 895
  895 FORMAT(///,1X,'* * * * * * * * * * * * * * * * * * * * * * * * * '
     .             ,'* * * * * * * * * * * * * *',/,
     .           1X,'*  TO COMPLETELY ANALYZE IOU PORT ERROR(S) IT IS N'
     .             ,'ECESSARY TO CHECK WHETHER *',/,
     .           1X,'*  ADDITIONAL FAILURE DATA WAS CONCURRENTLY RECORD'
     .             ,'ED (IDENTICAL FAILURE     *',/,
     .           1X,'*  TIME STAMP) FOR THE IOU OR FOR A PERIPHERAL CON'
     .             ,'TROLLER WHILE DOING A DMA *',/,
     .           1X,'*  TRANSFER OVER A CIO CHANNEL.  IF ONLY A CHANNEL'
     .             ,' PARITY ERROR WAS         *',/,
     .           1X,'*  CONCURRENTLY RECORDED FOR THE IOU A CONTROLLER '
     .             ,'ON THE CHANNEL SPECIFIED  *',/,
     .           1X,'*  COULD HAVE AN ASSCOCIATED ERROR, OTHERWISE, ALL'
     .             ,' CONTROLLERS ON CIO       *',/,
     .           1X,'*  CHANNELS FOR THAT IOU MAY HAVE TO BE CHECKED FO'
     .             ,'R AN ASSOCIATED ERROR.    *',/,
     .           1X,'* * * * * * * * * * * * * * * * * * * * * * * * * '
     .             ,'* * * * * * * * * * * * * *')
  
  
  900 RETURN                                                             HPA38
      END                                                                HPA38
      SUBROUTINE  BRBIT38(IBK,IPK,ID) 
*                                                                        HPA31B1
**        DESCRIPTION                                                    HPA31B1
*         -----------                                                    HPA31B1
*                                                                        HPA31B1
*         BDBIT38 - FIRST FIGURES OUT THE FAILING BIT FROM               HPA31B1
*         THE SYNDROME CODE.  SECOND IT FIGURES OUT THE                  HPA31B1
*         BOARD FROM THE BANK, QUAD, AND BIT.                            HPA31B1
*         PARAMETERS - IBK IS THE BANK, IPK IS THE PAK                   HPA31B1
*                                                                        HPA31B1
*         CALLED BY - AN8M23                                             HPA31B1
*         ---------                                                      HPA31B1
*                                                                        HPA31B1
*         DATA AREAS                                                     HPA31B1
*         ----------                                                     HPA31B1
*                                                                        HPA31B1
*         IBITTBL - TABLE USED TO PICK OUT THE BIT FROM THE              HPA31B1
*         SYNDROME CODE.  THE TABLE IS SEARCHED FOR A MATCH              HPA31B1
*         AND WHEN ONE IS FOUND, THE BIT NUMBER IS THE INDEX             HPA31B1
*         INTO THE TABLE MINUS 1.                                        HPA31B1
*                                                                        HPA31B1
*CALL HPACOM1                                                            HPA31B1
                                                                         HPA31B1
      DIMENSION IBITTBL(72)                                              HPA31B1
      DIMENSION M1CRBIT(72) 
                                                                         HPA31B1
                                                                         HPA31B1
      DATA (IBITTBL(I),I=1,72) /                                         HPA31B1
     .2H0E,   2H9E,   2H5E,   2HCE,   2H3E,                              HPA31B1
     .2HAE,   2H6E,   2HFE,   2H0D,   2H9D,                              HPA31B1
     .2H5D,   2HCD,   2H3D,   2HAD,   2H6D,                              HPA31B1
     .2HFD,   2H0B,   2H9B,   2H5B,   2HCB,                              HPA31B1
     .2H3B,   2HAB,   2H6B,   2HFB,   2H07,                              HPA31B1
     .2H97,   2H57,   2HC7,   2H37,   2HA7,                              HPA31B1
     .2H67,   2HF7,   2HE0,   2HE9,   2HE5,                              HPA31B1
     .2HEC,   2HE3,   2HEA,   2HE6,   2HEF,                              HPA31B1
     .2HD0,   2HD9,   2HD5,   2HDC,   2HD3,                              HPA31B1
     .2HDA,   2HD6,   2HDF,   2HB0,   2HB9,                              HPA31B1
     .2HB5,   2HBC,   2HB3,   2HBA,   2HB6,                              HPA31B1
     .2HBF,   2H70,   2H79,   2H75,   2H7C,                              HPA31B1
     .2H73,   2H7A,   2H76,   2H7F,   2H80,                              HPA31B1
     .2H40,   2H20,   2H10,   2H08,   2H04,                              HPA31B1
     .2H02,   2H01/                                                      HPA31B1
  
      DATA (M1CRBIT(I),I=1,72)/ 
     .2HE0,   2HE9,   2HE5,   2HEC,   2HB0, 
     .2HB9,   2HB5,   2HBC,   2H0E,   2H9E, 
     .2H5E,   2HCE,   2H0B,   2H9B,   2H5B, 
     .2HCB,   2HE3,   2HEA,   2HE6,   2HEF, 
     .2HB3,   2HBA,   2HB6,   2HBF,   2H3E, 
     .2HAE,   2H6E,   2HFE,   2H3B,   2HAB, 
     .2H6B,   2HFB,   2HD0,   2HD9,   2HD5, 
     .2HDC,   2H70,   2H79,   2H75,   2H7C, 
     .2H0D,   2H9D,   2H5D,   2HCD,   2H07, 
     .2H97,   2H57,   2HC7,   2HD3,   2HDA, 
     .2HD6,   2HDF,   2H73,   2H7A,   2H76, 
     .2H7F,   2H3D,   2HAD,   2H6D,   2HFD, 
     .2H37,   2HA7,   2H67,   2HF7,   2H80, 
     .2H40,   2H20,   2H10,   2H08,   2H04, 
     .2H02,   2H01/ 
  
      IBIT = 77 
      IF(MTY .NE. O"314") GO TO 5 
      ISYN = PL(11) 
      GO TO 20
5     CONTINUE
                                                                         HPA31B1
      IF (ID .EQ. 4HPIM3) THEN
         ISYN = SHIFT(NFLD(24),-4) .AND. Z"FF"
         GO TO 20 
      ENDIF 
      IF(IFLD(44).NE.O"240") GO TO 10 
      ILEFT = AND (SHIFT(IFLD(35),2),O"374")
      ISYN = OR(ILEFT,AND(SHIFT(IFLD(36),-10),O"3"))
      IF(ID.EQ.2HM1) ISYN = SHIFT(IFLD(35),-8).AND.O"377" 
      IF (ID.EQ.4HM1CR) ISYN = SHIFT(IFLD(35),-8).AND.O"377"
      GO TO 20
   10 CONTINUE
      IF(NFLD(38).NE.O"240") GO TO 1000 
      ILEFT = AND(SHIFT(NFLD(23),2),O"374") 
      ISYN = OR(ILEFT,AND(SHIFT(NFLD(24),-10),O"3"))
      IF(ID.EQ.2HM1) ISYN = SHIFT(NFLD(23),-8).AND.O"377" 
      IF (ID.EQ.4HM1CR) ISYN = SHIFT(NFLD(23),-8).AND.O"377"
   20 CONTINUE
                                                                         HPA31B1
*     CONVERT FROM RIGHT JUSTIFIED BINARY (HEX) TO DISPLAY               HPA31B1
*     CODE LEFT JUSTIFIED.                                               HPA31B1
                                                                         HPA31B1
      ENCODE(10,900,ISYND)ISYN                                           HPA31B1
      PL(11) = ISYND                                                     HPA31B1
      IF (ID.EQ.4HM1CR) GO TO 120 
      DO 100 I=1,72                                                      HPA31B1
  100 IF (IBITTBL(I) .EQ. ISYND)GO TO 200                                HPA31B1
      GO TO 160 
  120 CONTINUE
      DO 150  I = 1,72
      IF (M1CRBIT(I).EQ.ISYND) GO TO 200
  150 CONTINUE
  160 CONTINUE
      IF ((ID.EQ.4HM3CR).AND.(IPK.EQ.3H***)) GO TO 170
      IF (ID.EQ.2HM1) GO TO 300 
      IF (ID.EQ.4HM1CR) GO TO 350 
      IF (ID.EQ.4HM3CR) GO TO 380 
      PL(10) = 10H                                                       HPA31B1
      PL(12) = 10H                                                       HPA31B1
      GO TO 1000                                                         HPA31B1
  170 PL(10) = 3H***
      GO TO 1000
  200 IBIT = I-1                                                         HPA31B1
      IF (ID .EQ. 4HPIM3) GO TO 402 
      IF (ID.EQ.4HM1CR) GO TO 350 
      IF (ID.EQ.4HM3CR) GO TO 375 
      LET = 1HA                                                          HPA31B1
      IF(ID.EQ.2HM1) GO TO 300
      IF ((IBIT .GE. 32).AND.(IBIT .LE. 63))LET = 1HE                    HPA31B1
      IF ((IBIT .GE. 68).AND.(IBIT .LE. 71))LET = 1HE                    HPA31B1
      IF ((IBK .GE. 4).AND.(IBK .LE. 7))
     .   LET = LET + O"0100 0000 0000 0000 0000"
      NUM = 6  +  ( (3-IPK) *4) + (IBK-4)                                HPA31B1
      IF ((LET .EQ. 1HA).OR.(LET .EQ. 1HE))                              HPA31B1
     .   NUM = 4 + (IPK*4) + IBK                                         HPA31B1
      GO TO 400 
  300 CONTINUE
      LET = 1HA 
      NUM = 7-IBK*2 
      IF(IPK.EQ.1) NUM = NUM+1
      GO TO 400 
  350 CONTINUE
      LET = 1HB 
      IF (IPK.EQ.4) IPK = 0 
      NUM = 16 + IBK*4 - IPK
      GO TO 400 
  375 CONTINUE
      IF (IPK.NE.3H***) GO TO 380 
      PL(10) = 3H***
      GO TO 1000
  380 CONTINUE
      LET = 1HA 
      IF (IBK.GE.4) LET = 1HB 
      JBK = IBK 
      IF (JBK.GE.4) JBK = JBK - 4 
      N = 1 
      IF (JBK.GT.1) N = 7 
      NUM = JBK * 4 + IPK + N 
  400 CONTINUE
      ENCODE(10,901,PL(12))LET,NUM                                       HPA31B1
  402 CONTINUE
      ENCODE(10,902,PL(10))IBIT                                          HPA31B1
      IF (IBIT.EQ.77) PL(10) = 10H
                                                                         HPA31B1
  900 FORMAT (Z2)                                                        HPA31B1
  901 FORMAT (A1,I2)                                                     HPA31B1
  902 FORMAT (I2)                                                        HPA31B1
  903 FORMAT (1X,I2,7X) 
  904 FORMAT (1X,Z2,7X) 
                                                                         HPA31B1
 1000 RETURN                                                             HPA31B1
      END                                                                HPA31B1
      SUBROUTINE DL8M23 (NOPNT,ID)
*                                                                        HPA38
**        DESCRIPTION                                                    HPA38
*         -----------                                                    HPA38
*         SUBROUTINE DL8M23 PRINTS DETAIL REPORT FOR M1/M2/M3/M3CR/PIM3.
*         NOPNT SAYS THE WAS A PROBLEM IN THE REGISTERS, THE             HPA31B1
*         DETAIL LINE SHOULD NOT BE PRINTED, BUT THE EXTENDED            HPA31B1
*         DETAIL SHOULD BE IF CALLED FOR.  (SO THE PROBLEM CAN           HPA31B1
*         BE FIGURED OUT)                                                HPA31B1
*                                                                        HPA31B1
*                                                                        HPA38
*         CALLED BY - AN8M23                                             HPA38
*         ---------                                                      HPA38
*                                                                        HPA38
*         DATA AREAS                                                     HPA31B1
*         ---- -----                                                     HPA31B1
*                                                                        HPA31B1
*         PL ARRAY - WHERE THE DATA IS STORED FOR PRINTING               HPA31B1
*         AND ALSO TO PASS INFORMATION BETWEEN THIS SUBROUTINE           HPA31B1
*         AND AN8M23                                                     HPA31B1
*                                                                        HPA31B1
*                  WHAT'S STORED          FORMAT                         HPA31B1
*         PL(1)  = DATE                     A8                           HPA31B1
*         PL(2)  = TIME                     A8                           HPA31B1
*         PL(3)  = PORT                                A4 
*         PL(4)  = PAK/MODULE                          A3 
*         PL(5)  = BANK                                01 
*         PL(6)  = ADDRESS                             Z8 
*         PL(7)  =               (NOT USED)            -- 
*         PL(8)  =               (NOT USED)            -- 
*         PL(9)  =               (NOT USED)            -- 
*         PL(10) = BIT                                 A2 
*         PL(11) = SYNDROME CODE                       A2 
*         PL(12) = PAK LOCATION  (NOT USED FOR PIM3)   A3 
*                                                                        HPA38
*CALL,HPACOM1                                                            HPA38
*CALL,HPACOM2                                                            HPA38
                                                                         HPA38
      DIMENSION MSG (4, 8)
      DATA (MSG(I,1),I=1,4,1)/
     .10HDEADSTART ,10HERROR LOG ,10HMEMORY ERR,10HOR        /
      DATA (MSG(I,2),I=1,4,1)/
     .10HEXPRESS DE,10HADSTART ME,10HMORY DUMP ,10H          /
      DATA (MSG(I,3),I=1,4,1)/
     .10HCORRECTED ,10HMEMORY ERR,10HOR        ,10H          /
      DATA (MSG(I,4),I=1,4,1)/
     .10HUNCORRECTE,10HD MEMORY E,10HRROR      ,10H          /
      DATA (MSG(I,5),I=1,4,1)/
     .10HFATAL CM E,10HRROR (MULT,10HIPLE ODD B,10HIT ERROR) /
      DATA (MSG(I,6),I=1,4,1)/
     .10HFATAL CM E,10HRROR (PART,10HIAL WRITE ,10HPE)       /
      DATA (MSG(I,7),I=1,4,1)/
     .10HUNIDENTIFI,10HED DFT ERR,10HOR CODE   ,10H          /
      DATA (MSG(I,8),I=1,4,1)/
     .10HMULTIPLE E,10HRROR OCCUR,10HRENCE     ,10H          /
  
      DATA SDATE /0/
  
      IF (NOPNT .EQ. 1) GO TO 45
      IF (NOPNT .EQ. 2) GO TO 50
                                                                         HPA38
*         FINISH PUTTING THINGS INTO THE PRINT LINE ARRAY (PL)           HPA38
                                                                         HPA38
      PL(13) = PL(14) = PL(15) = 10H                                     HPA31B1
      PL(1) = SEBUF(23)                                                  HPA38
      IF(SDATE.EQ.SEBUF(23)) PL(1) = 10H
*         SAVE THE DATE TO SEE IF THE NEXT DATE SHOULD BE                HPA38
*         BLANKED OUT.                                                   HPA38
      SDATE = SEBUF(23) 
      PL(2) = IFLD(20)                                                   HPA38
      IF (STIME .EQ. IFLD(20)) PL(2) = 1H 
      STIME = IFLD(20)
      IF (PL(2) .NE. 1H ) CALL PLSEC(5) 
      CALL PRINT38 (3, 12)
      GO TO 500 
  
*     DEFINE THE ERROR MESSAGE
   45 J = 0 
  
*     CHECK FOR DFT ERROR MESSAGE 
      IF ((IFLD(45) .GE. O"401") .AND. (IFLD(45) .LE. O"406"))
     .    J = IFLD(45) .AND. 7
      IF ((IFLD(45) .GE. O"4401") .AND. (IFLD(45) .LE. O"4406"))
     .    J = IFLD(45) .AND. 7
  
      IF (J .NE. 0) THEN
         IDFTCD = IFLD(45)
         SEQNO = IFLD(19) 
         CALL LOAPR (1,IDFTCD,MSG(1,J),MSG(2,J),MSG(3,J),MSG(4,J),
     .                 SEQNO,SP,SP) 
         CALL PRINT38 (1,6) 
  
*        CHECK FOR MULTIPLE DFT ERRORS
         IF ((IFLD(45) .AND. O"4000") .NE. 0) THEN
            CALL LOAPR (1,MSG(1,8),MSG(2,8),MSG(3,8),SP,SP,SP,SP,SP)
            CALL PRINT38 (2,3)
         ENDIF
  
*        CHECK FOR PRE-DFT ERROR MESSAGE
      ELSE
         IF  (IFLD(45) .EQ. O"105") J = 2 
         IF  (IFLD(12) .EQ. O"10")  J = 1 
         IF (J .NE. 0) THEN 
            CALL LOAPR (1,MSG(1,J),MSG(2,J),MSG(3,J),MSG(4,J),SP,SP,
     .                    SP,SP)
            CALL PRINT38 (2,4)
         ENDIF
  
*        REPORT THE UNIDENTIFIED ERROR CODE 
         IF (J .EQ. 0) THEN 
            IDFTCD = IFLD(45) 
            SEQNO = IFLD(19)
            CALL LOAPR (1,IDFTCD,MSG(1,7),MSG(2,7),MSG(3,7),MSG(4,7), 
     .                    SEQNO,SP,SP)
            CALL PRINT38 (1,6)
         ENDIF
      ENDIF 
  
*     PRINT ALL REGISTERS 
   50 CALL PLSEC (5)
                                                                         HPA38
      IFLD28 = SHIFT(IFLD(28),4).OR.IFLD(39)
      IF(NFLD(FJOB) .NE. R" CONTINU") GO TO 60
      NFLD24 = SHIFT(NFLD(24),4).OR.NFLD(37)
      NFLD28 = SHIFT(NFLD(28),4).OR.NFLD(39)
      NFLD32 = SHIFT(NFLD(32),4).OR.NFLD(41)
      NFLD36 = SHIFT(NFLD(36),4).OR.NFLD(43)
      GO TO 75
  
   60 CONTINUE
      CALL LOAPR(1,IFLD(40),IFLD(25),IFLD(26),IFLD(27),IFLD28,SP,SP,SP) 
      CALL PRINT38(7,5) 
      GO TO 500 
   75 CONTINUE
      CALL LOAPR(1,IFLD(40),IFLD(25),IFLD(26),IFLD(27),IFLD28,
     .           NFLD(38),NFLD(21),NFLD(22))
      PL(9) = NFLD(23)
      PL(10) = NFLD24 
      CALL PRINT38(4,10)
      IF (NFLD(40).EQ.0) GO TO 500
      IF (NFLD(42).NE.0) GO TO 100
      CALL LOAPR(1,NFLD(40),NFLD(25),NFLD(26),NFLD(27),NFLD28,SP,SP,SP) 
      CALL PRINT38(7,5) 
      GO TO 500 
  100 CONTINUE
      CALL LOAPR(1,NFLD(40),NFLD(25),NFLD(26),NFLD(27),NFLD28,
     .           NFLD(42),NFLD(29),NFLD(30))
      PL(9) = NFLD(31)
      PL(10) = NFLD32 
      CALL PRINT38(4,10)
      IF ((NFLD(44) .EQ. 0) .OR. (NFLD(44) .EQ. Z"21")) GO TO 500 
      CALL LOAPR(1,NFLD(44),NFLD(33),NFLD(34),NFLD(35),NFLD36,SP,SP,SP) 
      CALL PRINT38(7,5) 
  500 RETURN                                                             HPA38
      END                                                                HPA38
      SUBROUTINE DL8SEC1
* 
**
*         DESCRIPTION 
*         ----------- 
* 
*         THIS ROUTINE PRINTS THE DETAIL REPORT FOR A170 SECDED COUNTS
* 
* 
*         CALLED BY - HPA38 
*         ------ -- 
* 
*         DATA AREAS
*         ---- -----
*         PL ARRAY - WHERE DATA IS STORED FOR PRINTING
* 
*         PL(1)  = DATE 
*         PL(2)  = TIME 
*         PL(3) = MFID
*         PL(4) = HOURLY COUNT
*         PL(5)  = ADDRESS
*         PL(6)  = FILLER 
*         PL(7)  = BANK 
*         PL(8)  = PAK
*         PL(9)  = CHIP ROW 
*         PL(10) = BIT
*         PL(11) = SYNDROM CODE 
*         PL(12) = PAK LOCATION 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*CALL,HPACOM1 
*CALL,HPACOM2 
      COMMON /SECDED2/ STORSEC(50,6)
* 
      DIMENSION  ITBL(5), ICNT(5), NEWSYN(5)
      DATA((STORSEC(I,J),I=1,50),J=1,6) /300*0/ 
  
      FLAG314 = 0 
  
      DO 100 I=1,4
      PTIFLD = 21 + ((I-1)*4) 
      ITBL(I) = AND(SHIFT(IFLD(PTIFLD),20),O"777774000000") 
      ITBL(I) = OR(AND(SHIFT(IFLD(PTIFLD+1),4),O"3777760"),ITBL(I)) 
      ITBL(I) = OR(AND(SHIFT(IFLD(PTIFLD+2),-12),O"17"),ITBL(I))
      NEWSYN(I) = AND(IFLD(PTIFLD+2),O"377")
  100 ICNT(I) = AND(IFLD(PTIFLD+3),O"77") 
      ITBL(5) = AND(SHIFT(IFLD(37),32),O"740000000000") 
      ITBL(5) = OR(AND(SHIFT(IFLD(38),24),O"37700000000"),ITBL(5))
      ITBL(5) = OR(AND(SHIFT(IFLD(39),20),O"74000000"),ITBL(5)) 
      ITBL(5) = OR(AND(SHIFT(IFLD(40),12),O"3770000"),ITBL(5))
      ITBL(5) = OR(AND(SHIFT(IFLD(41),8),O"7400"),ITBL(5))
      ITBL(5) = OR(IFLD(42),ITBL(5))
      NEWSYN(5) = AND(IFLD(44),O"377")
      ICNT(5) = AND(IFLD(45),O"77") 
  
      PL(64) = 0
      IHDR = 42 
      TYPID = 10H    SECDED 
      IF(TWIC .EQ. 6) GO TO 5 
      IF (RCFD.EQ.3HOFF) GO TO 5
      CALL HEADER 
      CALL PHEAD38 (1)
5     CONTINUE
  
      DO 900 IN=1,5 
      IF((ITBL(IN) .EQ. 0) .AND. (ICNT(IN) .EQ. 0)) GO TO 990 
      PL(1) = SEBUF(23) 
      IF (SDATE.EQ.SEBUF(23)) PL(1) = 10H 
*     SAVE THE DATE TO SEE IF THE NEXT DATE SHOULD BE BLANKED OUT 
      SDATE = SEBUF(23) 
* 
*     SAVE THE TIME FOR HOURLY TOTAL
      PL(2) = IFLD(20)
      IF (STIME.EQ.IFLD(20))  HRCNT = HRCNT + 1 
      IF (STIME.NE.IFLD(20))  HRCNT = 1 
      STIME = IFLD(20)
      PL(3) = MFID
      PL(4) = ICNT(IN)
      IF (RCFA .EQ. 2HON) CALL STOJN3 
  
      TESTNEW = IFLD(14).AND.1
      S1 = SHIFT(IFLD(13),-4).AND.3 
*   S1
      IF (S1.EQ.2) GO TO 150
*   S1CR
      IF ((S1.EQ.1).OR.(S1.EQ.3)) GO TO 160 
*   M3CR
      IF ((IFLD(13) .AND. O"17") .EQ. O"17") GO TO 210
*   M2/M3 
      IF (TESTNEW.NE.1) GO TO 120 
      PL(5) = AND(ITBL(IN),O"777 7777") 
      PL(7) = AND(ITBL(IN),7) 
      IPAK = AND(SHIFT(ITBL(IN),-19),3) 
      ENCODE (10,950,PL(8)) IPAK
      PL(11) = NEWSYN(IN) 
      GO TO 250 
  
  120 CONTINUE
      PL(5) = AND(SHIFT(ITBL(IN),-15),O"7777777") 
      PL(7) = AND(SHIFT(ITBL(IN),-15),O"7") 
      IPAK = AND(SHIFT(ITBL(IN),-34),3) 
      ENCODE (10,950,PL(8)) IPAK
      PL(11) = AND(SHIFT(ITBL(IN),-7),O"377") 
      GO TO 250 
  
  150 CONTINUE
      ID = 2HM1 
      IF (TESTNEW .NE. 1) THEN
         FLAG314 = 1
         PL(5) = PL(6) = PL(7) = PL(8) = PL(9) = PL(10) = 3H*** 
         GO TO 500
      ENDIF 
      MSIZE = IFLD(13).AND.O"17"
  
*         ADDRESS FOR M1
  
      PL(5) = AND(ITBL(IN),O"777 7777") 
*        16MB OR 32MB MACHINES
      IF (MSIZE.EQ.3) PL(5) = AND(ITBL(IN),O"7777 7777")
  
*         BANK FOR M1 
  
      PL(7) = AND(ITBL(IN),3) 
      IF(MSIZE.EQ.1) PL(7) = AND(PL(7),1) 
  
*         PAK FOR M1
      IPAK = 4
      IF((MSIZE.EQ.6).OR.(MSIZE.EQ.8))
     .    IPAK = AND(SHIFT(ITBL(IN),-19),1) 
      IF (MSIZE.EQ.3) IPAK = AND(SHIFT(ITBL(IN),-21),1) 
      IF(IPAK.NE.4) ENCODE(10,950,PL(8)) IPAK 
      IF(IPAK.EQ.4) PL(8) = 1H
      PL(11) = NEWSYN(IN) 
      GO TO 250 
  
  160 CONTINUE
      ID = 4HM1CR 
      IF (TESTNEW .NE. 1) THEN
         FLAG314 = 1
         PL(5) = PL(6) = PL(7) = PL(8) = PL(9) = PL(10) = 3H*** 
         GO TO 500
      ENDIF 
      MBITS = IFLD(13).AND.O"17"
  
*       ADDRESS FOR M1CR
  
      PL(5) = AND(ITBL(IN),O"7777 7777")
  
*       BANK FOR M1CR 
  
      PL(7) = AND(ITBL(IN),3) 
      IF (MBITS.EQ.2) PL(7) = AND(PL(7),1)
  
*       PAK FOR M1CR
  
      IPAK = 4
*    64K
      IF ((S1.EQ.1).AND.(MBITS.NE.2)) 
     .    IPAK = AND(SHIFT(ITBL(IN),-19),3) 
*    256K 
      IF ((S1.EQ.3).AND.(MBITS.NE.2)) 
     .    IPAK = AND(SHIFT(ITBL(IN),-21),3) 
      ENCODE (10,950,PL(8)) IPAK
      IF (IPAK.EQ.4) PL(8) = 1H 
      PL(11) = NEWSYN(IN) 
      GO TO 250 
  
  210 CONTINUE
      ID = 4HM3CR 
      IF (TESTNEW.NE.1) GO TO 220 
      PL(5) = ITBL(IN).AND.O"3 7777 7777" 
      PL(7) = ITBL(IN).AND.O"7" 
      IPAK = SHIFT(ITBL(IN),-22).AND.3
      ENCODE (10,950,PL(8)) IPAK
      PL(11) = NEWSYN(IN) 
      GO TO 250 
  
  220 FLAG314 = 1 
      PL(5) = PL(6) = PL(7) = IPAK = 3H***
      PL(11) = AND(SHIFT(ITBL(IN),-7),O"377") 
      GO TO 250 
* 
*     BRBIT38 SETS UP PL(10), AND PL(12)
  250 CONTINUE
      CALL BRBIT38 (PL(7),IPAK,ID)
* 
*     STORE DATA FOR ANALYSIS REPORT
* 
      IF (FLAG314.EQ.1) GO TO 500 
      DO 300 I=1,50 
      IF (STORSEC(I,1).EQ.0) GO TO 400
      IF (STORSEC(I,2).EQ.PL(5)) GO TO 400
  300 CONTINUE
      GO TO 500 
  400 CONTINUE
      STORSEC(I,1) = STORSEC(I,1) + ICNT(IN)
      STORSEC(I,2) = PL(5)
      STORSEC(I,3) = PL(7)
      STORSEC(I,4) = PL(10) 
      STORSEC(I,5) = PL(8)
      STORSEC(I,6) = PL(12) 
* 
*     PRINT THE SECDED DETAIL LINE
* 
  500 CONTINUE
      IF (RCFD.EQ.3HOFF) GO TO 900
      ENCODE (10,960,PL(4)) ICNT(IN)
      IF (ICNT(IN).EQ.O"77") ENCODE (10,961,PL(4)) ICNT(IN) 
      IF (FLAG314.EQ.1) CALL PRINT38(14,10) 
      IF (FLAG314.EQ.0) CALL PRINT38(8,12)
  
      IF ((RCFD .EQ. 2HON) .AND. (ICNT(IN) .EQ. O"77")) THEN
         PRINT 962
         LINE = LINE + 2
      ENDIF 
  900 CONTINUE
  
      IF (RCFD .EQ. 2HON)  THEN 
         IF (HRCNT .EQ. 10) THEN
            PRINT 963 
            LINE = LINE + 2 
         ENDIF
         IF (FLAG314 .NE. 0) THEN 
            PRINT 964 
            LINE = LINE + 1 
         ENDIF
      ENDIF 
  
  950 FORMAT(O1,9X) 
  960 FORMAT (1H ,I2,7X)
  961 FORMAT (1H*,I2,7X)
  962 FORMAT (25X,'*ERROR COUNT OVERFLOW, NOT ALL',/,26X, 
     .       'COUNTS ARE REPORTED') 
  963 FORMAT (25X,'*ONLY TEN UNIQUE ADDRESS ERRORS ARE',/,26X,
     .        'REPORTED, MORE ERRORS MAY HAVE OCCURRED')
  964 FORMAT (1X,'*** = INFORMATION NOT AVAILABLE') 
  
990   RETURN
      END 
      SUBROUTINE DL8SEC2
* 
**
*         DESCRIPTION 
*         ----------- 
* 
*         THIS ROUTINE PRINTS THE DETAIL REPORT FOR DFT SECDED COUNTS.
* 
*         *** NOTE *** UNPACKED AS RTY 106B: 12 - 32 - 16 BITS. 
*         CALLED BY - HPA38 
*         ------ -- 
* 
*         DATA AREAS
*         ---- -----
*         PL ARRAY - WHERE DATA IS STORED FOR PRINTING
* 
*         PL(1)  = DATE 
*         PL(2)  = TIME 
*         PL(3) = MFID
*         PL(4) = HOURLY COUNT
*         PL(5)  = ADDRESS
*         PL(6)  = FILLER 
*         PL(7)  = BANK 
*         PL(8)  = PAK/MODULE 
*         PL(10) = BIT
*         PL(11) = SYNDROM CODE 
*         PL(12) = PAK LOCATION 
* 
*CALL HPACOM1 
*CALL HPACOM2 
  
      COMMON /SECDED2/ STORSEC(50,6)
* 
      DIMENSION  ITBL(5), ICNT(5), SYN(5) 
  
      DATA((STORSEC(I,J),I=1,50),J=1,6) / 300 *0 /
  
*     DFT REVISION NUMBER 
      VERSION = IFLD(FUN) 
  
      II = 0
      DO 100 I = 21, 30, 3
      II = II + 1 
      ICNT(II) = IFLD(I)
      ITBL(II) = IFLD(I + 1)
  100 SYN(II)  = IFLD(I + 2)
  
      PL(64) = IFLD(33) 
      IHDR = 42 
      HCF(2) = 8
      IF (TWIC .EQ. 6) GO TO 5
      IF (RCFD .EQ. 3HOFF) GO TO 5
      CALL HEADER 
      CALL PHEAD38 (1)
  
    5 DO 900 IN = 1, 5
      IF ((ITBL(IN) .EQ. 0) .AND. (ICNT(IN) .EQ. 0)) GO TO 900
      PL(1) = SEBUF(23) 
      IF (SDATE .EQ. SEBUF(23)) PL(1) = 10H 
*     SAVE THE DATE TO SEE IF THE NEXT DATE SHOULD BE BLANKED OUT 
      SDATE = SEBUF(23) 
*     SAVE THE TIME FOR HOURLY TOTAL
      PL(2) = IFLD(20)
      IF (STIME .EQ. IFLD(20))  HRCNT = HRCNT + 1 
      IF (STIME .NE. IFLD(20))  HRCNT = 1 
      STIME = IFLD(20)
      PL(3) = MFID
      PL(4) = ICNT(IN)
  
*     SEQUENCE NUMBER 
      PL(13) = IFLD(19) 
      IF (RCFA .EQ. 2HON) CALL STOJN3 
  
      MODEL = IFLD(33)
      OIREG = SHIFT(IFLD(34),-12) .AND. O"7777" 
      OIFLAG = SHIFT(IFLD(34),-11) .AND. 1
*   S1
      IF ((MODEL .EQ. Z"11") .OR. (MODEL .EQ. Z"12")) GO TO 150 
*   S1CR
      IF ((MODEL .GE. Z"13") .AND. (MODEL .LE. Z"16")) GO TO 160
*   M3CR
      IF  (MODEL .EQ. Z"31") GO TO 210
      IF ((MODEL .EQ. Z"34") .OR. (MODEL .EQ. Z"35")) GO TO 220 
*   M2/M3 
      PL(5) = AND(ITBL(IN),O"777 7777") 
      PL(7) = AND(ITBL(IN),7) 
      IPAK = AND(SHIFT(ITBL(IN),-19),3) 
      ENCODE (10,950,PL(8)) IPAK
      PL(11) = SYN(IN)
      GO TO 250 
  
  150 ID = 2HM1 
  
*     ADDRESS FOR M1
      PL(5) = AND(ITBL(IN),O"777 7777") 
*        16MB OR 32MB 
      IF (OIFLAG .NE. 0) PL(5) = AND(ITBL(IN),O"7777 7777") 
  
*     BANK FOR M1 
      PL(7) = AND(ITBL(IN),3) 
*        1MB
      IF ((OIREG .AND. O"4000") .NE. 0) PL(7) = AND(PL(7),1)
  
*     PAK FOR M1
      IPAK = 4
*        6MB OR 8MB 
      IF ((OIREG .AND. O"120") .NE. 0)
     .     IPAK = AND(SHIFT(ITBL(IN),-19),1)
*        16MB OR 32MB 
      IF (OIFLAG .NE. 0) IPAK = AND(SHIFT(ITBL(IN),-21),1)
      IF (IPAK .NE. 4) ENCODE(10,950,PL(8)) IPAK
      IF (IPAK .EQ. 4) PL(8) = 1H 
      PL(11) = SYN(IN)
      GO TO 250 
  
  160 ID = 4HM1CR 
  
*     ADDRESS FOR M1CR
      PL(5) = AND(ITBL(IN),O"7777 7777")
  
*     BANK FOR M1CR 
      PL(7) = AND(ITBL(IN),3) 
*        2MB
      IF ((OIREG .AND. O"2000") .NE. 0) PL(7) = AND(PL(7),1)
  
*     PAK FOR M1CR
      IPAK = 4
*        64K
      IF ((OIFLAG .EQ. 0) .AND. ((OIREG .AND. O"2000") .EQ. 0)) 
     .     IPAK = AND(SHIFT(ITBL(IN),-19),3)
*        256K 
      IF ((OIFLAG .NE. 0) .AND. ((OIREG .AND. O"2000") .EQ. 0)) 
     .     IPAK = AND(SHIFT(ITBL(IN),-21),3)
      ENCODE (10,950,PL(8)) IPAK
      IF (IPAK .EQ. 4) PL(8) = 1H 
      PL(11) = SYN(IN)
      GO TO 250 
  
  210 ID = 4HM3CR 
      PL(5) = ITBL(IN).AND.O"3 7777 7777" 
      PL(7) = ITBL(IN).AND.O"7" 
      IPAK = SHIFT(ITBL(IN),-22) .AND. 3
      ENCODE (10,950,PL(8)) IPAK
      PL(11) = SYN(IN)
  
  220 ID = 4HPIM3 
      PL(5) = AND(ITBL(IN),Z"FFF FFFF") 
      PL(7) = AND(ITBL(IN),7) 
      IF (MODEL .EQ. Z"34") MODULE = AND(SHIFT(ITBL(IN),-23),3) 
      IF (MODEL .EQ. Z"35") MODULE = AND(SHIFT(ITBL(IN),-25),3) 
      INC = MODULE + 1
      ENCODE (10,950,PL(8)) INC 
      IPAK = MODULE 
      PL(11) = SYN(IN)
* 
*     BRBIT38 SETS UP PL(10), AND PL(12)
* 
  250 CALL BRBIT38 (PL(7),IPAK,ID)
* 
*     STORE DATA FOR ANALYSIS REPORT
* 
      DO 300 I=1,50 
      IF (STORSEC(I,1) .EQ. 0) GO TO 400
      IF (STORSEC(I,2) .EQ. PL(5)) GO TO 400
  300 CONTINUE
      GO TO 500 
  400 STORSEC(I,1) = STORSEC(I,1) + ICNT(IN)
      STORSEC(I,2) = PL(5)
      STORSEC(I,3) = PL(7)
      STORSEC(I,4) = PL(10) 
      STORSEC(I,5) = PL(8)
      STORSEC(I,6) = PL(12) 
* 
*     PRINT THE SECDED DETAIL LINE
* 
  500 IF (RCFD .EQ. 3HOFF) GO TO 900
      ENCODE (10,960,PL(4)) ICNT(IN)
      IF (VERSION .GE. 3) ENCODE (10,510,PL(14)) VERSION
  510 FORMAT (8X,I2)
      CALL PRINT38 (8, 14)
  
  900 CONTINUE
  
*     REPORT WHEN DFT SUPPORTIVE STATUS BUFFER DATE/TIME IS INVALID 
      IF ((VERSION .GE. 4) .AND. ((IFLD(19) .AND. O"4000") .NE. 0)) THEN
         PRINT 910
  910    FORMAT (11X,'DFT-REPORTED WALL CLOCK TIME INTEGRITY HAS BEEN ',
     .              'LOST') 
         LINE = LINE + 1
      ENDIF 
  
      IF ((RCFD .EQ. 2HON) .AND. (HRCNT .EQ. 10)) THEN
         PRINT 963
         LINE = LINE + 2
      ENDIF 
  
  950 FORMAT(O1,9X) 
  960 FORMAT (1H ,I2,7X)
  961 FORMAT (1H*,I2,7X)
  963 FORMAT (25X,'*ONLY TEN UNIQUE ADDRESS ERRORS ARE REPORTED',/, 
     .        25X,'MORE ERRORS MAY HAVE OCCURRED')
  
      RETURN
  
      END 
      SUBROUTINE PHEAD38 (ST) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE PHEAD38 PRINTS HEADINGS FOR REPORTS DEVELOPED
*         BY HPA38 ROUTINES.
* 
*         ENTRY CONDITIONS
*         ----- ----------
*         HCF(5) - ARRAY PRESET WITH POINTER 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 HCF(5) ARE SCANNED 
*                  SEQUENTIALLY AND SEVERAL SUBHEADERS MAY BE PRINTED.
*         ST     - CONTAINS POINTER TO WHERE ROUTINE WILL START 
*                  SCAN OF (HCF) FLAG.
* 
*         EXIT CONDITIONS 
*         ---- ---------- 
*         SUBHEADER HAS BEEN PRINTED
*         AN (HCF) FLAG CONTAING (0) HAS BEEN ENCOUNTERED 
* 
*         CALLED BY 
*         ------ -- 
*         PRINT38  -AUTOMATICALLY WHEN A NEW PAGE IS INITIATED. 
* 
*CALL HPACOM1 
*CALL HPACOM2 
  
      P = ST
      LINE = LINE + 1 
  
    6 IF (P .GT. 5) GO TO 1000
      PTR = HCF(P)
      IF ((PTR .LE. 0) .OR. (PTR .GT. 10)) GO TO 1000 
      P = P +1
* 
*         JUMP TO PRINT FORMAT AS CALLED BY POINTER (PTR) 
* 
      GO TO (10, 20, 30, 40, 50, 60, 70, 80, 90, 100) PTR 
* 
* 
   10 IF ((MTY .EQ. O"314") .AND. (IFLD(36) .EQ. O"3410")) GO TO 14 
      PRINT 11,HX(1),HX(2),HX(3),MFID 
   11 FORMAT (1X,'DT - ** MR **   ELEMENT = ',Z2,'   MODEL = ',Z2,
     .           '   SERIAL = ',Z4,'  MFID = ',R1)
      GO TO 6 
  
   14 PRINT 15,IFLD(33) 
   15 FORMAT (/,1X,'DT = ** MR **  (708) TOP OF HOUR SECDED ID TABLE ', 
     .'  MODEL = ',Z2)
      GO TO 6 
* 
*         180-8XX MEMORY ERRORS BY BANK AND QUAD
   20 IF ((HX(2) .NE. Z"34") .AND. (HX(2) .NE. Z"35")) PRINT 21,HDATA(1)
      IF ((HX(2) .EQ. Z"34") .OR. (HX(2) .EQ. Z"35")) PRINT 23,HDATA(1) 
      PRINT 22
   21 FORMAT (//,5X,23HFAILURES BY BANK   PAK ,A1,/,5X, 
     .        24H-------- -- ----   --- -)
   23 FORMAT (//,5X,'FAILURES BY BANK   INCREMENT ',A1,/, 
     .           5X,'-------- -- ----   --------- -') 
   22 FORMAT (5X,13HBANK NUMBER =,5X,2H00,5X,2H01,5X,2H02,5X,2H03,
     .        5X,2H04,5X,2H05,5X,2H06,5X,2HO7,/,18X,8(5X,2H--)) 
      LINE = LINE + 6 
      GO TO 1000
* 
*         180-8XX SUMMARY OF ERRORS BY TYPE HEADER
   30 IF ((PL(64) .NE. Z"34") .AND. (PL(64) .NE. Z"35")) PRINT 31 
      IF ((PL(64) .EQ. Z"34") .OR. (PL(64) .EQ. Z"35")) PRINT 32
   31 FORMAT (//,5X,'SUMMARY OF UNCORRECTED MEMORY ERRORS BY ADDRESS',
     .        //,5X,'COUNT   ADDRESS   BANK   PAK',/,5X,8(4H----))
   32 FORMAT (//,5X,'SUMMARY OF UNCORRECTED MEMORY ERRORS BY ADDRESS',
     .        //,5X,'COUNT   ADDRESS   BANK   INCREMENT',/,5X,9(4H----))
      LINE = LINE + 7 
      GO TO 1000
* 
*         180-8XX MEMORY ERRORS DETAIL REPORT HEADER
   40 PRINT 41,HX(5),HX(6),HX(7),HX(8),HX(9),HX(10),HX(11),HX(12),
     .         HX(13),HX(14),HX(15),HX(16)
   41 FORMAT (/,17X,'OPTIONS INSTALLED   = ',4(Z4,1X),'(12)',/, 
     .          17X,'ENVIRONMENT CONTROL = ',4(Z4,1X),'(20)',/, 
     .          17X,'O. S. BOUNDS        = ',4(Z4,1X),'(21)') 
      IF ((HX(2) .NE. Z"34") .AND. (HX(2) .NE. Z"35")) PRINT 42 
      IF ((HX(2) .EQ. Z"34") .OR. (HX(2) .EQ. Z"35")) PRINT 43
   42 FORMAT (/,58X,'SYN    PAK',/, 
     .3X,'DATE      TIME    PORT   PAK    BANK   ADDRESS   BIT   CODE', 
     .'   LOC',/, 
     .1X,7(10H----------),9H---------)
   43 FORMAT (/,58X,'SYN',/,
     .3X,'DATE      TIME    PORT   INC    BANK   ADDRESS   BIT   CODE', 
     ./,
     .1X,7(10H----------),9H---------)
      LINE = LINE + 8 
      GO TO 1000
* 
* 
   50 GO TO 1000
   60 GO TO 1000
* 
*         180-8XX MEMORY ERRORS BY BANK 
   70 PRINT 71
   71 FORMAT (//,5X,13HMEMORY ERRORS) 
      LINE = LINE + 3 
      GO TO 1000
* 
*          180-8XX SECDED II UNIQUE ID AND COUNTS 
   80 IF ((IFLD(33) .NE. Z"34") .AND. (IFLD(33) .NE. Z"35")) PRINT 81 
      IF ((IFLD(33) .EQ. Z"34") .OR. (IFLD(33) .EQ. Z"35")) PRINT 82
   81 FORMAT (/,20X,'MF   HOUR',21X,'SYN  PAK  SEQ  DFT',/, 
     .3X,'DATE      TIME   ID  COUNT    ADDR BNK PAK BIT CDE  LOC  NUM',
     .'  REV',/,1X,7('----------'),'--------')
   82 FORMAT (/,20X,'MF   HOUR',21X,'SYNDROME  SEQ  DFT',/, 
     .3X,'DATE      TIME   ID  COUNT    ADDR BNK INC BIT CODE      NUM',
     .'  REV',/,1X,7('----------'),'--------')
      LINE = LINE + 4 
      GO TO 1000
* 
*         180-8XX SECDED COUNTS ACCUMULATION
   90 IF ((PL(64) .NE. Z"34") .AND. (PL(64) .NE. Z"35")) PRINT 91 
      IF ((PL(64) .EQ. Z"34") .OR. (PL(64) .EQ. Z"35")) PRINT 92
   91 FORMAT (///,5X,'SUMMARY OF POTENTIAL HARD SECDED ERRORS BY ', 
     .        'ADDRESS',//,46X,'PAK',/,5X,'COUNT   ADDRESS',7X, 
     .        'BANK   BIT   PAK   LOC',/,5X,11(4H----)) 
   92 FORMAT (///,5X,'SUMMARY OF POTENTIAL HARD SECDED ERRORS BY ', 
     .        'ADDRESS',//,5X,'COUNT   ADDRESS',7X, 
     .        'BANK   BIT   INCREMENT',/,5X,11(4H----)) 
      LINE = LINE + 7 
      GO TO 1000
* 
* 
  100 IF ((PL(64) .NE. Z"34") .AND. (PL(64) .NE. Z"35")) PRINT 101
      IF ((PL(64) .EQ. Z"34") .OR. (PL(64) .EQ. Z"35")) PRINT 102 
  101 FORMAT (///,5X,'SUMMARY OF POTENTIAL TRANSIENT SECDED ERRORS ', 
     .        'BY ADDRESS',//,34X,'PAK',/,5X,'ADDRESS   BANK   BIT',
     .        '   PAK   LOC',/,5X,10(4H----)) 
  102 FORMAT (///,5X,'SUMMARY OF POTENTIAL TRANSIENT SECDED ERRORS ', 
     .        'BY ADDRESS',//,5X,'ADDRESS   BANK   BIT',
     .        '   INCREMENT',/,5X,10(4H----)) 
      LINE = LINE + 7 
      GO TO 1000
  
 1000 CONTINUE
      RETURN
      END 
                                                                         HPA38
      SUBROUTINE PRINT38 (LT,NW)                                         HPA38
*                                                                        HPA38
**        DESCRIPTION                                                    HPA38
*         -----------                                                    HPA38
*         SUBROUTINE PRINT38 PRINTS A LINE OF DATA IN VARIOS REPORTS     HPA38
*         BY TRACKING LINE COUNTS AND STARTS NEW PAGE IF NEEDED.         HPA38
*                                                                        HPA38
*         ENTRY CONDITIONS                                               HPA38
*         ----- ----------                                               HPA38
*         LT   - DEFINES THE FORMAT STATEMENT TO BE USED.                HPA38
*         NW   - DEFINES THE NUMBER OF WORDS TO BE PRINTED.              HPA38
*                                                                        HPA38
*         DATA AREAS SHARED-                                             HPA38
*         LINE, RCF, PL(32)                                              HPA38
*                                                                        HPA38
*         EXIT CONDITIONS                                                HPA38
*         ---- ----------                                                HPA38
*         DATA AREAS SHARED-                                             HPA38
*         LINE                                                           HPA38
*                                                                        HPA38
*         DATA AREAS                                                     HPA38
*         ---- -----                                                     HPA38
*         LEND   -(1)/LOCAL TO SUBROUTINE/NUMBER OF LINES TO BE          HPA38
*                 PRINTED IN A PAGE.                                     HPA38
*         LINE   -(1)/COMMON BLOCK/NUMBER OF LINES PRINTED SO FAR        HPA38
*                 IN A PAGE.                                             HPA38
*         IFORM  -(12,60)/COMMON BLOCK/AREA TO HOLD THE EXECUTION        HPA38
*                 TIME FORMAT STATEMENTS FOR VARIOUS REPORTS.            HPA38
*                 COLUMN NUMBER SELECTS A SET OF FORMAT STATEMENTS       HPA38
*                 AND THE MAXIMUM LENGTH OF ONE STATEMENT IS 12          HPA38
*                 WORDS LONG.                                            HPA38
*         PL     -(40)/COMMON BLOCK AREA TO HOLD A LIST OF PRINT         HPA38
*                 DATA LOADED BY THE CALLING ROUTINE.                    HPA38
*                                                                        HPA38
*         CALLS                                                          HPA38
*         -----                                                          HPA38
*         HEADER -INITIALIZE EACH PAGE OF VARIOUS REPORTS.               HPA38
*         PRHEAD -PRINT SUB-HEADER IN VARIOUS REPORTS.                   HPA38
*                                                                        HPA38
*CALL,HPACOM1                                                            HPA38
*CALL,HPACOM2                                                            HPA38
*         * * * * * * * * * * * * * * * * * * * * * * * * * *            HPA38
*                                                                        HPA38
      DIMENSION IFORM (9,18),  FMT (9)
* 
*         FORMAT FOR MEMORY DETAIL REPORT ERROR MESSAGE 
      DATA (IFORM(I,1),I=1,5,1) / 
     .10H(11X,'(',Z,10H3,') ',4A1,10H0,3X,'SEQU,10HENCE NUMBE,
     .10HR = ',Z2) /
*                                                                        HPA38
*         FORMAT FOR MEMORY DETAIL REPORT ERROR MESSAGE 
      DATA (IFORM(I,2),I=1,2,1) / 
     .10H(11X,4(A10,10H))         / 
* 
*         FORMAT FOR M1/M2/M3/M3CR/PIM3 MEMORY ERRORS - DETAIL REPORT 
      DATA(IFORM(I,3),I=1,7,1)/ 
     .10H(1X,A8,2X,,10HA8,2X,A4,4,10HX,A3,4X,O1,10H,5X,Z7,A1,,
     .10HA1,A1,A2,5,10HX,A2,4X,A3,10H)         /
*                                                                        HPA38
*         FORMAT FOR A170 MEMORY ERRORS - 2ND LINE DETAIL EXTENDED       HPA38
      DATA (IFORM(I,4), I=1,6,1) /
     .10H(11X,4HREG,10H ,Z2,1H=,4,10H(1X,Z4),3X,10H,4HREG ,Z2,10H,1H=,4(
     .1X,,10HZ4))      /
*                                                                        HPA38
*         FORMAT FOR A170 MEMORY ERRORS - ANALYSIS BY BANK               HPA38
      DATA (IFORM(I,5), I=1,4,1) /
     .10H(5X,13HERR,10HOR COUNT =,10H,8(1X,I6.0,10H))        /
                                                                         HPA38
*     FORMAT FOR SUMMARY OF POTENTIAL HARD SECDED ERRORS BY ADDRESS 
                                                                         HPA38
      DATA (IFORM(I,6),I=1,5,1) / 
     .10H(5X,I5,3X,,10HZ7,3X,A3,3,10HX,O2,3X,A2,10H,5X,A1,4X,,10HA3)
     .   /
                                                                         HPA403J
*          FORMAT FOR ONE REGISTER PRINT - M2 MEMORY EXTENDED DETAIL     HPA403J
                                                                         HPA403J
      DATA (IFORM(I,7),I=1,3,1) / 
     .10H(11X,4HREG,10H ,Z2,1H=,4,10H(1X,Z4))  /
* 
*         FORMAT FOR A170 SECDED ERROR COUNTS 
* 
      DATA (IFORM(I,8),I=1,8,1) / 
     .10H(1X,A8,2X,,10HA8,2X,R1,3,10HX,A3,2X,Z7,10H,A2,O1,3X,,
     .10HA1,A1,2X,A,10H2,2X,A2,2X,10H,A3,2X,Z2,,10H4X,R2)    /
*                                                                        HPA38
*     FORMAT FOR SUMMARY OF UNCORRECTED MEMORY ERRORS BY ADDRESS
* 
      DATA (IFORM(I,10),I=1,3,1)/ 
     .10H(5X,I5,3X,,10HZ7,5X,O2,5,10HX,A1)     /
* 
*     FORMAT FOR SUMMARY OF POTENTIAL TRANSIENT SECDED ERRORS BY ADDRESS
* 
      DATA (IFORM(I,11),I=1,4,1)/ 
     .10H(5X,Z7,4X,,10HO2,5X,A2,4,10HX,A1,4X,A3,10H)         /
* 
*     FORMAT FOR MEMORY INVALID STATUS
* 
      DATA(IFORM(I,13),I=1,3,1)/
     .10H(1X,A8,2X,,10HA8,5X,4(A1,10H0))       /
* 
*      FORMAT FOR S1/S1CR/S3CR INCORRECT SECDED MESSAGES
* 
      DATA (IFORM(I,14),I=1,4,1)/ 
     .10H(1X,A8,2X,,10HA8,2X,R1,3,10HX,A3,6X,A3,10H,5(1X,A3))/
*                                                                        HPA38
*         * * * * * * * * * * * * * * * * * * * * * * * * * *            HPA38
*                                                                        HPA38
*                                                                        HPA38
      IF ((LT .EQ. 1) .OR. (LT .EQ. 2) .OR. (LT .EQ. 4)) GO TO 20 
  
      IF (LINE .LT. PLF) GO TO 20                                        HPA38
  
*     PRINT NEW PAGE HEADER 
      CALL HEADER                                                        HPA38
      IF ((LT.EQ.3).OR.(LT.EQ.8))  PL(1) = SEBUF(23)
      CALL PHEAD38 (1)
   20 CONTINUE                                                           HPA38
      LINE = LINE+1                                                      HPA38
      DO 22 J = 1, 9
       FMT(J)=IFORM(J,LT) 
 22   CONTINUE
      PRINT FMT, (PL(J),J=1,NW) 
*                                                                        HPA38
      DO 60 K = 1,NW
   60 PL(K) = 1H                                                         HPA38
*                                                                        HPA38
      RETURN                                                             HPA38
      END                                                                HPA38
          IDENT  INTEM38
          LCC OVCAP.
          ENTRY  INTEM38
OVLNO     SET    8
          USE    /LINK/ 
LINKET    BSS    1
LINKEM    BSS    1
          USE    *
  
INTEM38   BSS    1
          SX6    ET 
          SA6    LINKET 
          SX6    EC 
          SA6    LINKEM 
          JP     INTEM38
          EJECT 
*CALL COMHPAERT 
          END 
