*DECK,HPA 
*IF DEF,XRUN,1
      OVERLAY ( HP, 0, 0, OV=66 ) 
*IF -DEF,XRUN 
      OVERLAY ( HPA, 0, 0, OV=66 )
*ENDIF
      PROGRAM HPA 
*IF -DEF,HPSORT,1 
     .(INPUT=101, OUTPUT=101, TAPE5=INPUT, TAPE6=OUTPUT)
*IF DEF,HPSORT,1
     .(INPUT=101, OUTPUT=101, TAPE5=INPUT, TAPE6=OUTPUT, TAPE14=513)
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                 HARDWARE PERFORMANCE ANALYZER                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                                                                     * 
*                                                                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
***       HPA-HARDWARE PERFORMANCE ANALYZER 
*           VERSION 4.XX
*         --------------------------------- 
* 
* 
* 
*         HPA IS A CUSTOMER ENGINEERING PROGRAM USED TO ANALYZE THE 
*         SYSTEM ENGINEERING FILE RETRIEVED VIA PROGRAM 
*           NORM, OR NORMS .
* 
* 
*CALL,HPACOM1 
  
      CHARACTER*10 F1,F2,DATE,JDATE,TIME,MOVE 
      COMMON /OPEN/ F1, F2,  MOVE(3)
*        ************************************************************** 
*CALL CPYFTN                                                             HPA405S
  
C         ****    INITIAL ENTRY TO HPA PROGRAM IS  VIA  --- 
C         ****    SUBROUTINE ( PARMS )  WHICH CRACKS CONTROL
C         ****    CARD, THEN RETURNS TO MAIN PROGRAM ( HPA )
C         ****
*       ****************************************************
  
* 
*        ENTER HPA FROM PARMS 
  
*       GET CURRENT SYSTEM DATE , AND TIME
      MOVE(1)= DATE ()
      MOVE(2)=TIME () 
      MOVE(3)=JDATE ()
* 
*        CALL COMPASS SUB TO LOAD INTEGER VARIABLES WITH THE
*        VALUES IN CHARACTER VARIABLE MOVE TO BE PROCESSED LATER
* 
      CALL LOADI
*        IDATIM(4) = THIS YEAR BIASED BY 1970 
      DECODE (10,100,IDATIM(3)) IDATIM(4) 
  100 FORMAT(I2)
      IDATIM(4) = IDATIM(4) - 70
* 
  
*       ************************************************* 
*        HPA MOD LEVEL IS DEFINED IN ... SUBROUTINE HEADER ...
  
*          **************************************************** 
  
*           INITIALIZE AND PROCESS PARAMETERS 
  
      CALL XOVCAP ('HPA1',0,0)
      CALL UOVCAP ('HPA1')
      IF (FLAGS(2) .EQ. 5HERROR) CALL EXIT
  
*      *****************************************
      IF (FLAGS(1) .EQ. 7H NOSORT) GO TO 300
*           CALL OVERLAY TO SORT SEF FILE 
  
*        ( SORTKEY )
      FLAGS(9) = 1
* 
      CALL XOVCAP ('HPA2',0,0)
      CALL UOVCAP ('HPA2')
  300 IF (FLAGS(2) .EQ. 5HERROR) CALL EXIT
  
*      ************************************************ 
*         CALL CONTROL ROUTINE FOR REPORT GENERATING
  
*          TEST FOR ERROR-CODE REPORT FLAG                              000910
      IF (FROG(4) .EQ. 2HON) GO TO 350                                  000920
  
      IF (FILEP(SEF) .EQ. 3HOFF) GO TO 400                              000820
                                                                        000940
*         GENERATE ANALYSIS AND DETAIL REPORTS
  
  350 CALL XOVCAP ('HPA3',0,0)
      CALL UOVCAP ('HPA3')
  
  
*     *********************************************************** 
*         INITIALIZE SCRATCH FILES TAPE11 (SCR2) AND TAPE12 (SCR3)
  400 CALL RMOPEN2
  
*     *********************************************************** 
*     ****************************************************
*         OVERLAY TO PROCESS SHR UPDATE / TEST FOR NEWHF REPORT 
  
      IF (FROG(3) .EQ. 3HOFF) GO TO 500 
  
      CALL XOVCAP ('HPA4',0,0)
      CALL UOVCAP ('HPA4')
  
*     ******************************************************
*      OVERLAY TO PROCESS SUMMARY REPORT
* 
  500 IF (FROG(1) .EQ. 3HOFF) GO TO 600 
      CALL XOVCAP ('HPA5',0,0)
      CALL UOVCAP ('HPA5')
* 
*       ******************************************* 
  
*     TEST FOR NH FILE/REPORT PARAMETER 
  600 CONTINUE
      IF (FROG(3) .EQ. 2HON) GO TO 750
                                                                         HPA408S
*          TEST FOR MEDIA REPORT PARAMETER
      IF (FROG(5) .NE. 3HOFF) GO TO 760 
      GO TO 2000
  
*       DO SORT OF SEF FILE FOR HISTORY 
  750 FLAGS(9) = 2
      IF (FILEP(SEF) .EQ. 3HOFF) GO TO 760
      CALL XOVCAP ('HPA2',0,0)
      CALL UOVCAP ('HPA2')
  
*          *************************************************
  
  760 CONTINUE
*     TURN OFF FILE (2) IF NEW HISTORY (NH) FILE/REPORT NOT REQUESTED.
*     IT IS USED AS A SCRATCH FILE IN OVERLAYS 3 AND 5. 
      IF (FROG(3) .NE. 2HON) FILEP(NEW) = 3HOFF 
  
*        TEST FOR NH OR MEDIA REPORT PARAMETER
      IF ((FILEP(NEW) .EQ. 3HOFF) .AND. (FROG(5) .EQ. 3HOFF)) GO TO 2000
      CALL XOVCAP ('HPA8',0,0)
      CALL UOVCAP ('HPA8')
      IF (FLAGS(2) .EQ. 5HERROR) CALL EXIT                               R2FHWMO
  
*          *****************************************: 
  
*       TEST FOR TAPE REPORT PARAMETER
  800 IF (FROG(5) .EQ. 3HOFF) GO TO 2000
  
*      DO SORT OF SCR1 TO SCR3 FOR MEDIA REPORT 
      FLAGS(9) = 3
      CALL XOVCAP ('HPA2',0,0)
      CALL UOVCAP ('HPA2')
  
  
*     OVERLAY TO PROCESS TAPE MEDIA REPORT
      CALL XOVCAP ('HPA9',0,0)
      CALL UOVCAP ('HPA9')
  
*     COMPLETE PROCESSING OF RECORD MANAGER INTERFACE FILES.
 2000 CALL XOVCAP ('RMCLOSE',0,0) 
      CALL UOVCAP ('RMCLOSE') 
                                                                        001190
*     EXIT TIME PRINT OUT CONTROL, TIME PRINTS CONTROLLED BY            001200
*     (X=T) PARAMETER.                                                  001210
      IF (FROG(6) .NE. L"T") GO TO 2100 
      CP = SECOND ()
      PRINT 2099,CP                                                     001240
 2099 FORMAT ( ' EXIT HPA, SECOND = ',F10.3)
 2100 CONTINUE                                                          001260
      END 
          IDENT  PARMS
          ENTRY  INIT 
          ENTRY  PARSET 
          ENTRY  LOADI
          EXT    INPUT# 
          EXT    OUTPUT#
          EXT    HPA
* 
          LDSET  NOEPT       ELIMINATE EPT FOR NOS/BE EXT. DUPLICATES 
*IF -DEF,DEBUG,1                                                         HPA31F1
          LDSET  PRESET=ZERO                                             HPA31F1
*IF DEF,DEBUG,3                                                          HPA31F1
          LDSET  PRESETA=NGINF                                           HPA31F1
          LDSET  MAP=SBEX/LOADMAP                                        HPA31F1
          LDSET  ERR=ALL                                                 HPA31F1
* 
*CALL VERS
* 
LEVEL     DATA   10L"VERS"
  
  
          ENTRY  VERSION
VERSION   BSS    1
          SA1    LEVEL       GET LEVEL/VERSION IDENTIFIER 
          BX6    X1 
          JP     VERSION
          EJECT 
  
          USE    /COMW/ 
 IPAR     BSS    100
 PARFN    BSS    16 
 IDATIM   BSS    4
          USE    *
* 
          USE    /OPEN/ 
 F1       BSS    1
 F2       BSS    1
 MOVE     BSS    3
          USE    *
**        INIT CRACK CONTROL CARD PARMETERS AND PLACES THEM 
*         IN BUFFER AREA IPARMS THEN RETURNS TO HPA 
* 
*         ENTRY  PARAMETERS STORED IN RA+2-RA+64
* 
*         EXIT   LABELED COMMON BLOCK IPARMS HAS PARAMETERS 
*                STORED IN IT 
* 
*         CALLS  NONE 
* 
*         REGISTORS USED
* 
*         A1,A6,A7
* 
*         X1,X2,X3,X6,X7
* 
*         B1,B2 
* 
  
 INIT     SA1    64B         FETCH NUMBER OF PARAMETERS 
          SB1    X1 
          NZ     B1,INITA    IF PARAMETERS NON ZERO 
          MX7    0
          SA7    2
          SB1    2
 INITA    SX2    17B         17B INDICATES EOF FOR PARMETERS
          MX3    54 
          SA1    B1+1        READ LAST PARAMETER
          BX6    X1*X3
          BX7    X6+X2       STORE 17B IN LAST PARMETER 
          SA7    A1 
          SB1    0
 INIT1    SA1    B1+2 
          BX6    X1 
          SA6    IPAR+B1
          SB1    B1+1 
          SB2    B1-77B 
          NZ     B2,INIT1    IF 77 WORDS NOT MOVED
          MX7    0
          SA7    2
          SA7    3
          SA7    4
          SA7    5
          SA7    6
          SA7    7
          SA7    10B
          SA7    11B
          SA7    12B
          SA7    64B         CLEAR PARMETERS OUT
          EQ     HPA
  
**        PARSET MOVES THE FILE NAMES FROM INTERGER VARIABLES TO
*         CHARACTER VARIABLES SO THE CAN BE USED TO OPEN THE FILES
*         PARAMETERS ARE IN ORDER 
* 
*         ENTRY  IPARMS HAS FILE NAMES STORED IN ORDER
* 
*         EXIT   FILE NAMES ARE STORED IN F1, F2, F3
* 
*         CALLS  NONE 
* 
*         REGISTORS USED
* 
*         A1,A6 
*         X1,X6 
*         B1
* 
  
 PARSET   PS
          SB1    1
          SB2    2
          SA1    PARFN+B2    LOAD NAME FROM INTEGER LOCATION TO X1
          SA1    A1+B1       FETCH NAME FOR INPUT FILE                   HPA405S
          BX6    X1          MOVE NAME TO REG X6
          SA6    F1          STORE NAME IN CHARACTER LOCATION F1
* 
          SA1    A1+B1       LOAD NAME FROM NEXT INTEGER LOCATION INTO X1 
          BX6    X1          MOVE FROM X1 TO X6 
          SA6    F2          STORE NAME IN CHARACTER LOCATION F2
* 
                                                                         HPA405S
          EQ     PARSET 
*         LOADI MOVES VALUES IN CHARACTER VARIABLES TO INTEGER VARIABLES
* 
*         ENTRY  MOVE ARRAY IS A CHARACTER ARRAY AND CONTAINS DATE, TIME
*                JDATE VALUES 
* 
*         EXIT   IDATIM ARRAY IS A INTEGER ARRAY AND CONTAINS DATE, TIME
*                JDATE VALUES 
* 
*         CALLS  NONE 
* 
*         REGISTORS USED
* 
*         A1,A6 
*         X1,X6 
* 
 LOADI    PS
          SB1    1
          SA1    MOVE        LOAD MOVE INTO X1
          BX6    X1          MOVE X1 TO X6
          SA6    IDATIM      STORE IN IDATEM
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          EQ     LOADI
          END    INIT 
          IDENT  LOVCAP=
          ENTRY  LOVCAP 
          ENTRY  LOVCAPX
          TITLE  LOVCAP= - LOAD OVERLAY CAPSULE.
          COMMENT LOVCAP - LOAD OVERLAY CAPSULE.
          B1=1
 LOVCAP=  SPACE  4,10 
***       LOVCAP= - LOAD OVERLAY CAPSULE. 
* 
*         V.    DJORDJEVIC   79/11/30    FTN5LIB VERSION
*         C. D. FOLEY        85/04/29    FOR HPA (DEFAULT LIB OF HPALIB)
* 
  
 TRACE.   VFD    42/7HLOVCAP=,18/LOVCAP 
 TEMPA0.  BSSZ   1
 LOVCAP=  SPACE  4,10 
***       LOVCAP= LOADS AN OVERLAY CAPSULE. 
*         THE ROUTINE FIRST CALLS CHMOVE TO GET THE OVCAP NAME. 
*         IT NEXT CALLS FDL.LOC TO LOAD THE OVCAP AND TO RETURN 
*         THE ADDRESS.
*         EVENTUAL LOAD ERRORS ARE PROCESSED. 
* 
*         ENTRY (B1) = 1
*               (X1) = OVCAP DESCRIPTOR 
* 
*         EXIT  (B1) = 1
* 
*         CALLS MMC.
*               FDL.LOC 
*               TABCAP
  
 LOVCAP   SPACE  4,10 
 LOV30    SA1    TEMPA0.
          SA0    X1          RESTORE A0 
  
 LOVCAP   EQ     *+1S17      ENTRY FROM USER
          SB4    0
 LOV5     SB1    1
          SX6    B4 
          SA6    LOVE        STORE CALLER FLAG
          SX6    A0 
          SA6    TEMPA0.     SAVE A0
          BX6    X1 
          SA6    LOVB        SAVE DESCRIPTOR
          SA1    LOVA 
          RJ     =XMMC. 
  
          SA4    LOVC+1      CAPSULE NAME 
          RJ     =XBTZ.      ZERO FILLED NAME 
          BX2    X6 
          SA6    LOVC+1 
          SX1    B0          SET UP LOAD PARAMETERS 
          SX3    LOVI        LIBRARY LIST 
          SX4    LOVD 
          RJ     =XFDL.LOC   LOAD OVCAP 
          SB7    X1          SET B7 TO OVCAP ADDRESS
          ZR     X6,LOV30    IF LOADED OK 
  
          BX1    X6 
          SA3    LOVC+1      GET CAPSULE NAME 
          MX0    42 
          BX7    X0*X3       ISOLATE NAME 
          SA7    LOVF+1      STORE FOR ERROR PROCESSING 
          SX2    0
          SX1    X1-3 
          SX6    ERR161 
          ZR     X6,LOV10    IF NON-EXISTENT OVCAP
          SX1    X1-3 
          SX6    ERR162 
          ZR     X1,LOV20    IF ALREADY LOADED
          SX6    ERR164 
 LOV10    SA6    LOVG+1      ADDRESS OF ERROR MESSAGE 
          SA1    LOVG        PARAMETER BLOCK
+         RJ     =XSYSTEM    ISSUE ERROR MESSAGES 
-         VFD    12/0,18/TRACE. 
          EQ     LOV30
  
 LOV20    SA3    LOVE 
          ZR     X3,LOV10    IF USER CALL 
          EQ     LOV30
  
 LOVCAPX  EQ     *+1S17      ENTRY FROM XOVCAP
          SA2    LOVCAPX
          BX6    X2 
          SB4    A2          SET NOT USER CALL (NON-ZERO) 
          SA6    LOVCAP      STORE ENTRY FOR TRACEBACK
          EQ     LOV5 
  
*         STORAGE 
  
 LOVA     VFD    30/10,12/0,18/LOVC+1 10 CHAR MMC DEST WD 
 LOVB     BSSZ   1
          CON    0
  
 LOVC     VFD    12/21B,12/1,36/0 
          BSS    1
          CON    0
  
 LOVD     VFD    42/0,18/LOVC      PASS LOC ADDRESS 
          CON    0
 LOVE     BSS    1           CALLER FLAG
  
 LOVF     DATA   10H OVCAP =
          BSS    1           OVCAP NAME 
  
 LOVG     VFD    42/0,18/LOVH 
          VFD    42/0,18/0   MESSAGE ADDRESS
          VFD    42/0,18/0
  
 LOVH     DATA   52D
  
 LOVI     DATA   0LHPALIB    LIBRARY SEARCH LIST
          DATA   0           LIBRARY LIST TERMINATOR
  
*         ERROR MESSAGES. 
  
 ERR161   DATA   C* NON-EXISTENT OVCAP.*
 ERR162   DATA   C* OVCAP IS ALREADY LOADED.* 
 ERR164   DATA   C* FDL ERROR DURING LOAD OR UNLOAD OF OVCAP.*
  
          END 
          IDENT  NEC
          ENTRY  NEC
**
*         FUNCTION SUBROUTINE TO GET WORD OF ERROR MESSAGE
  
          USE    /LINK/ 
LINKET    BSSZ    1 
LINKEM    BSSZ    1 
          USE    *
  
NEC       BSS    1
          SA3    X1          LOAD WORD NUMBER 
          SA1    A1+1 
          SX3    X3-1        FORM WORD OFSET
          SA2    X1          LOAD ERROR CODE NUMBER 
  
*         SET ERROR CODE IN UNUSED MESSAGE AREA 
  
          SX6    0
          BX4    X2 
          SB1    3
          MX0    57 
          LX4    48 
NEC0      LX4    3
          BX5    -X0*X4 
          SB1    B1-1 
          LX6    6
          BX6    X6+X5
          PL     B1,NEC0
          SA4    =10H      0000 
          IX6    X6+X4
          LX6    30 
          SA6    UNUSED+2 
  
*         SEARCH TABLE FOR MESSAGE
  
          SB7    UNUSED      PRESET FOR UNDEFINED MESSAGE 
          SA1    LINKET      GET ADDRESS OF ERROR CODE TABLE
          ZR     X1,NEC4     IF TABLE ADDRESS NOT DEFINED 
          SB1    0           INITIALIZE POSITION COUNTER
NEC1      SA5    X1+B1       LOAD WORD OF TABLE 
          SB2    3           INITIALIZE SHIFT COUNTER 
          MX0    45          INITIALIZE MASK
          ZR     X5,NEC4     END OF TABLE 
NEC2      LX5    15          SHIFT ERROR CODE TO LOWER BITS 
          BX6    X5-X2       COMPARE WITH REQUIRED CODE 
          BX6    -X0*X6      MASK CODE
          ZR     X6,NEC3     ERROR CODE FOUND 
          SB2    B2-1 
          PL     B2,NEC2
          SB1    B1+1 
          JP     NEC1 
  
*         FORM ADDRESS OF MESSAGE 
  
NEC3      SA1    LINKEM      GET ADDRESS OF ERROR MESSAGES
          SX2    B1          CHANGE POSITION INTO ADDRESS OFSET 
          LX2    2
          SB2    -B2
          SB2    B2+3 
          SX2    X2+B2
          BX0    X2 
          LX0    1
          IX2    X2+X0       FORM OFSET TO MESSAGE
          IX2    X2+X1       FORM ADDRESS OF MESSAGE
          SB7    X2 
  
*         LOAD WORD OF MESSAGE AND PLACE IN X6
  
NEC4      SA1    X3+B7       LOAD WORD OF MESSAGE 
          BX6    X1 
          JP     NEC
  
UNUSED    DATA   30H***UNUSED MESSAGE***
  
          END 
      BLOCK DATA SETFC
* 
**        DEFINE FIELD LOCATION VALUES, 
*         THESE ARE USED TO SPECIFY THE LOCATION OF A DATA FIELD
*         IN ARRAY (IFLD) AFTER PARSING FROM A RECORD, BY SETFLDS.
* 
*         *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 
* 
*CALL,HPACOM1 
*         * * *  COMMON  FIELDS - (FC)  * * * 
*                                  FDT= DEVICE TYPE 
      DATA FDT   /17/ 
*                                  FMTY= ERROR CODE 
      DATA FMTY  / 8/ 
*                                  FEST = EST ORDINAL 
      DATA FEST  /15/ 
*                                  FRTY = RECORD TYPE 
      DATA FRTY  / 2/ 
*                                  FCON = CONTROLLER
      DATA FCON  / 4/ 
*                                  FUN = UNIT 
      DATA FUN  / 5/
*                                  FC7 = YEAR (BIAS FROM 1970)
      DATA FC7  / 6/
*                                 FJDAY = JULIAN DAY OF YEAR
      DATA FJDAY   /7/
*                                  FTIME = TIME - HRS.
      DATA FTIME  / 9/
*                                  FC10 = TIME - MIN. 
*                                  FC11 = TIME - SEC. 
*                                  FJOB = JOB NAME
      DATA FJOB /18/
*                                  FC13 = RECOV,D/UNRECOV,D FLAG
      DATA FC13 /16/
*                                  FCHAN = CHANNEL IN USE 
      DATA FCHAN /12/ 
*                                  HUID = HARDWARE UNIQUE IDENTIFIER
      DATA FHUID /19/ 
*                                  FSYS = SYSTEM OF ORGIN 
      DATA FSYS / 1/
*                                  FC16 = PRIMARY CHANNEL 
      DATA FC16 / 3/
*                                  FC20 = TIME (ENCODED FOR PRINT ) 
      DATA FC20 /20/
*                                  FPPU = PPU NUMBER
      DATA FPPU /13/
*                                  FACHAN = ALTERNATE CHANNEL 
      DATA FACHAN /14/
  
      END 
      SUBROUTINE HEADER 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE HEADER EJECTS PRINT PAGE, RESETS LINE COUNT, 
*         PRINTS PAGE HEADER AND REPORT NAME, AND ADVANCES PAGE COUNT 
* 
*         ENTRY CONDITIONS
*         ----------------
*            IHDR = SET BY CALLING ROUTINE TO HEADER TO BE PRINTED. 
* 
*         EXIT CONDITIONS 
*         --------------- 
*         DATA AREAS SHARED - 
*         LINE
* 
*         DATA AREAS
*         ----------
*         IHDR   - (1)/COMMON BLOCK/INDEX VALUE TO DEFINE ONE OF
*                  HEADERS TO BE USED FOR THE REPORTS.
*         IREP   - (3,20)/LOCAL TO SUBROUTINE/AREA TO HOLD HEADERS
*                  FOR VARIOUS REPORTS. COLUMN NUMBER WHICH IS
*                  DEFINED BY IHDR SELECTS ONE OF THE HEADERS.
*         LINE   - (1)/COMMON BLOCK/LINE COUNT PRINTED SO FAR IN
*                  THE CURRENT PAGE.
* 
* 
*CALL,HPACOM1 
*CALL HPACOM2 
*CALL HPACOM3 
      DIMENSION IREP(3,44)
  
      DATA IDSFLG /0,0/, FEOFSAV /0/, SP /1H /, 
     .     VSNCNT /1/, LCH /0/, TBFL /0,0/, ITCHAN /63*0/, SEBUF /64*0/ 
  
*         **  -- HEADER DEFINITIONS  ** 
  
      DATA (IREP(I, 1),I=1,3,1) /10HCONTROL CA,10HRD PARAMET,10HERS 
     +  / 
      DATA (IREP(I, 2),I=1,3,1) /10HSUMMARY ..,10H. ERROR LO,10HG ENTRIE
     +S / 
      DATA (IREP(I, 3),I=1,3,1) /10HDETAIL REP,10HORT .. CYB, 
     .                           10HERPLUS    / 
      DATA (IREP(I, 4),I=1,3,1) /10HSYSTEM CON,10HFIGURATION, 
     .                           10H          / 
      DATA (IREP(I, 6),I=1,3,1) /10H UNIT ANAL,10HYSIS  REPO,10HRT
     +  / 
      DATA (IREP(I, 7),I=1,3,1) /10H DETAIL RE,10HPORT .. S/,10HC  REG. 
     +  / 
      DATA (IREP(I, 8),I=1,3,1) /10H DETAIL RE,10HPORT .. TA,10HPES 
     +  / 
      DATA (IREP(I, 9),I=1,3,1) /10H DETAIL RE,10HPORT .. MA,10HSS STORA
     +GE/ 
      DATA (IREP(I,10),I=1,3,1) /10H DETAIL RE,10HPORT .. LC, 
     .                           10HN         / 
      DATA (IREP(I,11),I=1,3,1) /10H ANALYSIS ,10HREPORT .. , 
     .                           10HLCN       / 
      DATA (IREP(I,12),I=1,3,1) /10HDETAIL REP,10HORT .. ESM, 
     .                           10H          / 
      DATA (IREP(I,13),I=1,3,1) /10H HISTORY U,10HPDATED .. ,10HREPORT
     +  / 
      DATA (IREP(I,14),I=1,3,1) /10H ERROR COD,10HE .. REPOR,10HT 
     +  / 
      DATA (IREP(I,15),I=1,3,1) /10H TAPE MEDI,10HA .. DETAI,10HL REPORT
     +  / 
      DATA (IREP(I,16),I=1,3,1) /10HDETAIL REP,10HORT..CHANN, 
     .                           10HEL MSGS   / 
      DATA (IREP(I,17),I=1,3,1) /10HANALYSIS R,10HEPORT..CHA, 
     .                           10HNNEL MSGS / 
      DATA(IREP(I,18),I=1,3,1) / 10HDETAIL REP,10HORT - 2550, 
     .                           10H/CDCNET   / 
      DATA (IREP(I,19),I=1,3,1) /10HMASSTOR ME,10HDIA..SUMMA, 
     .                           10HRY REPORT / 
      DATA(IREP(I,20),I=1,3,1) / 10HDETAIL REP,10HORT..ECS/D,10HDP
     +  / 
      DATA (IREP(I,21),I=1,3,1) /10H TAPE MEDI,10HA .. SUMMA,10HRY REPOR
     +T / 
      DATA (IREP(I,22),I=1,3,1) /10HDETAIL REP,10HORT..UNIT ,10HRECORD
     +  / 
      DATA (IREP(I,23),I=1,3,1) /10H DETAIL RE,10HPORT ... M, 
     .                           10HAP III/IV / 
      DATA (IREP(I,24),I=1,3,1) /10HANALYSIS R,10HEPORT..C17,10H6 S/C RE
     +G / 
      DATA (IREP(I,25),I=1,3,1) /10HDETAIL REP,10HORT .. 99X, 
     .                           10H MEMORY   / 
      DATA (IREP(I,26),I=1,3,1) /10HDETAIL REP,10HORT .. 99X, 
     .                           10H SECDED   / 
      DATA (IREP(I,27),I=1,3,1) /10HUNIT ERROR,10H GRAPHS   ,10H
     +  / 
      DATA (IREP(I,28),I=1,3,1) /10H  INTERVEN,10HTION REPOR,10HT 
     +  / 
      DATA (IREP(I,29),I=1,3,1) /10HDETAIL REP,10HORT..99X P, 
     .                           10HROCESSOR 0/ 
      DATA (IREP(I,30),I=1,3,1) /10HDETAIL REP,10HORT..99X P, 
     .                           10HROCESSOR 1/ 
      DATA (IREP(I,31),I=1,3,1) /10HDETAIL REP,10HORT..MAINF, 
     .                           10HRAME MSGS / 
      DATA (IREP(I,32),I=1,3,1) /10HDETAIL REP,10HORT       ,10H
     +  / 
      DATA (IREP(I,33),I=1,3,1) /10HDETAIL REP,10HORT..I1 / , 
     .                           10HI1CR / I2 / 
      DATA (IREP(I,34),I=1,3,1) /10HDETAIL REP,10HORT..I4 IO, 
     .                           10HU 0       / 
      DATA (IREP(I,35),I=1,3,1) /10HDETAIL REP,10HORT ... 88, 
     .                           10H7         / 
      DATA (IREP(I,36),I=1,3,1) /10HDETAIL REP,10HORT ... SW, 
     .                           10H MSGS     / 
      DATA (IREP(I,37),I=1,3,1) /10HANALYSIS R,10HEPORT ... , 
     .                           10HSYSTEM MSG/ 
      DATA (IREP(I,38),I=1,3,1) /10HDETAIL REP,10HORT ... DU, 
     .                           10HAL STATE  / 
      DATA (IREP(I,39),I=1,3,1) /10HDETAIL REP,10HORT..I4 IO, 
     .                           10HU 1       / 
      DATA (IREP(I,40),I=1,3,1) /10HDETAIL REP,10HORT ... PR, 
     .                           10HOCESSOR 0 / 
      DATA (IREP(I,41),I=1,3,1) /10HDETAIL REP,10HORT ... PR, 
     .                           10HOCESSOR 1 / 
      DATA (IREP(I,42),I=1,3,1) /10HDETAIL REP,10HORT ... ME, 
     .                           10HMORY      / 
      DATA (IREP(I,43),I=1,3,1) /10HDETAIL REP,10HORT ... 98, 
     .                           10H53 / DAS  / 
      DATA (IREP(I,44),I=1,3,1) /10HDETAIL REP,10HORT .. OPT, 
     .                           10HICAL DISK / 
  
  
*         *********************************************** 
*           HPA VERSION LEVEL IDENTIFIER   -------- 
  
      HPVER=VERSION(0)
  
*         ************************************************
                                                                         HPA401R
      IF (FROG(6) .NE. L"REG") GO TO 4
      PRINT 3                                                            HPA401R
    3 FORMAT (1H1,/)                                                     HPA401R
      GO TO 20                                                           HPA401R
    4 IF (IHDR .EQ. 1) GO TO 6                                           HPA401R
      IF (FROG(18) .NE. 3HYES) GO TO 6                                   HPA401R
      PRINT 5, (IREP(K,IHDR),K=1,3),IDATIM(1) 
    5 FORMAT(1H1,4A10,/)
      GO TO 20                                                           HPA401R
    6 CONTINUE                                                           HPA401R
      PRINT 10, HPVER,(IREP(K,IHDR),K=1,3),IDATIM(1),IDATIM(2),IPAGE
   10 FORMAT (1H1,5HHPA  ,A10,2X,4A10,1X,A10,1X,4HPAGE,I4)
      PRINT 11
   11 FORMAT(10H * * * * * ,/)
   20 CONTINUE                                                           HPA401R
      IPAGE=IPAGE+1 
      LINE = 3
      RETURN
      END 
      SUBROUTINE LOAPR ( LIP,W1,W2,W3,W4,W5,W6,W7,W8 )
* 
**            DESCRIPTION 
*             ------------
*             LOAPR  --  LOAD CONSECUTIVE LOCATIONS IN PRINT BUFFER 
*                     ( PL ) , WITH DATA FROM PARAMETER LOCATIONS 
* 
*           ENTRY CONDITIONS
*          -------------------
*          ROUTINE IS CALLED WITH PARAMETERS TO SPECIFY LOCATION
*          IN ( PL ) AND DATA TO BE LOADED. 
*            -  LIP  = STARTING LOCATION IN (PL) FOR LOAD.
*            -  W1 TO W8 = DATA LOCATIONS AS SELECTED BY
*               CALLING ROUTINES. 
*               MAX. OF 8 WORDS ARE LOADED, IF LESS THAN 8
*            ARE TO BE LOADED - REMAINING PARAMETER LOCATIONS ARE 
*            DESIGNATED AS SPACES, WITH  ( SP ).
* 
*             EXIT CONDITIONS 
*             ----------------
*             DATA WORDS TRANSFERRED TO ( PL ). 
* 
*             CALLED BY 
*             ----------- 
*             ANY REPORT GENERATION SUBROUTINES MAKING USE OF THE 
*             * PRINT * SUBROUTINE. 
* 
*CALL,HPACOM1 
  
       K = LIP
       PL(K) = W1 
       PL(K+1) = W2 
       PL(K+2) = W3 
       PL(K+3) = W4 
       PL(K+4) = W5 
       PL(K+5) = W6 
       PL(K+6) = W7 
       PL(K+7) = W8 
  
       RETURN 
       END
      SUBROUTINE PLSEC(F) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE PLSEC PRINTS SECTION DIVIDERS ON VARIOUS 
*         REPORT PAGES. 
* 
*         ENTRY CONDITIONS
*         ----------------
*         F  - DEFINES THE CHARACTER TO BE USED AND THE FORMAT OF 
*              SECTION DIVIDER. 
* 
*         DATA AREAS
*         ----------
*         FC     - (5)/LOCAL TO SUBROUTINE/TABLE OF CHARACTERS
*                  TO BE USED FOR A SECTION DIVIDER.
*         KW     - (1)/LOCAL TO SUBROUTINE/LENGTH OF SECTION
*                  DIVIDER LINE IN WORDS. 
*         PL - (32)/COMMON BLOCK/AREA FROM WHERE SECTION
*                  DIVIDER IS PRINTED OUT.
* 
* 
*CALL,HPACOM1 
      DIMENSION FC(4),PLS(13) 
      DATA FC(1) / 10H  --------  / 
      DATA FC(2) /10H * * * * * / 
      DATA FC(3) /10H---------- / 
* 
      KW = 6
      IF (F .EQ. 4) GO TO 40
      IF (F .EQ. 5) GO TO 50
      PLS(7) = 1H 
      IF(F.EQ.3) KW = 7 
      DO 10 K=1,KW
   10 PLS(K) = FC(F)
      PRINT 20, (PLS(J), J=1,KW)
   20 FORMAT (1X,7A10)
      IF (F .GE. 3) GO TO 30
      LINE = LINE + 1 
      PRINT 25
   25 FORMAT (1H )
   30 LINE = LINE + 1 
      GO TO 90
  
   40 PRINT 41
   41 FORMAT ( / )                                                      000120
      LINE = LINE + 2                                                   000130
      GO TO 90
  
   50 PRINT 51
   51 FORMAT (1X) 
      LINE = LINE + 1 
  
   90 RETURN
      END 
      SUBROUTINE RMDXIT 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE RMDXIT IS A NULL ROUTINE WHOSE ADDRESS EXISTS IN THE 
*         DX FIT FIELDS.  SORT/MERGE UNCONDITIONALLY SETS THE DX FIELDS 
*         OF SORT FILES TO THE ADDRESS OF A SORT ROUTINE.  THIS DX FIELD
*         MUST BE CLEARED WHEN THE FILE IS USED BY HPA AFTER SORT/MERGE,
*         TO PREVENT RE-ENTERING THE SORT ROUTINES WHEN END-OF-DATA OCCURS. 
* 
*     RETURN TO CALLING ROUTINE 
      RETURN
      END 
      SUBROUTINE RMFILEM (FILE) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE RMFILEM WRITES A FILE MARK ON THE SPECIFIED FILE.
* 
*         ENTRY CONDITION 
*         --------------- 
*         FILE = FILE SPECIFIED FOR WRITING FILE MARK ON. 
* 
*         EXIT CONDITION
*         --------------
*         FEOF(FILE) = SET TO 3HYES IF FILE NOT PRESENT, INVALID FILEP(FILE)
*                                   NAME OR AFTER WRITING FILE MARK.
*         ERROR MESSAGE PRINTED AND EXIT CALLED IF INVALID FILE NUMBER. 
* 
*CALL HPACOM1 
  
*     CHECK IF FILE PRESENT 
      IF (FILEP(FILE) .EQ. 3HOFF) GO TO 800 
  
*     CHECK FOR VALID FILE
      NAMECHK = AND (SHIFT(FILEP(FILE),6), O"77") 
      IF (NAMECHK .GE. R"0") GO TO 800
      IF ((FILE .GE. 1) .AND. (FILE .LE. 16)) GO TO 100 
      PRINT 50, FILE
   50 FORMAT (1X,' RMFILEM ... ILLEGAL FILE FOR FILEM COMMAND ',I2) 
      CALL EXIT 
  
*     WRITE THE FILE MARK 
  100 CALL ENDFILE (FITTBL(1,FILE)) 
  
*     SET EOF FLAG IF FILE NOT PRESENT, INVALID FILE NAME OR
*     AFTER WRITING FILE MARK 
  800 FEOF(FILE) = 3HYES
  
*     RETURN TO CALLING ROUTINE 
      RETURN
      END 
      SUBROUTINE RMOPEN 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE RMOPEN CALLS ON RECORD MANAGER INTERFACE TO BUILD
*         A FILE INFORMATION TABLE (FIT) AND INITIALIZE EACH HPA FILE 
*         WITH THE EXCEPTION OF INPUT AND OUTPUT FILES. 
*         RMOPEN IS CALLED FROM SUBROUTINE SETPAR1. 
* 
*         EXIT CONDITION
*         --------------
*         FILEP ARRAY TURNED ON OR OFF TO DENOTE THE PRESENCE OR ABSENCE
*         OF EACH FILE:                FILEP (1) = OLD (LFN OLDHF)
*                                            (2) = NEW (LFN NEWHF)
*                                            (3) = RSEF (LFN SEF) 
*                                            (4) = SEF (LFN FSORT)
*                                FTN IO      (5) = INPUT (LFN TAPE5)
*                                FTN IO      (6) = OUTPUT (LFN TAPE6) 
*                                            (7) = UNUSED 
*                                            (8) = UNUSED 
*                                            (9) = UNUSED 
*                                           (10) = SCR1 (LFN TAPE10)
*                                           (11) = SCR2 (LFN TAPE11)
*                                           (12) = SCR3 (LFN TAPE12)
*                                           (13) = UNUSED 
*                      MS FILE -  HPSORT    (14) = RAMF2 (LFN TAPE14) 
*                                 HPSORT    (15) = SCR4 (LFN TAPE15)
*                                 HPSORT    (16) = SCR5 (LFN TAPE16)
* 
*CALL HPACOM1 
  
      EXTERNAL RMDXIT 
      DIMENSION IBUFFER (64)
      DATA (LFNTBL(I), I=1,16)  / L"OLDHF",L"NEWHF",L"SEF",L"FSORT",L" "
     .,L" ",                          L" ",L" ",L" ",L"TAPE10",L"TAPE11"
     .,L"TAPE12",                           L" ",L" ",L"TAPE15",L"TAPE16
     ."/
  
*     CONSTRUCT A FIT TABLE FOR EACH FILE 
      CALL FILESQ (FITTBL(1,1),L"LFN",LFNTBL(1),L"RT",L"W",L"BT",L"I",
     .                              L"MRL",640,L"WSA",IBUFFER(1),L"DX",R
     .MDXIT)
      CALL FILESQ (FITTBL(1,2),L"LFN",LFNTBL(2),L"RT",L"W",L"BT",L"I",
     .                              L"MRL",640,L"WSA",IBUFFER(1),L"DX",R
     .MDXIT)
      CALL FILESQ (FITTBL(1,3),L"LFN",LFNTBL(3),L"RT",L"W",L"BT",L"I",
     .                               L"MRL",80,L"WSA",IBUFFER(1),L"DX",R
     .MDXIT)
      CALL FILESQ (FITTBL(1,4),L"LFN",LFNTBL(4),L"RT",L"W",L"BT",L"I",
     .                               L"MRL",80,L"WSA",IBUFFER(1),L"DX",R
     .MDXIT)
      CALL FILESQ (FITTBL(1,10),L"LFN",LFNTBL(10),L"RT",L"W",L"BT",L"I",
     .                               L"MRL",640,L"WSA",IBUFFER(1),L"DX",
     .RMDXIT) 
  
*IF DEF,HPSORT
*     CONSTRUCT, OPEN AND REWIND FILES IF HPSORT DEFINED
*     TAPE14 IS FTN IO RANDOM ACCESS MS FILE IN INIDAT2 
      CALL FILESQ (FITTBL(1,15),L"LFN",LFNTBL(15),L"RT",L"W",L"BT",L"I",
     .                        L"MRL",640,L"WSA",IBUFFER(1),L"DX",RMDXIT)
      CALL FILESQ (FITTBL(1,16),L"LFN",LFNTBL(16),L"RT",L"W",L"BT",L"I",
     .                        L"MRL",640,L"WSA",IBUFFER(1),L"DX",RMDXIT)
*ENDIF
  
      CALL XOVCAP ('RMOPENX',0,0) 
      CALL UOVCAP ('RMOPENX') 
  
*     RETURN TO SETPAR1 
      RETURN
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*     ENTRY POINT - RMOPEN2 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
      ENTRY RMOPEN2 
      CALL FILESQ (FITTBL(1,11),L"LFN",LFNTBL(11),L"RT",L"W",L"BT",L"I",
     .                        L"MRL",640,L"WSA",IBUFFER(1),L"DX",RMDXIT)
      CALL FILESQ (FITTBL(1,12),L"LFN",LFNTBL(12),L"RT",L"W",L"BT",L"I",
     .                         L"MRL",80,L"WSA",IBUFFER(1),L"DX",RMDXIT)
  
      CALL XOVCAP ('RMOPENX',1,0) 
      CALL UOVCAP ('RMOPENX') 
  
*     RETURN TO SETPAR1 
      RETURN
      END 
      SUBROUTINE RMREAD (FILE,IBUFFER,ILENGTH)
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE RMREAD READS A RECORD FROM THE SPECIFIED FILE
*         INTO THE SPECIFIED ARRAY AND RETURNS THE RECORD LENGTH. 
* 
*         ENTRY CONDITION 
*         --------------- 
*         FILE = FILE SPECIFIED FOR READING.
*         IBUFFER = ARRAY SPECIFIED FOR DATA INPUT. 
* 
*         EXIT CONDITION
*         --------------
*         ILENGTH = LENGTH OF RECORD READ INTO IBUFFER FROM FILE. 
*         FEOF(FILE) = SET TO 2HNO (CLEARED) BEFORE READING A RECORD. 
*                      SET TO 3HYES IF FILE NOT PRESENT, INVALID FILEP(FILE)
*                                   NAME, EOF OR EOI OCCURS.
*         ERROR MESSAGE PRINTED AND EXIT CALLED IF INVALID FILE NUMBER. 
* 
*CALL HPACOM1 
  
      DIMENSION IBUFFER(64) 
  
*     CHECK IF FILE PRESENT 
      IF (FILEP(FILE) .EQ. 3HOFF) GO TO 800 
  
*     CHECK FOR VALID FILE
      NAMECHK = AND (SHIFT(FILEP(FILE),6), O"77") 
      IF (NAMECHK .GE. R"0") GO TO 800
      IF ((FILE .GE. 1) .AND. (FILE .LE. 16)) GO TO 100 
      PRINT 50, FILE
   50 FORMAT (1X,' RMREAD ... ILLEGAL FILE FOR READ COMMAND ',I2) 
      CALL EXIT 
  
*     CLEAR THE EOF FLAG
  100 FEOF(FILE) = 2HNO 
  
*     READ THE FILE INTO IBUFFER
      CALL GET (FITTBL(1,FILE),IBUFFER(1))
      FP = IFETCH (FITTBL(1,FILE),L"FP")
      IF (FP .NE. O"20") GO TO 800
  
*     OBTAIN NUMBER OF 60 BIT WORDS TRANSFERRED TO IBUFFER
      RL = IFETCH (FITTBL(1,FILE),L"RL")
      ILENGTH = RL/10 
      GO TO 900 
  
*     SET EOF FLAG IF FILE NOT PRESENT, INVALID FILE NAME,
*     EOF OR EOI OCCURS 
  800 FEOF(FILE) = 3HYES
  
*     RETURN TO CALLING ROUTINE 
  900 RETURN
      END 
      SUBROUTINE RMREWND (FILE) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE RMREWND REWINDS THE SPECIFIED FILE.
* 
*         ENTRY CONDITION 
*         --------------- 
*         FILE = FILE SPECIFIED FOR REWINDING.
* 
*         EXIT CONDITION
*         --------------
*         FEOF(FILE) = SET TO 2HNO AFTER REWINDING. 
*                      SET TO 3HYES IF FILE NOT PRESENT OR INVALID
*                                   FILEP(FILE) NAME. 
*         ERROR MESSAGE PRINTED AND EXIT CALLED IF INVALID FILE NUMBER. 
* 
*CALL HPACOM1 
  
*     CHECK IF FILE PRESENT 
      IF (FILEP(FILE) .EQ. 3HOFF) GO TO 800 
  
*     CHECK FOR VALID FILE
      NAMECHK = AND (SHIFT(FILEP(FILE),6), O"77") 
      IF (NAMECHK .GE. R"0") GO TO 800
      IF ((FILE .GE. 1) .AND. (FILE .LE. 16)) GO TO 100 
      PRINT 50, FILE
   50 FORMAT (1X,' RMREWND ... ILLEGAL FILE FOR REWIND COMMAND ',I2)
      CALL EXIT 
  
*     REWIND THE FILE 
  100 CALL REWND (FITTBL(1,FILE)) 
      FEOF(FILE) = 2HNO 
      GO TO 900 
  
*     SET EOF FLAG IF FILE NOT PRESENT OR INVALID FILE NAME 
  800 FEOF(FILE) = 3HYES
  
*     RETURN TO CALLING ROUTINE 
  900 RETURN
      END 
      SUBROUTINE RMWRITE (FILE,IBUFFER,ILENGTH) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE RMWRITE WRITES A RECORD OF THE SPECIFIED LENGTH
*         FROM THE SPECIFIED ARRAY ON THE SPECIFIED FILE. 
* 
*         ENTRY CONDITION 
*         --------------- 
*         FILE = FILE SPECIFIED FOR WRITING.
*         IBUFFER = ARRAY SPECIFIED FOR DATA OUTPUT.
*         ILENGTH = LENGTH OF RECORD TO BE WRITTEN FROM IBUFFER.
* 
*         EXIT CONDITION
*         --------------
*         FEOF(FILE) = SET TO 3HYES IF FILE NOT PRESENT OR INVALID
*                               FILEP(FILE) NAME. 
*         ERROR MESSAGE PRINTED AND EXIT CALLED IF INVALID FILE NUMBER. 
* 
*CALL HPACOM1 
  
      DIMENSION IBUFFER (64)
  
*     CHECK IF FILE PRESENT 
      IF (FILEP(FILE) .EQ. 3HOFF) GO TO 800 
  
*     CHECK FOR VALID FILE
      NAMECHK = AND (SHIFT(FILEP(FILE),6), O"77") 
      IF (NAMECHK .GE. R"0") GO TO 800
      IF ((FILE .GE. 1) .AND. (FILE .LE. 16)) GO TO 100 
      PRINT 50, FILE
   50 FORMAT (1X,' RMWRITE ... ILLEGAL FILE FOR WRITE COMMAND ',I2) 
      CALL EXIT 
  
*     OBTAIN NUMBER OF CHARACTERS TO BE TRANSFERRED FROM IBUFFER
  100 RL = ILENGTH * 10 
  
*     WRITE THE FILE FROM IBUFFER 
      CALL PUT (FITTBL(1,FILE),IBUFFER(1),RL) 
      GO TO 900 
  
*     SET EOF FLAG IF FILE NOT PRESENT OR INVALID FILE NAME 
  800 FEOF(FILE) = 3HYES
  
*     RETURN TO CALLING ROUTINE 
  900 RETURN
      END 
      SUBROUTINE SETREF (PAR,FLAG)
* 
**       SETREF  -  ROUTINE TO SEF REPORT CONTROL FLAGS 
*                   FOR ANALYSIS AND DETAIL REPORTS.
* 
*         ENTRY CONDITIONS -
*         ------------------------- 
*         PAR = POINT TO POSITION IN ARRAY FROP (X,X,PAR) , 
*               DEPENDING ON PARAMETER TO BE TESTED.
*                     ANALYSIS,   OR DETAIL PARAMETER TEST. 
*        FLAG = SET TO VALUE (RCFA), OR (RCFD), WHICH ARE 
*               USED TO CONTROL CALLING ROUTINES PRINTING 
*               OF ANALYSIS AND DETAIL REPORTS. 
* 
*         EXIT CONDITIONS 
*         --------------------- 
*         CURRENT DEVICE TYPE, AND EST (IF APPLICABLE), ARE 
*         TESTED AGAINST PARAMETER VALUES IN ARRAYS POINTED 
*         TO BY (PAR).
*         REPORT CONTROL FLAG (FLAG) IS SET TO VALUE OF 
*         (ON), OR (OFF) DEPENDING ON RESULTS OF TEST.
* 
*CALL,HPACOM1 
      FLAG = 2HON 
  
      DO 100 K=1,8
*            CHECK FOR NONE SELECTED
      IF (FROP(K,1,PAR) .EQ. 3HOFF ) GO TO 150
*            CHECK FOR ALL SELECTED  (NO EQUALS SIGN SPECIFIED ON CALL) 
      IF (FROP(K,1,PAR) .EQ. 3HALL ) GO TO 200
*            CHECK IF ERROR CODE SPECIFIED
      IF (FROP(K,1,PAR) .EQ. 7HERRCODE ) GO TO 40 
*            CHECK IF HUID SPECIFIED
      IF (FROP(K,1,PAR) .EQ. 4HHUID ) GO TO 60
*            CHECK DEVICE TYPE FOR NO MATCH 
      IF (FROP(K,1,PAR) .NE. IFLD(FDT)) GO TO 100 
*            CHECK DT FORM OF PARAMETER 
      IF (FROP(K,2,PAR) .EQ. 3HALL ) GO TO 200
*            CHECK DTEEE FORM OF PARAMETER
      IF (FROP(K,2,PAR) .EQ. IFLD(FEST)) GO TO 200
*            CHECK DTEEEUU FORM OF PARAMETER
      FRUN = SHIFT(IFLD(FUN),9).OR.IFLD(FEST) 
      IF(FROP(K,2,PAR).EQ.FRUN) GO TO 200 
*       IF UNIT NUMBER SELECTED WAS ZERO TEST FOR 77 UPPER 6 BITS 
        IF(FROP(K,2,PAR).EQ.(L";".OR.FRUN)) GO TO 200 
      GO TO 100 
*            CHECK ERROR CODE FOR MATCH 
   40 IF (FROP(K,2,PAR) .EQ. IFLD(FMTY)) GO TO 200
      GO TO 100 
*            CHECK HUID FOR MATCH 
   60 IF (FROP(K,2,PAR) .EQ. IFLD(FHUID)) GO TO 200 
 100  CONTINUE
 150  FLAG = 3HOFF
 200  RETURN
      END 
      OVCAP.
      SUBROUTINE SETFLDS (FLDS) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE SETFLDS PARSES SEF INPUT ERROR RECORD IN SEFREC
*         INTO INDIVIDUAL FIELDS AND PUTS THEM IN EITHER ARRAY IFLD 
*         (FLDS = 4HIFLD) OR ARRAY NFLD (FLDS = 4HNFLD).
*         DATA FIELD DEFINITION FOR EACH RECORD TYPE IS DEFINED IN
*         BLOCK DATA SETIBIT. 
* 
*         ENTRY CONDITIONS
*         ----------------
*         DATA AREAS SHARED - 
*         ICOMBIT(2), IBIT(64,3), SEFREC
* 
*         EXIT CONDITIONS 
*         --------------- 
*         DATA AREAS SHARED - 
*         IFLD(64), NFLD(64)
* 
*         DATA AREAS
*         ----------
*         ICOMBIT - (2)/COMMON BLOCK/AREA TO HOLD THE DEFINITION OF 
*                   DATA FIELDS WHICH ARE COMMON TO ALL SEF INPUT 
*                   RECORDS.
*                   DEFINES THE DATA FIELDS OF THE FIRST THREE WORDS
*                   OF SEF INPUT RECORD.
*         IBIT    - COMMON BLOCK TO HOLD THE DEFINITION 
*                   OF DATA FIELDS WHICH ARE UNIQUE TO EACH SEF ERROR 
*                   INPUT RECORD. 
*         SEFREC  - (8)/COMMON BLOCK/AREA TO HOLD THE CURRENT SEF 
*                   ERROR INPUT RECORD IN PACKED FORM.
*         IFLD    - (64)/COMMON BLOCK/AREA TO HOLD THE PARSED DATA
*                   FIELDS OF THE CURRENT SEF ERROR INPUT RECORD IN 
*                   RIGHT-JUSTIFIED.
*         NFLD    - (1)/COMMON BLOCK/HOLDS INDEX VALUE TO SELECT
*                   ONE ENTRY WORD IN ARRAY IFLD. 
*         NIBY    - (1)/COMMON BLOCK/HOLDS INDEX VALUE TO SELECT
*                   ONE ENTRY WORD IN ARRAY IBY.
*         IBY     - (64)/COMMON BLOCK/AREA TO HOLD THE PARSED DATA
*                   FIELD BIT COUNTS FOR THE CURRENT INPUT RECORD IN
*                   SEFREC. 
*         JWORD   - (1)/COMMON BLOCK/HOLDS DATA FIELD DEFINITION WORD 
*                   IN PACKED FORM. 
*         JBC     - (1)/LOCAL TO SUBROUTINE/BIT COUNT OF THE CURRENT
*                   DATA FIELD. 
*         JB      - (1)/LOCAL TO SUBROUTINE/HOLDS TOTAL BIT COUNTS
*                   PAESED SO FAR.
*         J2      - (1)/LOCAL TO SUBROUTINE/TEMPORARY USAGE.
*         J3      - (1)/LOCAL TO SUBROUTINE/TEMPORARY USAGE.
* 
*         CALLED BY 
*         --------- 
*         HPA3 (SEFED3) - HPA9 (TAPREP9)
* 
*         CALLS 
*         ----- 
*         SPLIT   - PARSE 6-BIT VALUE DATA FIELD BIT COUNTS FROM
*                   DATA FIELDS ARRAY DEFINED BY SUBROUTINE SETIBIT.
*CALL HPACOM1 
  
      COMMON /PARSE/ IBIT(72,3), IBY(64), ICOMBIT(2)
  
*         PARSE FIELD BIT COUNTS FROM (IBIT)
  
      NIBY = 1
      RTY = SHIFT (SEFREC(1),18) .AND. O"777" 
*     FORCE NEW UNPACKING FOR DFT SECDED - M1/M1CR/M2/M3/M3CR 
      IF (RTY .EQ. O"13") THEN
         IF ((SEFREC(8) .AND. O"7777") .EQ. O"3410") RTY = O"106" 
      ENDIF 
*     FORCE UNPACKING OF DFT/SCI ERRORS TO THAT OF RTY 13 
      IF ((RTY. EQ. O"11") .AND. (((SEFREC(1). AND. O"7777") .EQ. 
     .   O"4314") .OR. ((SEFREC(1) .AND. O"7777") .EQ. O"4315"))) 
     .   RTY = O"13"
*        ALSO NEGATIVE SIT CONDITION
      IF ((RTY .EQ. O"11") .AND. ((SEFREC(1) .AND. O"7777") .EQ.
     .   O"4320"))
     .   RTY = O"13"
*        FORCE UNPACKING OF EPM ERRORS TO THAT OF RTY 110 
      IF ((RTY .EQ. O"11") .AND. (((SEFREC(1) .AND. O"7777") .EQ. 
     .   O"4316") .OR. ((SEFREC(1) .AND. O"7777") .EQ. O"4317"))) 
     .   RTY = O"110" 
  
  
      JWORD = ICOMBIT(1)
  
*         SPLIT 6-BIT BYTE COUNTS FROM FIELD DEF. ARRAY 
  
      CALL SPLIT (JWORD,NIBY) 
      JWORD = ICOMBIT(2)
      CALL SPLIT (JWORD,NIBY) 
      NIBY = 21 
      DO 50 JW = 1,3
      JWORD = IBIT(RTY,JW)
   50 CALL SPLIT (JWORD,NIBY) 
  
*         GET THE FIELDS FROM (IROM)8 STORE RIGHT-JUSTIFIED 
*         INTO (IFLD),  POINTED TO BY NFLD.  CLEAR IFLD.
  
      NIBY = 1
  
*         GET DATA FIELDS FROM (IROM) 
  
      DO 130 K1 = 1,8 
  
*         BIT COUNTER 
  
      JB = 0
      JWORD = SEFREC(K1)
  
*         FIELD BIT COUNT 
  
  120 JBC = IBY(NIBY) 
      IF (JBC .EQ. 0) GO TO 125 
      JB = JB + JBC 
      IF (JB .GT. 60) GO TO 130 
  
*         MASK FOR CURRENT FIELD
  
      J2 = MASK(JBC)
  
*         GET THE FIELD 
  
      J3 = JWORD .AND. J2 
      JWORD = SHIFT (JWORD,JBC) 
  
*         RIGHT JUSTIFY AND STORE THE FIELD 
  
      IF (FLDS .EQ. 4HIFLD) IFLD(NIBY) = SHIFT(J3,JBC)
      IF (FLDS .EQ. 4HNFLD) NFLD(NIBY) = SHIFT(J3,JBC)
      NIBY = NIBY + 1 
      GO TO 120 
  125 IF (NIBY .GT. 24) GO TO 150 
      NIBY = 21 
  130 CONTINUE
  
  150 IF (FLDS .NE. 4HIFLD) GO TO 160 
      MFID = IFLD(FSYS) .AND. O"77" 
      IF (MFID .EQ. 0) MFID = R" "
  
  160 CONTINUE
      IF (RTY .EQ. O"106") RTY = O"13"
      IF ((RTY. EQ. O"13") .AND. (((SEFREC(1). AND. O"7777") .EQ. 
     .   O"4314") .OR. ((SEFREC(1) .AND. O"7777") .EQ. O"4315"))) 
     .   RTY = O"11"
      IF ((RTY .EQ. O"13") .AND. ((SEFREC(1) .AND. O"7777") .EQ.
     .   O"4320"))
     .   RTY = O"11"
      IF ((RTY .EQ. O"110") .AND. (((SEFREC(1) .AND. O"7777") .EQ.
     .   O"4316") .OR. ((SEFREC(1) .AND. O"7777") .EQ. O"4317"))) 
     .   RTY = O"11"
  
      RETURN
      END 
      SUBROUTINE SPLIT (JWORD,NIBY) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE SPLIT PARSES DATA FIELD BIT COUNT FROM THE 
*         UPPER 6 BITS OF JWORD AND STORES IT RIGHT-JUSTIFIED IN
*         THE ARRAY IBY AS POINTED BY THE COUNTER NIBY. 
*         JWORD IS LEFT-SHIFTED BY 6 BITS AND PARSE CONTINUES UNTIL 
*         DATA IN JWORD IS USED UP OR ZERO QUANTITY BIT COUNT IS
*         ENCOUNTERED.
* 
*         ENTRY CONDITIONS
*         ----------------
*         DATA AREAS SHARED - 
*         JWORD, NIBY, IBY(64)
* 
*         EXIT CONDITIONS 
*         --------------- 
*         DATA AREAS SHARED - 
*         IBY(64) 
* 
*         DATA AREAS
*         ----------
*         JWORD  - (1)/COMMON BLOCK/HOLDS DATA FIELD BIT COUNTS IN
*                  PACKED FORM WHICH IS DEFINED IN SUBROUTINE 
*                  SETIBIT . EACH COUNT IS A 6-BIT VALUE. 
*         IBY    - (64)/COMMON BLOCK/AREA TO HOLD THE PARSED DATA 
*                  FIELD BIT COUNT IN RIGHT-JUSTIFIED.
*         NIBY   - (1)/COMMON BLOCK/HOLDS INDEX VALUE TO SELECT 
*                  WORD IN ARRAY IBY. 
*                  NIBY IS INITIALLY SET IN SUBROUTINE SETFLDS. 
* 
*         CALLED BY 
*         --------- 
*         SETFLDS 
* 
      COMMON /PARSE/ IBIT(72,3), IBY(64), ICOMBIT(2)
* 
      DO 100 K1 = 1,10
      JWORD = SHIFT (JWORD,6) 
      IT = JWORD .AND. O"77"
      IF (IT .EQ. 0) GO TO 200
      IBY(NIBY) = IT
  100 NIBY = NIBY + 1 
  200 IBY(NIBY) = 0 
      RETURN
      END 
      BLOCK DATA SETIBIT
* 
**        .... IBIT AND ICOMBIT ARRAYS .... 
* 
*         DEFINE THE VARIOUS FIELD FORMATS (BIT-STRINGS)
*         OF THE VARIOUS RECORD TYPES.
* 
*         ICOMBIT DEFINES THE FIRST THREE WORDS, COMMON TO EVERY RECORD 
* 
*         IBIT IS USED TO DEFINE  THE REMAINING WORDS.
*         THE FIRST SUBSCRIPT OF IBIT CORRESPONDS TO A RECORD CODE. 
*         UP TO 3 WORDS ARE USED TO SUPPLY THE FIELDS BIT COUNT . 
* 
*         RECORDS ARE DEFINED BY A STRING OF BIT COUNTS.
*         A BIT COUNT IS A 6-BIT QUANTITY, SPECIFYING THE FIELD SIZE. 
*         A ZERO BYTE TERMINATES THE FIELD DEFINITION 
* 
*         BIT COUNTS ARE PACKED, 10 PER WORD IN IBIT, 
*         STARTING IN UPPER POSITION. 
*         THE DEFINITION IS PERFORMED BY MEANS OF DATA STATEMENTS,
*         IN IBIT AND ICOMBIT.
* 
*              ?-- RECORD TYPE    ? -- BIT COUNTS ----- ? 
*         IBIT(N,1)   /FIELD-01/FIELD-02/----------/FIELD-10/ 
*         IBIT(N,2)   /FIELD-11/FIELD-12/----------/FIELD-20/ 
*         IBIT(N,3)   /FIELD-21/FIELD-22/----------/FIELD-30/ 
*         IBIT(N,4)   /FIELD-31/FIELD-32/----------/FIELD-40/ 
  
      COMMON /PARSE/ IBIT(72,3), IBY(64), ICOMBIT(2)
  
  
*     ALL RECORD TYPES
  
      DATA ICOMBIT(1) / O"11 11 06 03 06 06 11 14 06 06" /
      DATA ICOMBIT(2) / O"06 06 06 06 14 01 13 60 14 00" /
  
*         RECORD TYPE 01    ** SYSTEM /CONTROLWARE MESSAGES **
  
      DATA (IBIT(1,K),K=1,3,1) /
     .O"36 36 30 06 36 74 74 74 00 00",  O"0",  O"0"  / 
  
*         RECORD TYPE 02    ** BETA-A SCR ENTRY **
  
      DATA (IBIT(2,K),K=1,3,1) /
     .O"02 05 01 04 10 01 10 02 01 04", 
     .O"14 04 10 07 05 04 12 26 14 10", 
     .O"04 22 06 10 20 30 14 00 00 00"/ 
  
*         RECORD TYPE 03   ** STATUS-CONTROL REG **   RT = 03B
  
      DATA (IBIT(3,K),K=1,3,1) /
     .O"02 05 15 01 47 04 01 03 64 34", 
     .O"02 01 02 03 10 20 30 30 14 17", 
     .O"00 00 00 00 00 00 00 00 00 00" /
  
*         RECORD TYPE 04   **  MISC. SYSTEM MESSAGES  **
  
      DATA (IBIT(4,K),K=1,3) /
     .  O"14 14 14 14 14 00 00 00 00 00",  O"0",  O"0"   /
  
*         RECORD TYPE 05   ** CHANNEL MESSAGES ** 
  
      DATA (IBIT(5,K),K=1,3,1) /
     .O"14 14 14 14 11 03 60 14 14 14", 
     .O"14 14 14 14 14 14 14 14 14 14", 
     .O"14 14 14 00 00 00 00 00 00 00"/ 
  
*         RECORD TYPE 06   ** BETA-B SCR ENTRY ** 
  
      DATA (IBIT(6,K),K=1,3,1) /
     .O"02 05 01 04 10 01 10 02 01 04", 
     .O"14 04 10 07 05 04 12 26 14 10", 
     .O"04 22 06 10 20 30 14 00 00 00"/ 
  
*         RECORD TYPE 07   ** BETA-C SCR ENTRY ** 
  
      DATA (IBIT(7,K),K=1,3,1) /
     .O"02 05 01 04 10 01 10 02 01 04", 
     .O"14 04 10 07 05 04 12 26 14 10", 
     .O"04 22 06 10 20 30 30 14 00 00"/ 
  
*         RECORD TYPE 10   ** DIAGNOSTICS **          RT = 10B
  
      DATA (IBIT(O"10",K),K=1,3) /
     .  O"22 22 30 74 74 74 74 00 00 00",  O"0",  O"0"   /
  
*         RECORD TYPE 11   ** MAINFRAME MISC. **     RT = 11B 
  
      DATA (IBIT(O"11",K),K=1,3) /
     .  O"14 20 20 20 14 20 20 20 14 20", 
     .  O"20 20 14 20 20 20 14 20 20 20", 
     .  O"00 00 00 00 00 00 00 00 00 00"/ 
  
*         RECORD TYPE 12B   ** C176 CM SECDED UNIQUE ID AND COUNT **
  
      DATA (IBIT(O"12",K),K=1,3) /
     .  O"44 30 44 30 44 30 44 30 44 30",  O"0",  O"0"   /
  
*         RECORD TYPE 13  ** M1/M1CR/M2/M3/M3CR **    RT = 13B
  
      DATA (IBIT(O"13",K),K=1,3) /
     .  O"20 20 20 14 20 20 20 14 20 20", 
     .  O"20 14 20 20 20 14 04 10 04 10", 
     .  O"04 10 04 10 14 00 00 00 00 00"/ 
  
*         RECORD TYPE 14    ** SECDED UNIQUE ID AND COUNTS ** 
  
      DATA (IBIT(O"14",K),K=1,3) /
     .  O"44304430443044304430",
     .  O"00000000000000000000",
     .  O"00000000000000000000"/
  
*         RECORD TYPE 15    ** LCME SECDED UNIQUE ID AND COUNTS **
  
      DATA (IBIT(O"15",K),K=1,3) /
     .  O"44304430443044304430",
     .  O"00000000000000000000",
     .  O"00000000000000000000"/
* 
  
*         RECORD TYPE 16   ** 865 SECDED ID AND COUNTS ** 
  
      DATA (IBIT(O"16",K),K=1,3) /
     .  O"44304430443044304430",
     .  O"00000000000000000000",
     .  O"00000000000000000000"/
  
*         RECORD TYPE 17   ** 875 SECDED ID AND COUNTS ** 
  
      DATA (IBIT(O"17",K),K=1,3) /
     .  O"44304430443044304430",
     .  O"00000000000000000000",
     .  O"00000000000000000000"/
  
*         RECORD TYPE 20   ** 405  **                 RT = 20B
  
      DATA (IBIT(O"20",K),K=1,3) /
     .O"14141414141414000000",
     .O"00000000000000000000",
     .O"00000000000000000000"/
  
*         RECORD TYPE 21   ** 415  **                 RT = 21B
  
      DATA (IBIT(O"21",K),K=1,3) /
     .O"14141414141414000000",
     .O"00000000000000000000",
     .O"00000000000000000000"/
  
*         RECODE TYPE 22   ** S1, S2 PROCESSOR **     RT = 22B
  
      DATA (IBIT(O"22",K),K=1,3) /
     .    O"20 20 20 14 20 20 20 14 20 20", 
     .    O"20 14 20 20 20 14 04 10 04 10", 
     .    O"04 10 04 10 14 00 00 00 00 00"/ 
  
*         RECORD TYPE 23   ** 512  **                 RT = 23B
  
      DATA (IBIT(O"23",K),K=1,3) /
     .O"14141414141414000000",
     .O"00000000000000000000",
     .O"00000000000000000000"/
  
*         RECORD TYPE 24   ** 580 AND NIP **          RT = 24B
  
      DATA (IBIT(O"24",K),K=1,3) /
     .O"14141414141414000000",
     .O"00000000000000000000",
     .O"00000000000000000000"/
  
*         RECORD TYPE 25   ** 865 MAINTENANCE REGISTER ** 
  
      DATA (IBIT(O"25",K),K=1,3) /
     .  O"02051501470401036434",
     .  O"02010203102030000000",
     .  O"00000000000000000000"/
  
*         RECORD TYPE 26   ** 875 MAINTENANCE REGISTER ** 
  
      DATA (IBIT(O"26",K),K=1,3) /
     .  O"02051501470401036434",
     .  O"02020103102030000000",
     .  O"00000000000000000000"/
  
*         RECORD TYPE 27  ** IOU - I1 AND I2 **        RT = 27B 
  
      DATA (IBIT(O"27",K),K=1,3) /
     .  O"20 20 20 14 20 20 20 14 20 20", 
     .  O"20 14 20 20 20 14 04 10 04 10", 
     .  O"04 10 04 10 14 00 00 00 00 00"/ 
  
*         RECORD TYPE 30   ** ISMT **                  RT = 30B 
  
      DATA(IBIT(O"30",K),K=1,3)/
     .  O"14 14 14 30 44 14 11 02 01 14", 
     .  O"14 14 10 10 10 10 10 10 10 10", 
     .  O"10 14 10 10 10 10 10 10 14 00"/ 
  
*         RECORD TYPE 31   ** 657 **                  RT = 31B
  
      DATA (IBIT(O"31",K),K=1,3) /
     .  O"14141430441411020114",O"14141414141414141414",O"14141414000000
     .000000"/
  
*         RECORD TYPE 32   ** 659 **                  RT = 32B
  
      DATA (IBIT(O"32",K),K=1,3) /
     .  O"14141430441411020114",O"14141414141414141414",O"14141414000000
     .000000"/
  
*         RECORD TYPE 33   ** FSC **                  RT = 33B
  
      DATA (IBIT(O"33",K),K=1,3) /
     .  O"14 14 14 30 44 14 11 02 01 14", 
     .  O"14 14 10 10 10 10 10 10 10 10", 
     .  O"10 14 10 10 10 10 10 10 14 00"  / 
  
*         RECORD TYPE 34   ** 667 **                  RT = 34B
  
      DATA (IBIT(O"34",K),K=1,3) /
     .  O"14141430441411020114",O"14141414141414141414",
     .    O"14141414000000000000"   / 
  
*         RECORD TYPE 35   ** 669 **                  RT = 35B
  
      DATA (IBIT(O"35",K),K=1,3) /
     .  O"14141430441411020114",O"14141414141414141414",
     .    O"14141414000000000000" / 
  
*      RECORD TYPE 36   ** 677 ** 
  
      DATA (IBIT(O"36",K),K=1,3) /
     .  O"14141430441411020114", O"14141414141414141414", 
     .    O"14141414141414141414"    /
  
*     RECORD TYPE 37  ** 679 ** 
  
      DATA (IBIT (O"37",K), K=1,3) /
     .  O"14 14 14 30 44 14 11 02 01 14", 
     .  O"14 14 14 14 14 14 14 14 14 14", 
     .  O"14 14 14 14 14 14 14 14 14 14"  / 
  
*         RECORD TYPE 40   ** ISD ADAPTER **          RT = 40B
  
      DATA (IBIT(O"40",K),K=1,3) /
     .  O"14141414110360143014",O"14141414141414141414",O"14140000000000
     .000000"/
  
*         RECORD TYPE 41   ** ISD CONTROL MODULE **   RT = 41B
  
      DATA (IBIT(O"41",K),K=1,3) /
     .  O"14141414110360143014",O"14141414141414141414",O"14140000000000
     .000000"/
  
*         RECORD TYPE 42   ** ISD DRIVE **            RT = 42B
  
      DATA (IBIT(O"42",K),K=1,3) /
     .  O"14141414110360143014",O"14141414141414141414",O"14140000000000
     .000000"/
  
*         RECORD TYPE 43   ** 841 **                  RT = 43B
  
      DATA (IBIT(O"43",K),K=1,3) /
     .  O"14141414130160143030",O"00000000000000000000",O"00000000000000
     .000000"/
  
*          RECORD TYPE 44  ** 844, 885/FMD, CDSS2 **   RT = 44B 
  
      DATA (IBIT(O"44",K),K=1,3) /
     .  O"14 14 14 14 11 03 60 14 30 14", 
     .  O"14 14 14 14 14 14 14 14 14 14", 
     .  O"14 14 00 00 00 00 00 00 00 00"  / 
  
*         RECORD TYPE 45   ** ISD DIAGNOSICS **       RT = 45B
  
      DATA (IBIT(O"45",K),K=1,3) /
     .  O"14141414110360143014",O"14141414141414141414",O"14140000000000
     .000000"/
  
*         RECORD TYPE 46    *** 7165/895 ***          RT = 46B
  
      DATA (IBIT(O"46",K),K=1,3) /
     .  O"14 14 14 14 11 03 60 14 30 14", 
     .  O"10 10 10 10 10 10 10 10 10 14", 
     .  O"10 10 10 10 10 10 14 00 00 00"  / 
*         RECORD TYPE 47   ** ACS/CTS ERRORS **     RT = 47B
  
      DATA (IBIT(O"47",K),K=1,3) /
     .  O"74 74 74 74 74 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00"  / 
  
  
*     RECORD TYPE 50   *** 819 HCD ***
  
      DATA (IBIT(O"50",K),K=1,3) /
     .  O"14141430141414141414",
     .  O"14141414141414141414",
     .  O"14301400000000000000"  /
  
*                 RECORD TYPE 51  ** FSC DISK **      RT = 51B
  
      DATA (IBIT(O"51",K),K=1,3) /
     .  O"14 14 14 14 11 03 60 14 30 14", 
     .  O"10 10 10 10 10 10 10 10 10 14", 
     .  O"10 10 10 10 10 10 14 00 00 00"  / 
  
*         RECORD TYPE 52   ** DEMA  **                RT = 52B
  
      DATA (IBIT(O"52",K),K=1,3) /
     .  O"14141414110360143014",O"14141414141414141414",O"14140000000000
     .000000"/
  
*         RECORD TYPE 53  ** HYDRA 887 **           RT = 53B
  
      DATA (IBIT(O"53",K),K=1,3) /
     .  O"74 74 74 74 74 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00" /
  
*         RECORD TYPE 54  ** XMD3 9853 , DAS **     RT = 54B
  
      DATA (IBIT(O"54",K),K=1,3) /
     .  O"74 74 74 74 74 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00" /
  
*         RECORD TYPE 55   ** CMTS **               RT = 55B
  
      DATA (IBIT(O"55",K),K=1,3) /
     .  O"14 14 14 30 44 14 11 02 01 14", 
     .  O"14 14 10 10 10 10 10 10 10 10", 
     .  O"10 14 10 10 10 10 10 10 14 00"  / 
  
*          RECORD TYPE 56  ** 2550 TERMINAL MESSAGES ** 
  
      DATA (IBIT(O"56",K),K=1,3) /
     .  O"14202020142020201420",O"20201420202000000000",O"00000000000000
     .000000"/
  
*          RECORD TYPE 57  ** 2550 NAM(CCP 3.0) MESSAGES ** 
  
      DATA (IBIT(O"57",K),K=1,3) /
     .  O"14202020142020201420",O"20201420202000000000",O"00000000000000
     .000000"/
  
*         RECORD TYPE  60  ** 2550 MULTI-HOST MESSAGE **
  
      DATA (IBIT(O"60",K),K=1,3) /
     .  O"14202020142020201420",O"20201420202000000000",O"00000000000000
     .000000"/
  
*         RECORD TYPE  61  ** MUX ERRORS  **          RT = 61B
  
      DATA (IBIT(O"61",K),K=1,3) /
     .  O"14000000000000000000",O"00000000000000000000",O"00000000000000
     .000000"/
  
*               *** TYPE 62  WIDE BAND MUX  *** 
  
      DATA (IBIT(O"62",K),K=1,3) / O"14141414141414141414", 
     .  O"14141414141414141414", O"14141414140000000000"  / 
  
* 
*         RECORD TYPE 63   ** CYBERPLUS **               RT = 63B 
* 
      DATA (IBIT(O"63",K),K=1,3)/ 
     .  O"74 74 74 74 74 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00"/ 
  
* 
*         RECORD TYPE 64   ** OPTICAL DISK **            RT = 64B 
* 
      DATA (IBIT(O"64",K),K=1,3)/ 
     .  O"74 74 74 74 74 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00"/ 
*               *** TYPE 65   MSFS ERRORS 
  
      DATA (IBIT(O"65",K), K=1,2,1) / 
     .  O"14141414141414141414",O"14105074740000000000"        /
  
*               *** TYPE 66B MASSTOR 7990 ERROR AND USAGE 
  
      DATA(IBIT(O"66",K),K=1,3,1)/
     .O"20 20 20 14 04 20 20 20 10 10", 
     .O"20 20 20 04 14 20 20 20 20 20", 
     .O"20 14 00 00 00 00 00 00 00 00"/ 
  
*               *** TYPE 67B MASSTOR CCC ERROR
  
      DATA(IBIT(O"67",K),K=1,3,1)/
     .O"14 14 14 10 10 10 10 10 10 10", 
     .O"10 10 14 14 10 10 10 10 10 10", 
     .O"10 10 10 10 10 10 14 14 14 44"/ 
  
*               *** TYPE 70  ECS/CPU ERROR
  
      DATA (IBIT(O"70",K),K=1,2) / O"14141414110102302222", 
     ,  O"30301474740000000000"  /
  
*               *** TYPE 71  ECS/DDP ERROR
  
      DATA (IBIT(O"71",K),K=1,2) / O"14141414110102302222", 
     ,  O"30301474740000000000"  /
  
*       *** TYPE 72 ESM ERRORS ***              RT = 72B
  
      DATA (IBIT(O"72",K),K=1,3) /
     .  O"14141414141414141414",
     .  O"14141414141414141414",
     .  O"14141414140000000000" / 
  
*            *** RECORD TYPE 73B - MAP III/IV ERROR *** 
  
      DATA ( IBIT(O"73",K),K=1,2) / O"14141414141414141414", 0 /
  
*            *** RECORD TYPE 74B - LCN USAGE/DETAIL STATUS MESSAGE ***
  
      DATA (IBIT(O"74",K),K=1,3) /
     .  O"14 14 06 06 30 14 06 06 06 14", 
     .  O"22 10 10 10 10 10 10 14 24 40", 
     .  O"10 10 20 20 20 04 00 00 00 00"  / 
  
*            *** RECORD TYPE 75B - LCN ERROR LOG ENTRY ***
  
      DATA (IBIT(O"75",K),K=1,3) /
     .  O"14 14 06 06 30 14 06 06 06 14", 
     .  O"22 10 10 10 10 10 10 10 04 04", 
     .  O"10 10 10 10 20 10 10 10 10 00"  / 
  
*            *** RECORD TYPE 76B - LCN NAD MESSAGE ***
  
      DATA (IBIT(O"76",K),K=1,3) /
     .  O"14 14 06 06 30 14 06 06 06 14", 
     .  O"22 14 14 14 10 04 04 10 14 14", 
     .  O"14 14 14 20 20 20 14 00 00 00"  / 
  
* 
*         RECORD TYPE 102  ** S3 PROCESSOR **         RT = 102B 
* 
      DATA (IBIT(O"102",K),K=1,3)/
     .O"20202014202020142020",
     .O"20142020201404100410",
     .O"04100410140000000000"/
* 
* 
*         RECORD TYPE 103  ** THETA (990) PROCESSOR **   RT = 103B
* 
      DATA (IBIT(O"103",K),K=1,3)/
     .O"20 20 20 14 20 20 20 14 20 20", 
     .O"20 14 20 20 20 14 04 10 04 10", 
     .O"04 10 04 10 14 00 00 00 00 00"/ 
* 
*         RECORD TYPE 104  ** THETA (990) MEMORY **      RT = 104B
* 
      DATA (IBIT(O"104",K),K=1,3)/
     .  O"20 20 10 10 14 20 20 10 10 14", 
     .  O"20 20 10 10 14 20 20 10 10 14", 
     .  O"04 10 04 10 04 10 04 10 14 00"/ 
* 
*         RECORD TYPE 105  ** THETA (990) MEMORY/SECDED  RT = 105B
* 
      DATA (IBIT(O"105",K),K=1,3)/
     .  O"14 40 20 14 40 20 14 40 20 14", 
     .  O"40 20 14 30 14 14 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00"/ 
* 
*         RECORD TYPE 106  ** M1/M1CR/M2/M3/M3CR SECDED  RT = 106B
* 
      DATA (IBIT(O"106",K),K=1,3)/
     .  O"14 40 20 14 40 20 14 40 20 14", 
     .  O"40 20 14 30 14 14 00 00 00 00", 
     .  O"00 00 00 00 00 00 00 00 00 00"/ 
  
* 
*         RECORD TYPE 107  ** I4 **                      RT = 107B
* 
      DATA (IBIT(O"107",K),K=1,3)/
     .  O"20 20 20 14 20 20 20 14 20 20", 
     .  O"20 14 20 20 20 14 04 10 04 10", 
     .  O"04 10 04 10 14 00 00 00 00 00"/ 
  
* 
*         RECORD TYPE 110  ** EPM **  (FOR THE PURPOSE OF UNPACKING ONLY) 
* 
      DATA (IBIT(O"110",K),K=1,3)/
     .O"10 10 10 10 10 10 10 04 10 10", 
     .O"10 10 10 10 10 04 10 10 10 10", 
     .O"10 10 10 04 10 10 10 10 34 74"/ 
      END 
      OVCAP.
      SUBROUTINE RMCLOSE
* 
**       DESCRIPTION
*        -----------
*        SUBROUTINE RMCLOSE COMPLETES PROCESSING OF FILES ESTABLISHED 
*        AND UTILIZED BY DIRECT CALLS TO RECORD MANAGER INTERFACE.
*        RMCLOSE IS CALLED FROM HPA MAIN PROGRAM PRIOR TO NORMAL EXITING
* 
*CALL HPACOM1 
  
*     CLOSE AND REWIND THE FILES
      CALL CLOSEM (FITTBL(1,1),L"R")
      CALL CLOSEM (FITTBL(1,2),L"R")
      CALL CLOSEM (FITTBL(1,3),L"R")
      CALL CLOSEM (FITTBL(1,4),L"R")
      CALL CLOSEM (FITTBL(1,10),L"R") 
      CALL CLOSEM (FITTBL(1,11),L"R") 
      CALL CLOSEM (FITTBL(1,12),L"R") 
*IF DEF,HPSORT
  
*     CLOSE AND REWIND HPSORT FILES 
      CALL CLOSEM (FITTBL(1,15),L"R") 
      CALL CLOSEM (FITTBL(1,16),L"R") 
*ENDIF
  
*     RETURN TO HPA 
      RETURN
      END 
      OVCAP.
      SUBROUTINE RMOPENX (PASS) 
  
*CALL HPACOM1 
  
      IF (PASS .EQ. 1) GO TO 100
  
*     OPEN AND REWIND EACH FILE 
      CALL OPENM (FITTBL(1,1),L"INPUT",L"R")
      CALL OPENM (FITTBL(1,2),L"I-O",L"R")
      CALL OPENM (FITTBL(1,3),L"I-O",L"R")
      CALL OPENM (FITTBL(1,4),L"I-O",L"R")
      CALL OPENM (FITTBL(1,10),L"I-O",L"R") 
  
*     INITIALIZE SCRATCH FILES
      FILEP(SCR1) = 2HON
  
      CALL ENDFILE (FITTBL(1,10)) 
      CALL REWND (FITTBL(1,10)) 
*IF DEF,HPSORT
  
*     OPEN FILES IF HPSORT DEFINED
*     TAPE14 IS FTN IO RANDOM ACCESS MS FILE IN INIDAT2 
      CALL OPENM (FITTBL(1,15),L"I-O",L"R") 
      CALL OPENM (FITTBL(1,16),L"I-O",L"R") 
  
      FILEP(14) = 2HON
      FILEP(15) = 2HON
      FILEP(16) = 2HON
*ENDIF
  
      GO TO 900 
  
  100 CALL OPENM (FITTBL(1,11),L"I-O",L"R") 
      CALL OPENM (FITTBL(1,12),L"I-O",L"R") 
  
      FILEP(SCR2) = 2HON
      FILEP(SCR3) = 2HON
  
      CALL ENDFILE (FITTBL(1,11)) 
      CALL ENDFILE (FITTBL(1,12)) 
  
      CALL REWND (FITTBL(1,11)) 
      CALL REWND (FITTBL(1,12)) 
  
*     RETURN TO SETPAR1 
  900 CONTINUE
      RETURN
      END 
      OVCAP.
      SUBROUTINE RMSKIP (FILE)
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE RMSKIP SKIPS A FILE ON THE SPECIFIED FILE. 
* 
*         ENTRY CONDITION 
*         --------------- 
*         FILE = FILE SPECIFIED FOR SKIPPING A FILE.
* 
*         EXIT CONDITION
*         --------------
*         FEOF(FILE) = SET TO 2HNO (CLEARED) AFTER SKIPPING A FILE. 
*                      SET TO 3HYES IF FILE NOT PRESENT OR INVALID
*                              FILEP(FILE) NAME.
*         ERROR MESSAGE PRINTED AND EXIT CALLED IF INVALID FILE NUMBER. 
* 
*CALL HPACOM1 
  
      DIMENSION IBUFFER (64)
  
*     CHECK IF FILE PRESENT 
      IF (FILEP(FILE) .EQ. 3HOFF) GO TO 800 
  
*     CHECK FOR VALID FILE
      NAMECHK = AND (SHIFT(FILEP(FILE),6), O"77") 
      IF (NAMECHK .GE. R"0") GO TO 800
      IF ((FILE .GE. 1) .AND. (FILE .LE. 16)) GO TO 100 
      PRINT 50, FILE
   50 FORMAT (1X,' RMSKIP ... ILLEGAL FILE FOR SKIP COMMAND ',I2) 
      CALL EXIT 
  
*     SKIP A FILE 
  100 CALL GET (FITTBL(1,FILE),IBUFFER(1))
      FP = IFETCH (FITTBL(1,FILE),L"FP")
      IF (FP .EQ. O"20") GO TO 100
      FEOF(FILE) = 2HNO 
      GO TO 900 
  
*     SET EOF FLAG IF FILE NOT PRESENT OR INVALID FILE NAME 
  800 FEOF(FILE) = 3HYES
  
*     RETURN TO CALLING ROUTINE 
  900 RETURN
      END 
