*DECK,HPA1
      OVCAP.
      SUBROUTINE HPA1 
* 
**           DESCRIPTION
*            -------------
*          HPA1 - CONTROL PROGRAM TO CALL PARAMETER 
*                 PROCESSOR OVERLAYS
*                    AND INPUT PROCESS ROUTINES.
* 
*             CALLED BY 
*             ----------- 
*             HPA - MAIN CONTROL
* 
*             SUBROUTINES CALLED
*             --------------------- 
*CALL,HPACOM1 
  
*            INITIALIZE HPA FILES, FLAGS, AND DATA AREA 
      CP = SECOND ()
      CALL INIDAT1
  
*            CRACK CONTROL CARD PARAMETERS, SET FLAGS 
*              AND FILE NAMES 
      CALL XOVCAP ('SETPAR1',0,0) 
      CALL UOVCAP ('SETPAR1') 
      IF (FLAGS(2) .EQ. 5HERROR) GO TO 100
  
      IF(FROG(6).NE.L"T") GO TO 20
      PRINT 10,CP                                                        HPA0319
   10 FORMAT ( ' ENTER HPA1 , SECOND = ',F10.3) 
   20 CONTINUE                                                           HPA0319
  
*        TEST INPUT FILES TO VERIFY PRESENCE OF OLDHF AND RSEF FILES
      CALL INPTST1
  
*        CALL FOR SEF EDIT IF ( HR ) PARA4ETER
      IF (FROP(1,1,6) .NE. 3HOFF) THEN
         CALL XOVCAP ('RDHIS1',0,0) 
         CALL UOVCAP ('RDHIS1') 
      ENDIF 
  
  100 CONTINUE
       END
      SUBROUTINE INIDAT1
* 
**          DESCRIPTION 
*           ------------
*           INIDAT1 - INITIALIZE ARRAYS, FLAGS, AND CONSTANTS UPON
*                    INITIAL ENTRY TO HPA.
* 
*            ENTRY CONDITIONS 
*            ---------------- 
*            HPA NEEDS TO BE INITIALIZED FOR EXECUTION. 
* 
*            EXIT CONDITIONS
*            ---------------
*            PRESET ALL DATA AREA FOR EXECUTION OF PROGRAM
* 
*            DATA AREAS 
*            ---------- 
*            COMMON AREAS REQUIRING PRESET DATA 
* 
*            CALLED BY
*            ---------
*            HPA  MAIN PROGRAM, UPON ENTRY. 
* 
*CALL,HPACOM1 
  
* 
*         DEFAULT FILE NAMES
  
      PARFN(1) = L"OLDHF" 
      PARFN(2) = L"NEWHF" 
      PARFN(3) = L"SEF" 
      PARFN(4) = L"INPUT" 
      PARFN(5) = L"OUTPUT"
  
*         SET CONSTANTS 
  
      DO 5 K = 1,30 
    5 FLAGS(K) = 0
      TWIC = 0
       IPAGE = 1
      FLAGS(2) = 1H 
      FLAGS(12) = 3HOFF 
  
*         SET MAXIMUM RTY AND MTY 
      RTYMAX = O"110" 
      MTYMAX=1000 
*          FILE ASSIGNMENTS 
       OLD    = 1 
       NEW    = 2 
      SCR1 = 10 
      SCR2 = 11 
      SCR3 = 12 
      RSEF = 3
      SEF = 4 
  
      DO 10 K = 1,16                                                     HPA0310
   10 FEOF(K) = 2HNO
* 
      DO 15 K = 1,20                                                     HPA0376
   15 FROG(K) = 3HOFF 
      DO 20 K = 1,16
   20 FILEP(K) = 3HOFF
  
*        DEFAULT FOR TYPE OF ORDINAL
      TYPORD = 3HEST
  
*         DEFAULT FOR NUMBER PRINT LINES PER PAGE                       000290
      PLF = 56                                                          000300
*      DEFAULT FOR MAXIMUM DETAILS
      FROG(12) = 45 
  
*     DEFAULT FOR VSN MAXIUM DETAIL LIMIT 
      FROG(17) = 5
  
*       DEFAULT NO. OF RECORDS(DAYS) ON HISTORY 
      FROG(9) = 31
  
*     TURN ON RSEF, SEF AND NEW FILES 
      FILEP(RSEF) = 2HON
      FILEP(SEF) = 2HON 
      FILEP(NEW) = 2HON 
  
      RETURN
      END 
      SUBROUTINE INPTST1
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE INPTST1 PERFORMS A TEST ON THE OLDHF AND SEF INPUT 
*         FILES TO VERIFY THEIR PRESENCE.  IF A FILE IS UNAVAILABLE,
*         THE FILEP ARRAY IS TURNED OFF AND A MESSAGE IS PRINTED; A 
*         FLAG IS SET TO PREVENT SORTING OF AN EMPTY SEF.  IF BOTH
*         FILES ARE UNAVAILABLE, THE ERROR FLAG IS SET TO ABORT THE 
*         JOB.  THESE TESTS ARE OMITTED WHEN THE HR (HISTORY READ)
*         PARAMETER IS REQUESTED. 
*         EXCEPTION: ERROR CODE REPORT CAN BE OBTAINED W/O OLDHF + SEF. 
*         EXCEPTION: SHR CONFIG TABLE CAN BE INITIALIZED W/O SEF + OLDHF
* 
*         MESSAGES
*         --------
*         ----- HISTORY FILE NOT AVAILABLE ----- (INPTST1)
*         ----- SEF FILE NOT AVAILABLE ----- (INPTST1)
* 
*         CALLED BY 
*         --------- 
*         HPA1 CONTROL PROGRAM
* 
*         CALLS 
*         ----- 
*         RMREAD - READS A RECORD FROM THE FILE 
*CALL,HPACOM1 
  
*        OMIT CHECKING FOR OLDHF AND RSEF IF HR (HISTORY READ) PARAM. 
      IF (FROP(1,1,6) .NE. 3HOFF) GO TO 500 
  
*        CHECK FOR PRESENCE OF OLDHF
      CALL RMREAD (OLD,NFLD,LENGTH) 
      IF (FEOF(OLD) .NE. 3HYES) GO TO 200 
      FILEP(OLD) = 3HOFF
      PRINT 100 
  100 FORMAT (//,' ----- HISTORY FILE NOT AVAILABLE ----- (INPTST1)') 
  
*        CHECK FOR PRESENCE OF RSEF 
  200 CALL RMREAD (RSEF,NFLD,LENGTH)
      IF (FEOF(RSEF) .NE. 3HYES) GO TO 500
      FP = IFETCH(FITTBL(1,RSEF),L"FP") 
      IF(FP .LT. O"100") GO TO 200
      FILEP(RSEF) = FILEP(SEF) = 3HOFF
      PRINT 300 
  300 FORMAT (//,' ----- SEF FILE NOT AVAILABLE ----- (INPTST1)') 
  
*        SET FLAG TO PREVENT SORTING OF EMPTY SEF FILE
      FLAGS(1) = 7H NOSORT
  
*        EXIT IF BOTH OLDHF AND RSEF UNAVAILABLE
      IF (FILEP(OLD).EQ.3HOFF) FLAGS(2) = 5HERROR 
  
*     ENABLE ERROR CODE REPORT W/O OLDHF AND SEF FILES
      IF (FROG(4) .EQ. 2HON) FLAGS(2) = 0 
* 
*         ENABLE INITIAL CONFIGURATION BUILD W/O SEF OR OLDHF 
      IF (FROG(16) .EQ. 2HON ) FLAGS(2) = 0 
  
  500 CONTINUE
      RETURN
      END 
      OVCAP.
      SUBROUTINE RDHIS1 
**         ROUTINE TO DO SELECTIVE READ OF
*          HISTORY FILE DATA, WHEN PROCESSING 
*          (HR) PARAMETER.
  
*          ENTRY CONDITIONS 
*          ---------------------- 
  
*          FROP (X,1,6) IS DEVICE TYPE OR HUID OF DATA TO BE RETRIEVED
*                       FROM HISTORY FILE 
*          FROP (X,2,6) IS EST, EST/UN OR HUID VALUE TO QUALIFY DEVICE
*                       TYPE OR HUID SPECIFIED IN FROP (X,1,6)
*                                                                        R2FHWMO
*          FROP (1,1,8) = HW PARAMETER                                   R2FHWMO
*               (1,2,8) = FIRST DATE TO BE COPIED FROM OLDHF TO SEF      R2FHWMO
*               (1,3,8) = LAST DATE TO BE COPIED FROM OLDHF TO SEF       R2FHWMO
*                                                                        R2FHWMO
* 
*CALL,HPACOM1 
      IF (FILEP(OLD) .EQ. 3HOFF) GO TO 810                               HPA0331
      CALL RMREWND (RSEF) 
      CALL RMREWND (OLD)
      RSEFCNT = 0                                                        R2FHWMO
                                                                         R2FHWMO
*     SKIP OLDHF FILE (STATISTICS AT START / TO NEXT DAY FOR HW)
   50 CALL XOVCAP ('RMSKIP',OLD,0)
      CALL UOVCAP ('RMSKIP')
      CALL RMREAD (OLD,SEFREC,LENGTH) 
      IF (FEOF(OLD) .EQ. 3HYES) GO TO 810 
      GO TO 110                                                          HPA402S
* 
  100 CALL RMREAD (OLD,SEFREC,LENGTH) 
      IF (FEOF(OLD) .EQ. 3HYES) GO TO 600 
  110 IFLD(FDT) = SEFREC(2) .AND. O"3777" 
      IFLD(FEST) = SHIFT(SEFREC(2),-12) .AND.O"7777"
      IDATE = SHIFT(SEFREC(1),-12) .AND. O"77777" 
      IFLD(FUN) = SHIFT(SEFREC(1),-27) .AND. O"77"
      IFLD(FCON) = SHIFT(SEFREC(1),-33) .AND. O"7"
      IFLD(FHUID) = SEFREC(3) .AND. O"7777" 
      IF (FROP(1,1,8).NE.L"HW") GO TO 140 
      IF (FROP(1,3,8) .GT. IDATE) GO TO 800                              R2FHWMO
      IF (FROP(1,2,8) .LT. IDATE) GO TO 50                               R2FHWMO
* 
  140 CONTINUE                                                           R2FHWMO
      IF (FROP(1,1,6) .EQ. 3HALL) GO TO 200 
      CALL SETREF (6,FLAG)
      IF (FLAG .NE. 2HON ) GO TO 100
  
  200 CALL RMWRITE (RSEF,SEFREC,8)
      RSEFCNT = RSEFCNT + 1                                              R2FHWMO
      GO TO 100 
  
  600 CALL RMREAD (OLD,SEFREC,LENGTH) 
      IF (FEOF(OLD) .EQ. 3HYES) GO TO 750 
      IF ((FROP(1,1,8).NE.L"HW") .OR. (FROP(1,3,8).LT.IDATE)) GO TO 110 
                                                                         R2FHWMO
  700 CALL RMFILEM (RSEF) 
      CALL RMFILEM (RSEF) 
      CALL RMREWND (RSEF) 
      CALL RMREWND (OLD)
      FILEP(OLD)=3HOFF
      FEOF(OLD)=3HYES 
      RETURN
  
  750 IF (RSEFCNT .NE. 0) GO TO 700 
      PRINT 760 
  760 FORMAT (' --- OLDHF DID NOT CONTAIN SPECIFIED SEF DATA TO ',
     .        'EXTRACT ---',/)
      GO TO 820 
  
  800 IF (RSEFCNT .NE. 0) GO TO 700 
      PRINT 805                                                          R2FHWMO
  805 FORMAT (' --- OLDHF DID NOT CONTAIN HW DATES --- ',/) 
      GO TO 820                                                          R2FHWMO
  810 PRINT 811                                                          R2FHWMO
  811 FORMAT (' --- NO OLDHF FOUND FOR HISTORY RETRIEVE --- ',/)
  820 FLAGS(2) = 5HERROR                                                 R2FHWMO
      RETURN
      END 
      OVCAP.
      SUBROUTINE SETPAR1
* 
**        DESCRIPTION 
*         ------------
*         SETPAR - CRACK INPUT PARAMETERS ON HPA CONTROL CARD.
*          PRINT CONTROL CARD ERROR MESSSAGES, IF ANY.
*          SET FILE NAMES AS DEFINED ON CONTROL CARD - CALL PARSET
*          TO SET FILE NAMES IN FETS. 
*          SET REPORT CONTROL AND FILE CONTROL FLAGS, FOR LATER USE 
*          IN REPORT GENERATORS.
* 
*         ENTRY CONDITIONS
*         ----------------
*         INPUT PARAMETER DATA FROM CONTROL CARD HAS BEEN PARSED
*         BY ROUTINE ( PARMS ) AND FIELDS PLACED IN 
*         ARRAY  - IPAR - . 
* 
*         EXIT CONDITIONS 
*         --------------- 
*         DATA FILES ARE DEFINED AND READY FOR USE BY OTHER ROUTINES. 
*         CONTROL CARD IS ACCEPTED, OR ERROR CONDITIONS PRINTED AND 
*         ERROR FLAG SET ( IERR ).
*         FILE NAMES IN USE, AND REPORTS CALLED, ARE PRINTED TO OUTPUT. 
*         APPROPRIATE FLAGS SET FOR CONTROL OF LATER REPORTING ROUTINES.
* 
*         DATA AREAS
*         ----------
*         IPAR - PARAMETERS FROM PROGRAM CALL CARD. 
*            FILEP(10) - FILE USAGE POINTERS
*            FLAGS(24) - VARIOUS PARAMETERS AND FLAGS (SEE ERS) 
*            FROP(8,3,6) - HOLD PARAMETER CALLS FOR DETAIL,ANALYSIS 
*                 STATISTICS,HISTORY,BYPASS,AND EXTENDED DETAIL.
*                 WILL CONTAIN DEVICE TYPES AND EST ORDINALS FOR
*                 UP TO 8 REQUESTS ON EACH REPORT.
*           FROG(20) - HOLD PARAMETER VALUES FOR OTHER MISC. CALLS. 
*         CALLED BY 
*         --------- 
*             HPA1 CONTROL PROGRAM
* 
*         SUBROUTINES CALLED
*         ------------------- 
*         HEADER - PRINT PAGE HEADER ( CONTROL CARD PARAMETERS )
*         PARSET - INITIALIZE I/O FILES ( FETS )
*         IOCT (FUNCTION) - CONVERT DISPLAY INPUT TO OCTAL
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*CALL,HPACOM1 
      DIMENSION FNAM(9) 
*       ************************************************* 
      DIMENSION PARID(36),PRAMT(24) 
*        ********************************************************** 
      CHARACTER*10  F1, F2,  MOVE 
      COMMON /OPEN/  F1, F2,  MOVE(3) 
*        ********************************************************** 
  
  
*          ASSIGN OTHER DEFAULT VALUES
* 
  
  
*         FILE IDENT FOR PRINT
  
      DATA (FNAM(I),I=1,9) / 5HOLDHF,5HNEWHF,4H SEF,5HINPUT,6HOUTPUT, 
     .1H ,1H ,1H ,1H                       /
  
  
      DATA (PARID(I), I=1,36) / 
     .L"H",L"NH",L"SEF",L"I",L"L",L" ", 
     .      L"D",L"S",L"T",L"HR",L"A",L"E",L"M",L"X",L"DX",L"B",L"ST",L"
     .NS",              L"LH",L"MF",L"VSN",L"DR",L"EX",L"SE",L" ",L" ",L
     ."PF",L" ",                  L"VR",L"R",L"HW",L"DSA",L"MMF",L"DATE"
     .,0,0/ 
  
* 
*         SET UP HEADER FOR CONTROL CARD
  
      IPAGE=1 
      IHDR=1
  
*         M7      = MASK FOR UPPER 7 CHAR.
*         PARSIZE = NUMBER OF IDENTS IN PARID ARRAY 
*         PWP     = POINTER FOR STORING IN PRINT LINE 
*         KP      = POINTER TO ( IPAR ) FOR PARAM WORD
*         PEND    = END OF PARAM LIST FLAG
  
      M7=MASK(42) 
      PARSIZE = 34
      PWP=1 
      DO 10 K=1,24
      PRAMT (K) = 1H
   10 PL(K) = 1H
      PL(1)=5H NONE 
      KP=1
      PEND=0
      PRHW2=0 
      FLAGS(24)=3HOFF 
      FROG(6) = 0 
      IFLG = 0
* 
*         PRESET PARAMETER ARRAY FOR DEVICE AND EST CONTROLS
      DO 20 K = 1,8 
      DO 20 K2 = 1,10                                                   000380
      FROP (K,1,K2) = 3HOFF 
      FROP (K,2,K2) = 3HALL 
   20 FROP (K,3,K2) = 3HALL 
  
      FLAGS(1) = 4HSORT 
*         GET PARAMETER WORD FROM (IPAR) AND MATCH WITH 
*         PRESTORED VALUES TO COMPUTE FLAG SETTINGS.
  
  100 WORD=IPAR(KP) 
      RPEST = 0 
      MPAR4 = 0 
      SEPR=WORD.AND.O"77" 
*         IF TERMINATOR 
      IF(WORD.EQ.0)GO TO 900
      IF(SEPR.EQ.O"17") PEND=1
  
*         MPAR  = CURRENT PARAMETER WORD
*         MPAR2 = FOLLOWING PARAMETER WORD IF NEEDED
  
      WORD2=IPAR(KP+1)
      MPAR=WORD.AND.M7
      MPAR2=WORD2.AND.M7
*     TEST IF PARAMETER IS LEGAL FOR UNIT SELECT. 
* 
      IF((MPAR.NE.L"A").AND.(MPAR.NE.L"B").AND.(MPAR.NE.L"D").AND.
     .      (MPAR.NE.L"DX").AND.(MPAR.NE.L"HR").AND.(MPAR.NE.L"ST")) GO 
     .TO 140
      IF(AND(SHIFT(WORD2,36),O"77").EQ.0) GO TO 140 
* IF EST NUMBER HAS ONLY 2 CHRACTERS GO TO 130
      IF(AND(SHIFT(WORD2,42),O"77").EQ.0) GO TO 130 
      MPAR2=WORD2.AND.MASK(30)
      MPAR4=AND(SHIFT(WORD2,42),O"7777")
      GO TO 140 
  130 MPAR2=WORD2.AND.MASK(24)
      MPAR4=AND(SHIFT(WORD2,36),O"7777")
  
*         PARK = PARAMETER IDENT COUNTER
*         FIND PARAMETER MATCH
  
  140 DO 150 PARK = 1, PARSIZE
        IF(MPAR.EQ.PARID(PARK)) GO TO 200 
  150 CONTINUE
  
  160 FLAGS(2) = 5HERROR
      CALL HEADER 
      CALL IBLANK (MPAR)
      PRINT 1000, MPAR
 1000 FORMAT(1X,' UNRECOGNIZED PARAMETER  ( ',A7, 
     .' )  ... HPA RUN ABORT ... ') 
      GO TO 3000
  
*         SETFL = VALUE USED FOR FLAG , (1) OR PARAM CONTENT. 
  
  200 SETFL = 3HALL 
  
*         TEST IF  ( = ) SIGN 
      IF(SEPR.EQ.2) GO TO 205 
      IF(SEPR.EQ.O"54") GO TO 205 
  
*          GO PROCESS PARAMETER 
      GO TO 210 
  
  205 SEPR = 2
      SETFL = MPAR2 
*        TEST FOR PRESENCE OF EST CALL
*        IF FILE NAME PARAM, JUMP 
      IF (PARK .EQ. 7) GO TO 208
      IF (PARK .EQ. 10) GO TO 208 
      IF (PARK .EQ. 11) GO TO 208 
      IF (PARK .EQ. 15) GO TO 208 
      IF (PARK .EQ. 16) GO TO 206 
      IF (PARK .EQ. 17) GO TO 208 
      IF (PARK .EQ. 23) GO TO 208 
      GO TO 210 
  
*       TEST (B) PARAMETER FOR ERROR CODE = (ENNN)
  206 TE = (SHIFT(MPAR2,12)) .AND. O"7777"
*       TEST FOR ( E )
      TE1 = SHIFT (TE,-6) 
      IF (TE1 .NE. R"E") GO TO 208
      TE2 = TE .AND. O"77"
*      TEST FOR ALPHA ( FROM DEVICE TYPE )
      IF (TE2 .LT. O"33") GO TO 208 
      SETFL = 7HERRCODE 
      RPEST=SHIFT(MPAR2,30).AND.O"77777777" 
* 
*          INSURE ERROR CODES ARE 4 DIGITS BY INCLUDING LEADING 
*          ZEROS IF NECESSARY.
* 
      TE = O"33 00 00 00 "
      DO 207 I=1,4
      IF ((RPEST .AND. O"77") .NE. 0) GO TO 210 
 207  RPEST = SHIFT (RPEST,-6) .OR. TE
* 
      GO TO 210 
*        GET DEVICE TYPE
  208 CONTINUE
* 
*            CHECK FOR HUID BY TESTING FIRST CHARACTER FOR NUMERIC
* 
      TE = (SHIFT(MPAR2,6) .AND. O"77" )
      IF ((TE .GT. O"44" ) .OR. (TE .LT. O"33" )) GO TO 209 
      SETFL = 4HHUID
      RPEST = MPAR2 
      GO TO 210 
  209 CONTINUE
      SETFL=(SHIFT(MPAR2,12)).AND .O"7777"
*        GET EST REQUEST, IF ANY
      RPEST = (SHIFT(MPAR2,30)) .AND. O"777777" 
      TEST2 = RPEST .AND. O"77" 
      IF (TEST2 .EQ. 0) RPEST = SHIFT (RPEST, -6) 
* TEST IF UNIT NUMBER WAS SELECTED. 
      IF(MPAR4.EQ.0) GO TO 210
      RPEST = SHIFT(MPAR4,18).OR.RPEST
      IF((RPEST.AND.O"77").NE.0) GO TO 210
*     ADJUST FOR ONLY TWO CHRACTERS ON EST. 
      RPUN = RPEST.AND.O"7777000000000" 
      RPEST = SHIFT(RPEST,-6).AND.O"7777" 
      RPEST = RPEST.OR.RPUN 
  210 GO TO  (300,310,320,330,340,160,360,370,380,390,
     .400,410,420,430,440,450,460,470,480,490,
     .500,510,520,530,160,160,560,160,
     .580,590,600,220,230,720) PARK 
  
  
*     PROCESS DETAIED STATUS ANALYSIS PARAMETER 
*     (DSA IS DEFAULT AND WILL BE PERFORMED IF NOT PREVIOUSLY DONE, AS
*      DENOTED BY DSA BIT SET IN SEF.  DSA PARAMETER WILL FORCE THE 
*      PROCESS ANEW, TO ACCOMMODATE UPDATED DSA TABLES.)
  
  220 FLAGS(24) = 3HALL 
      PL(PWP)=10HD.STAT.ANL 
      GO TO 800 
  
*     PROCESS MMF PARAMETER 
  
  230 CONTINUE
      FLAGS(25) = 3HALL 
      PL(PWP) = 10HMULTI-CPU
      TYPORD=4HHUID 
      IF(SEPR.NE.R"=".AND.SEPR.NE.2) GO TO 800
      NUM =SETFL
      CALL IVAL1(NUM) 
      IF(NUM.EQ.5HERROR) GO TO 160
      FLAGS(25) = NUM 
      GO TO 795 
  300 FILEP(OLD) = SETFL
      PL(PWP) = 10HOLD HISTRY 
      GO TO 750 
  
  310 FILEP(NEW) = SETFL
      PL(PWP) = 10HNEW HISTRY 
      FROG(3) = 2HON
      GO TO 750 
  
  320 FILEP(RSEF) = SETFL 
      GO TO 750 
  
*       INPUT FILE .... 
  330 FILEP(5) = SETFL
      PL(PWP) = 10HINPUT
      FROG(16) = 2HON                                                   000250
      GO TO 750 
  
*      OUTPUT FILE .... 
  340 FILEP(6) = SETFL
      GO TO 750 
  
*         ............  ( D ) PARAMETER , DETAIL REPORT 
  360 PL(PWP) = 10HDETAIL 
      PTR = 1 
      GO TO 700 
  
*      SUMMARY REPORTS
  370 FROG(1) = SETFL 
      PL(PWP) = 10HSUMMARY
      GO TO 795 
  
*     .........  (T) TAPE MEDIA REPORT                                   R2FHWMO
  380 FROG(5) = SETFL                                                    R2FHWMO
      PL(PWP) = 10HTAPE MEDIA                                           003570
      IF(SETFL.EQ.3HALL) FROG(5) = 3HNUL
      GO TO 795 
  
*      .........  (HR) PARAMETER
  390 PL(PWP) = 10HHIST-READ
      FILEP(OLD) = 2HON                                                  R2FHWMO
      PTR = 6 
      GO TO 700 
  
  400 PL(PWP) = 10HANALYSIS 
      PTR = 2 
      GO TO 700 
  
*       ....... (E)  ERROR CODE LIST
  
  410 PL (PWP) = 10HERR-CODE
      FROG(4) = 2HON
      GO TO 800 
  
*        MEDIA-UNIT ANALYSIS REPORT                                     003590
  420 FROG(2) = 2HON
*        FORCE T=S IF NOT SET ALREADY                                   003610
      IF(FROG(5).NE.3HOFF) GO TO 422                                    003620
      FROG(5) = L"S"
      PL(PWP) = 10HTAPE MEDIA                                           003640
      PWP = PWP + 1                                                     003650
  422 CONTINUE                                                          003660
      PL(PWP) = 10HMEDIA-UNIT                                           003670
      GO TO 800 
  
*            ** ( X ) PARAMETER 
  
  430 CONTINUE
*     IF MORE THAN ONE X PARAMETER ABORT
      IF(FROG(6).NE.0) GO TO 1030 
      FROG(6) = SETFL 
      GO TO 810 
  
*          ** ( DX ) PARAMETER
  440 PL (PWP) = 10HEXT-DETAIL
      PTR = 3 
      GO TO 700 
  
*           .... ( B ) PARAMETER .... 
  450 PL (PWP) = 10HBYPASS-DET
      PTR = 4 
      GO TO 700 
  
*         ..... ( ST ) PARAMETER
  460 PL (PWP) = 10HSTATISTICS
      PTR = 5 
      GO TO 700 
  
*      .......  ( NS ) PARAMETER
  470 PL(PWP) = 8HNO-SORT 
      SEF = RSEF
      FLAGS(1) = 7H NOSORT
      GO TO 800 
  
*      .......  ( LH ) PARAMETER
  480 PL (PWP) = 10HLIMIT-HIST
      IF (SETFL .EQ. 3HALL) GO TO 800 
      NUM = SETFL 
*       CONVERT TO INTEGER
      CALL IVAL1 (NUM)
      IF (NUM .EQ. 5HERROR) GO TO 160 
      FROG(9) = NUM 
      GO TO 795 
* 
*       ......  ( MF ) , MEDIA FILE PARAMETER 
  490 PL(PWP) = 10HMEDIA FILE                                            R2FHWMO
      FROG(11) = SETFL                                                   R2FHWMO
      IF ((SETFL.EQ.3HALL).OR.(SETFL.EQ.L"SEF")) FROG(11) = SEF 
      IF (((SETFL.EQ.L"H").OR.(SETFL.EQ.L"OLD")).OR.(SETFL.EQ.L"OLDHF"))
     .   FROG(11) = OLD 
      IF (((SETFL.EQ.L"NH").OR.(SETFL.EQ.L"NEW")).OR.(SETFL.EQ.L"NEWHF")
     .)  FROG(11) = NEW 
      IF (FROG(11) .EQ. OLD) FILEP(OLD) = 2HON                           R2FHWMO
      IF (FROG(11) .EQ. NEW) FILEP(NEW) = 2HON                           R2FHWMO
      GO TO 795 
* 
*     .........   ( VSN ) PARAMETER, FOR MEDIA REPORT 
  500 PL (PWP) = 10HVSN(MEDIA)
      IF (SEPR .EQ. 2) SETFL = MPAR2
      FROG(10) = SETFL
      GO TO 795 
  
*       .......  (DR) PARAMETER, FOR CONTROL OF  REPEAT DETAIL
  510 PL(PWP) = 10HDTL-RPTQTY 
      FROG(12) = SETFL
      NUM = SETFL 
       IF (FROG(12) .EQ. L"ALL") GO TO 795
*      CONVERT TO INTEGER 
      CALL IVAL1 (NUM)
      IF (NUM .EQ. 5HERROR) GO TO 160 
      FROG(12) = NUM
      GO TO 795 
  
*    ....... ( EX ) PARAMETER, EXTRACT DATA FROM SEF
  520 PL(PWP) = 10HEXTRACT
      FROG(13) = SETFL
      GO TO 795 
  
*     .......... ( SE ) PARAMETER , SELECTED ERROR REPORT 
  530 PL(PWP) = 10HSEL. ERROR 
      FROG(14) = SETFL
      GO TO 795 
  
*      ......... ( PF ) PARAMETER , PRINT FORMAT - LINES PER PAGE       000450
  560 PL(PWP) = 10HPRINT-FORM                                           000460
      IF (SETFL .EQ. 3HALL) GO TO 800                                   000470
      NUM = SETFL                                                       000480
*        CONVERT TO INTEGER                                             000490
      CALL IVAL1 (NUM)                                                  000500
      IF (NUM .EQ. 5HERROR) GO TO 160                                   000510
      PLF = NUM                                                         000520
      GO TO 795                                                         000530
  
*     ........  (VR) PARAMETER,  VSN RANGE LIMIT
  
  580 PL(PWP) = 10HVSN-RPTQTY 
      FROG(17) = SETFL
      NUM = SETFL 
      IF (FROG(17) .EQ. L"ALL") GO TO 795 
  
*     CONVERT TO INTEGER
  
      CALL IVAL1(NUM) 
      IF(NUM .EQ. 5HERROR) GO TO 160
      FROG(17) = NUM
      GO TO 795 
                                                                         R2DFMD 
*     PROCESS "R" PARAMETER                                              R2DFMD 
                                                                         R2DFMD 
  590 CONTINUE                                                           HPA408S
*     ABORT IF X AND R PARAMETER SELECTED.
      IF(FROG(6).NE.0) GO TO 1030 
      FROG(18) = 3HYES                                                   R2DFMD 
*        TURN ON X=BF PARAMETER                                          HPA408S
      FROG(6) = L"BF" 
      GO TO 810                                                          HPA408S
                                                                         R2FHWMO
*     .........( HW ) PARAMETER - HISTORY WINDOW                         R2FHWMO
                                                                         R2FHWMO
  600 PL(PWP) = 10HHIS-WINDOW                                            R2FHWMO
      FROP(1,1,8) = MPAR                                                 R2FHWMO
*        PROCESS BEGINNING DATE OF HW                                    R2FHWMO
      HWDATE = 1                                                         R2FHWMO
      TEST=SHIFT(MPAR2,-18) .AND. O"77777777" 
      IF ((TEST .AND. O"77") .NE. 0) GO TO 160
      IF (TEST .NE. 0) GO TO 610
*      USE SYSTEM DATE AS BEGINNING DATE OF HW
*      HW=NN (NN=NUMBER OF DAYS) BECOMES HW=SYSTEM DATE/NN
      IFLG = 1
      DECODE (10,605,IDATIM(3)) FROP(1,2,8) 
  605 FORMAT (2X,I3)
      JDT = IDATIM(4) 
      FROP(1,2,8) = FROP(1,2,8) .OR. SHIFT(JDT,9) 
*        CHECK IF NUMBER OF DAYS DEFAULTS TO 1
      TEST = SHIFT(MPAR2,6) .AND. O"77" 
      IF ((TEST .LT. O"34") .OR. (TEST .GT. O"44")) MPAR2 = L"1"
      MPAR3 = MPAR2 
      KP = KP - 1 
      GO TO 615 
*        PROCESS NEXT HW DATE (BEGINNING OR ENDING) 
  610 DO 611  I = 2,6,2 
      N = I*3 
      IF ((SHIFT(SETFL,N+18).AND.O"77").NE.O"12") GO TO 611 
*             HW=DDDYYJ/DDDYYJ OR HW=DDDYYJ/NN; (J=JULIAN DATE) 
      MPARD = SHIFT(SETFL,N).AND.(8**I-1) 
      MPARY = SHIFT(SETFL,N+12).AND.O"7777" 
      CALL IVAL1(MPARD) 
      IF (MPARD .EQ. 5HERROR) GO TO 160 
      CALL IVAL1(MPARY) 
      IF (MPARY .EQ. 5HERROR) GO TO 160 
      MPARY = MPARY - 70
      JDT = SHIFT(MPARY,9).OR.MPARD 
      GO TO 614 
  611 CONTINUE
*             HW=YYMMDD/YYMMDD OR HW=YYMMDD/NN; CALENDAR DATE 
      MPARY = SHIFT(SETFL,12) .AND. O"7777" 
      MPARM = SHIFT(SETFL,24) .AND. O"7777" 
      MPARD = SHIFT(SETFL,36) .AND. O"7777" 
      CALL IVAL1 (MPARM)                                                 R2FHWMO
      IF (MPARM .EQ. 5HERROR) GO TO 160 
      CALL IVAL1 (MPARD)                                                 R2FHWMO
      IF (MPARD .EQ. 5HERROR) GO TO 160 
      CALL IVAL1 (MPARY)                                                 R2FHWMO
      IF (MPARY .EQ. 5HERROR) GO TO 160 
      MPARY = MPARY - 70                                                 R2FHWMO
      CALL JULE (MPARM,MPARD,MPARY,JDT) 
      IF (FLAGS(2) .EQ. 5HERROR) GO TO 160                               R2FHWMO
  614 CONTINUE
      IF (HWDATE .EQ. 2) GO TO 660                                       R2FHWMO
      FROP(1,2,8) = JDT 
*        CHECK IF NEXT HW PARAMETER AN ENDING DATE OR NUMBER OF DAYS
      MPAR3 = IPAR (KP + 2) .AND. M7                                     R2FHWMO
      TEST = SHIFT(MPAR3,-18) .AND. O"77777777" 
      IF ((TEST .AND. O"77") .NE. 0) GO TO 160
      IF (TEST .NE. 0) GO TO 650                                         R2FHWMO
*        CHECK IF NUMBER OF DAYS DEFAULTS TO 1
      TEST = SHIFT(MPAR3,6) .AND. O"77" 
      IF ((TEST .GE. O"34") .AND. (TEST .LE. O"44")) GO TO 615
      MPAR3 = L"1"
      KP = KP - 1 
*        PROCESS NUMBER OF DAYS FOR HW                                   R2FHWMO
  615 CONTINUE
      PRHW2=MPAR3 
      CALL IBLANK(PRHW2)
      CALL IVAL1 (MPAR3)                                                 R2FHWMO
      IF ((MPAR3 .LT. 1) .OR. (MPAR3 .GT. 366)) GO TO 160                R2FHWMO
      IDAY = FROP(1,2,8).AND.O"777" 
      IF (IDAY.GE.MPAR3) GO TO 640
      IYR = SHIFT(FROP(1,2,8),-9).AND.O"77" 
      IYR = IYR - 1 
      YDAY = 365
*        CHECK FOR LEAP YEAR
      ITEST = IYR - 2 
  620 CONTINUE
      IF (ITEST.EQ.0) YDAY = 366
      IF (ITEST.LE.0) GO TO 630 
      ITEST = ITEST -4
      GO TO 620 
  630 CONTINUE
      IDAY = YDAY + IDAY - (MPAR3 - 1)
      FROP(1,3,8) = SHIFT(IYR,9).OR.IDAY
      GO TO 690 
  640 CONTINUE
      FROP (1,3,8) = FROP(1,2,8) - (MPAR3 - 1)                           R2FHWMO
      GO TO 690                                                          R2FHWMO
*        PROCESS ENDING DATE OF HW                                       R2FHWMO
  650 HWDATE = 2                                                         R2FHWMO
      SETFL = MPAR3                                                      R2FHWMO
      PRHW2=MPAR3 
      CALL IBLANK(PRHW2)
      GO TO 610                                                          R2FHWMO
*        CONCLUDE PROCESSING ENDING DATE
  660 FROP(1,3,8) =JDT
      IF (FROP(1,3,8) .LT. FROP(1,2,8)) GO TO 690                        R2FHWMO
      FROP(1,3,8) = FROP(1,2,8)                                          R2FHWMO
      FROP(1,2,8) =JDT
  690 KP = KP + 1                                                        R2FHWMO
      GO TO 795                                                          R2FHWMO
                                                                         R2FHWMO
*           SET PARAMETERS IN ARRAY FROP AS CALLED BY POINTER(PTR)
  700 DO 710 K = 1,8
      IF(FROP(K,1,PTR).EQ.3HOFF) GO TO 705
      IF(FROP(K,1,PTR).EQ.3HALL) GO TO 704
      IF(FROP(K,1,PTR).NE.SETFL) GO TO 710
      IF(FROP(K,2,PTR).EQ.3HALL) GO TO 704
      IF(FROP(K,2,PTR).NE.RPEST) GO TO 710
  704 PL(PWP)=1H
      GO TO 810 
  705 CONTINUE
      FROP(K,1,PTR) = SETFL 
      IF (SETFL .EQ. 4HHUID) GO TO 708
      IF (RPEST .NE. 0) FROP(K,2,PTR) = IOCT1 (RPEST) 
* IF UNIT NUMBER WAS ZERO BIAS WORD BY 77 IN UPPER BITS.
      IF(MPAR4.EQ.O"3333") FROP(K,2,PTR) = FROP(K,2,PTR).OR.L";"
      GO TO 715 
  708 CALL IVAL1 (RPEST)
      FROP(K,2,PTR) = RPEST 
      IF (FROP(K,2,PTR) .GT. 4095 ) FROP(K,2,PTR) = 5HERROR 
      GO TO 715 
  710 CONTINUE
      FLAGS(2)=5HERROR
      CALL HEADER 
      PRINT 712 
  712 FORMAT(1X,'ERROR - PARAMETER TABLE OVERFLOW') 
      GO TO 3000
  715 IF (FROP(K,2,PTR)  .EQ.  5HERROR) GO TO 160 
      GO TO 795 
  
*     .........( DATE ) PARAMETER 
  
  720 PL(PWP) = 10HDATE 
      IF ((SETFL .EQ. 3HALL) .OR. (SETFL .EQ. 0)) GO TO 160 
      DECODE(6,722,SETFL) IM,ID,IY
  722 FORMAT(I2,I2,I2)
      IY = IY -70 
       CALL JULE(IM,ID,IY,JULDT)
      IF (FLAGS(2) .EQ. 5HERROR) GO TO 160
       IY = AND(SHIFT(JULDT,-9),O"77") + 1070 
       ID = AND(JULDT,O"777") + 1000
      ENCODE(10,724,IYY) IY 
      ENCODE(10,724,IDD) ID 
  724 FORMAT(6X,I4) 
       JULDT = OR(SHIFT(AND(IYY,O"7777"),18),AND(IDD,O"777777"))
      DECODE(6,726,SETFL) IM,ID,IY
  726 FORMAT(A2,A2,A2)
      ENCODE(10,728,PRDATE) IY,IM,ID
  728 FORMAT(1X,A2,1H/,A2,1H/,A2,1H.) 
*        IF DEBUG DEFINED, STORE DATE, JDATE
*IF DEF,DEBUG 
      IDATIM(1) = PRDATE
      IDATIM(3) = JULDT 
*ENDIF
      GO TO 795 
*         ADVANCE POINTER AND GET NEXT PARAMETER
*         SET FILE NAME ASSIGNMENT IN BUFFER FOR PARSET 
  
  750 IF(SEPR.EQ.2) GO TO 760 
      IF(SEPR.NE.O"54")GO TO 800
  760 CONTINUE
      PARFN(PARK)=MPAR2 
      IF (PARK .LT. 3) GO TO 800
      GO TO 810 
  
*       INSERT PARAMETER AFTER (=) IN ANY CALL, TO BE 
*       PRINTED IN PARAMETER REPORT.
  795 IF (SEPR .EQ. 2) PRAMT (PWP) = WORD2.AND.M7 
      CALL IBLANK (PRAMT(PWP))
      IF (IFLG.EQ.0)  GO TO 800 
* 
*        INSERT DATE FOR PARAMETER HW=XXX 
* 
      DECODE(10,796,IDATIM(1))  IYY, IMM, IDD 
  796 FORMAT(1X,3(A2,1X)) 
      ENCODE(10,797,PRAMT(PWP)) IYY, IMM, IDD 
  797 FORMAT(3A2,4X)
* 
  
  800 IF(PL(PWP).NE.5H NONE) PWP=PWP+1
      IF(PTR .NE. 3) GO TO 810
      PARK = 7
      GO TO 200 
  810 KP=KP+1 
      IF(KP.GE.64)GO TO 900 
      IF(SEPR.EQ.2) KP=KP+1 
      IF(PEND.EQ.0) GO TO 100 
  
  900 CONTINUE
      IF(PARFN(1).NE.PARFN(2))GO TO 904 
      CALL HEADER 
      PRINT 902 
  902 FORMAT(' .. OLDHF = NEWHF ILLEGAL .. HPA RUN ABORT .. ')
      FLAGS(2) = 5HERROR
      GO TO 3000
* 
*     CHECK TO MAKE SURE NH IS SPECIFIED IF I IS SET
904   IF((FROG(16) .EQ. 3HOFF) .OR. (FROG(3) .EQ. 2HON)) GO TO 906
      CALL HEADER 
      FLAGS(2) = 5HERROR
      PRINT 1003
1003  FORMAT(1X, ' NH MUST BE SPECIFIED WHEN USING THE I PARAMETER',
     .'   ... HPA RUN ABORT ...') 
      GO TO 3000
  
*        INITIALIZE INPUT AND OUTPUT FILES
  
906   CALL PARSET 
      OPEN(5,BUFL=101,FILE=F1)
      OPEN(6,BUFL=101,FILE=F2)
  
*     REPLACE DEFAULT LOGICAL FILE NAMES FOR NEW, OLD AND RSEF. 
      LFNTBL(1) = PARFN(1)
      LFNTBL(2) = PARFN(2)
      LFNTBL(3) = PARFN(3)
  
*        CONSTRUCT, OPEN AND REWIND RECORD MANAGER INTERFACE FILES
  
      CALL RMOPEN 
  
*        SKIP PARAMETERS HEADING IF (X) PARAMETER SET.                  000770
      IF(FROG(6) .EQ. L"BF") GO TO 1020 
      CALL HEADER 
  
      DO 910 K = 1,6
       CALL IBLANK (PARFN(K)) 
  910 CONTINUE
      IF (FLAGS(2) .EQ. 5HERROR) RETURN 
  
*         PRINT FILE NAMES AND REPORTS CALLED 
  
      IQUL=6H --- 
      PRINT 1004
 1004 FORMAT (/,'  FILE ASSIGNMENTS ',/)
      PRINT 1001, (FNAM(I),I=1,5) 
      PRINT 1001, IQUL,IQUL,IQUL,IQUL,IQUL
      PRINT 1001, (PARFN(I),I=1,5)
 1001 FORMAT (5(3X,A7)) 
      PRINT 1005
 1005 FORMAT (/,'  .. REPORTS CALLED .. ',/)
  
 1020 CONTINUE                                                           HPA408S
      IF (PL(1) .NE. 5H NONE) GO TO 1050
*         SET DEFAULT PARAMETERS: SUMMARY REPORT AND OLDHF ENABLED
      PL(1) = 10HSUMMARY
      FROG(1) = L"12" 
      FILEP(OLD) = 2HON                                                  HPA408S
      GO TO 1050
* 
*     PRINT ERROR IF MORE THAN ONE X OR X AND R PARAMETER SELECTED. 
 1030 CONTINUE
      FLAGS(2) = 5HERROR
      CALL HEADER 
      PRINT 1040
 1040 FORMAT(1X,' ONLY ONE X OR R PARAMETER CAN BE SELECTED-',
     .'HPA RUN ABORT ') 
      FROG(6) = 0 
      GO TO 3000
                                                                         HPA408S
*        BYPASS PARAMETER PRINTING IF X=BF SELECTED                      HPA408S
 1050 CONTINUE                                                           HPA0332
      IF(FROG(6) .EQ. L"BF") GO TO 1110 
  
      DO 1105 K = 1,PWP 
      IF(PL(K) .NE. 10HHIS-WINDOW) GO TO 1100 
      PRINT 1080,PL(K),PRAMT(K),PRHW2 
1080  FORMAT(4X,A10,2X,A6,' / ',A6) 
      GO TO 1105
 1100    PRINT 1102 , PL(K), PRAMT(K) 
 1102    FORMAT (4X,A10,2X,A10) 
 1105 CONTINUE
  
*        IF HR (HISTORY READ) SELECTED, NH (NEW HISTORY) DISALLOWED 
 1110 IF ((FROP(1,1,6).EQ.3HOFF) .OR. (FROG(3).EQ.3HOFF)) GO TO 1120
      FROG(3) = 3HOFF 
      PRINT 1111
 1111 FORMAT (//,' ----- NEWHF REQUEST DENIED WITH HR PARAMETER -----') 
  
*        IF HR (HISTORY READ) SELECTED, I (INPUT) DISALLOWED
 1120 IF ((FROP(1,1,6).EQ.3HOFF) .OR. (FROG(16).EQ.3HOFF)) GO TO 1130 
      FILEP(5) = 3HOFF
      FROG(16) = 3HOFF
      PRINT 1121
 1121 FORMAT (//,' ----- INPUT REQUEST DENIED WITH HR PARAMETER -----') 
  
 1130 CONTINUE
      DO 2000 K = 1,64
 2000 PL(K) = 1H
  
 3000 RETURN
      END 
      SUBROUTINE IBLANK (IWRD)
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE IBLANK FILLS ZERO BYTES (ONE BYTE IS 
*         6 BITS LONG) IN ONE CPU WORD WITH SPACE.
* 
*         ENTRY CONDITIONS
*         ----------------
*         IWRD - ONE CPU WORD WHOSE ZERO BYTES ARE TO BE FILLED 
*                WITH SPACE.
* 
*         EXIT CONDITIONS 
*         --------------- 
*         IWRD - ONE CPU WORD WHOSE ZERO BYTES WERE FILLED
*                WITH SPACE.
* 
      DO 100 J = 1,10 
      IF ((IWRD .AND. O"77") .EQ. 0) IWRD = IWRD .OR. O"55" 
  100 IWRD = SHIFT(IWRD,6)
      RETURN
      END 
      FUNCTION IOCT1 (WORD) 
* 
**        DESCRIPTION 
*         ----------- 
*         FUNCTION IOCT CONVERTS DISPLAY CODED NUMBER HELD IN 
*         ONE CPU WORD INTO AN OCTAL VALUE WITH ZERO FILLED.
* 
*         ENTRY CONDITIONS
*         ----------------
*         WORD - DISPLAY CODED NUMBER IN ONE CPU WORD.
* 
*         EXIT CONDITIONS 
*         --------------- 
*         IOCT - OCTAL NUMBER CONVERTED FROM WORD ONLY IF WORD
*                HAD A VALID DATA. IOCT=-1 IF INVALID.
* 
*         DATA AREAS
*         ----------
*         VARIABLES USED ARE ALL LOCAL TO THIS ROUTINE. 
* 
*         CALLED BY 
*         --------- 
*         SETPAR1 
* 
      IMPLICIT INTEGER(F-Z) 
       SW = SHIFT (WORD,6)
       WORD = 0 
       DO 50 K = 1,10 
            WORD = SHIFT(WORD,3)
            IT = SW .AND. O"77" 
            IF (IT .EQ. 0) GO TO 50 
            IT = IT - O"33" 
  
*            TEST FOR VALID OCTAL 
  
             IF (IT .GT. 7) GO TO 100 
             IF (IT .LT. 0) GO TO 100 
             WORD = WORD .OR. IT
   50  SW = SHIFT(SW,6) 
       IOCT1 = WORD 
       GO TO 200
  
  100 IOCT1 = 5HERROR 
  
  200  RETURN 
       END
      SUBROUTINE IVAL1 (WORD) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE IVAL CHECKS IF THE GIVEN ONE CPU WORD
*         CONTAINS ONLY THE DISPLAY CODED NUMERICS. 
*         IF SO, DECODE IT TO DECIMAL INTEGER,
*         ELSE SET THE ERROR FLAG OF -1.
* 
*         ENTRY CONDITIONS
*         ----------------
*         WORD - ONE CPU WORD WHICH CONTAINS DIAPLAY CODED
*                NUMERICS.
* 
*         EXIT CONDITIONS 
*         --------------- 
*         WORD - DECODED DECIMAL INTEGER IF WORD HAD VALID DATA,
*                VALUE OF -1 IF WORD HAD CONTAINED OTHER THAN 
*                DISPLAY CODED NUMERICS OR THE BYTES IS ZERO(ONE
*                BYTE IS 6 BIT LONG). 
* 
*         DATA AREAS
*         ----------
*         VARIABLES USED ARE ALL LOCAL TO SUBROUTINE. 
* 
*         CALLED BY 
*         --------- 
*         SETPAR1 
* 
      IMPLICIT INTEGER(F-Z) 
  
*         SHIFT AND TEST EACH CHAR. FOR VALUE BETWEEN 33B TO 44B .
  
      TEMP = WORD 
      TEMP2 = 0 
      DO 10 K = 1,10
        TEMP = SHIFT(TEMP,6)
        IT = TEMP .AND. O"77" 
        IF (IT .EQ. 0) GO TO 5
        IF (IT .LT. O"33") GO TO 100
        IF (IT .GT. O"44") GO TO 100
    5   IF (IT .EQ. 0) IT = O"55" 
        TEMP2 = SHIFT(TEMP2,6)
        TEMP2 = TEMP2 .OR. IT 
   10 CONTINUE
  
*     RIGHT JUSTIFY 
      DO 20 K = 1,10
         IT = SHIFT(TEMP2,6) .AND. O"77"
         IF (IT .EQ. O"55") GO TO 50
         TEMP2 = SHIFT (TEMP2,6)
   20 CONTINUE
  
   50 DECODE (10,51,TEMP2) WORD 
   51 FORMAT ( I10 )
      RETURN
  
*         ERROR  FLAG 
  
  100 WORD = 5HERROR
      RETURN
      END 
      SUBROUTINE JULE (IMN,IDY,IYR,JDATE) 
* 
**        DESCRIPTION 
*         ----------- 
* 
*         SUBROUTINE JULE CONVERTS CALENDAR DATE INTO JULIAN DATE 
* 
*         ENTRY CONDITIONS
*         ----------------
* 
*         IMN - FORMAL PARAMETER OF DECIMAL CALENDAR MONTH
*         IDY - FORMAL PARAMETER OF DECIMAL CALENDAR DAY
*         IYR - FORMAL PARAMETER OF DECIMAL CALENDAR YEAR 
*               BIASED BY 1970
*         IDATIM(4) = THIS YEAR BIASED BY 1970
* 
*         EXIT CONDITIONS 
*         --------------- 
* 
*         JDATE - FORMAL PARAMETER RETURNING THE CONVERTED JULIAN DATE
* 
*         DATA AREAS
*         ----------
* 
*         IDAYTBL - (12) / LOCAL TO SUBROUTINE.  TABLE OF JULIAN DAYS 
*                          FOR EACH MONTH.
*         FLAGS(2) - / COMMON BLOCK / ERROR FLAG
* 
*CALL HPACOM1 
  
      DIMENSION IDAYTBL(12) 
      DATA (IDAYTBL(J),J=1,12) /0, 31, 59, 90, 120, 151,
     .                   181, 212, 243, 273, 304, 334 / 
  
      IF ((IMN .LT. 1) .OR. (IMN .GT. 12)) FLAGS(2) = 5HERROR 
      IF ((IDY .LT. 1) .OR. (IDY .GT. 31)) FLAGS(2) = 5HERROR 
      IF ((IYR .LT. 0) .OR. (IYR .GT. IDATIM(4))) FLAGS(2) = 5HERROR
      IDAY = IDY + IDAYTBL(IMN) 
      ITEST = IYR - 2 
  
   50 IF ((ITEST .EQ. 0) .AND. (IDAY .GT. 59)) IDAY = IDAY + 1
      IF (ITEST .LE. 0) GO TO 100 
      ITEST = ITEST - 4 
      GO TO 50
  
  100 JDATE =  SHIFT (IYR,9) .OR. IDAY
      RETURN
      END 
