*DECK HPA21 
*IF,DEF,HPSORT
      SUBROUTINE FLUSH2 (IOUT2,PFLAG)                                    HPA0310
**    FLUSH2 - FLUSH LAST RECORD OUT OF HOLDING AREA AT END OF SORT      HPA0310
*                                                                        HPA0310
*     ENTRY    LAST RECORD HAS BEEN WRITTEN TO OUTPUT FILE               HPA0310
*                                                                        HPA0310
*     EXIT     REMAINING RECORD (IN OUT1) PASSED TO OUTPUT FILE          HPA0310
*                                                                        HPA0310
*     CALLED BY  -- RMERGF2                                              HPA0310
*                                                                        HPA0310
*     USES    OUT2                                                       HPA0310
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
      IMPLICIT INTEGER (F-Z)
*CALL COMHPASPE 
                                                                         HPA0310
      DIMENSION IOUT2(8)
  
      PFLAG = 1                                                          HPA0310
      DO 100 I = 1, 8                                                    HPA0310
  100 IOUT2(I) = IOUT1(I)                                                HPA0310
      IF (IOUT2(1) .EQ. 0) RETURN                                        HPA0310
      IOUT1(1) = 0                                                       HPA0310
      PFLAG = 2                                                          HPA0310
                                                                         HPA0310
      RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE HSORT2 (INF,OUTF)                                       HPA0310
*                                                                        HPA0310
*            CONTROL ROUTINE FOR HPA INTERNAL SORT.                      HPA0310
*                                                                        HPA0310
*            CALLED BY  --  STFACE2                                      HPA0310
*                                                                        HPA0310
*            DESCRIPTION  --  ASSIGN THE FILES USED FOR SORT AND         HPA0310
*                             CALL SUBROUTINES IN THE PROCESS.           HPA0310
*                                                                        HPA0310
*CALL,HPACOM1                                                            HPA0310
  
      COMMON /S2/  IREC(8),IRA,IRB,IREC2(8),QRA,QRB,
     .RAMF2,RLIM,SA(1024,2),SCR4,SCR5,U,L 
      COMMON /S3/ KEYT(12,4),KYK, RINK,ROUT,RDEST,SEGF,SEGL,WDEST        HPA0310
                                                                         HPA0310
      CALL INIDAT2 (2)                                                   HPA0310
*                  LOAD  (SA) ARRAY FROM SEF.                            HPA0310
  200 CALL SALOAD2 (INF)                                                 HPA0310
                                                                         HPA0310
*                   ORDER DATA (SA), WITH BATCHER TECHNIQUE.             HPA0310
      CALL SAORD2                                                        HPA0310
                                                                         HPA0310
      FEOF(RAMF2) = FEOF(SCR5) = FEOF(SCR4) = 2HNO                       HPA0310
                                                                         HPA0310
      GO TO (410,420,430,440,450)  SEGF 
                                                                         HPA0310
*         SEGF = 1                                                       HPA0310
  410 WDEST = OUTF                                                       HPA0310
      IF (FEOF(INF) .NE. 3HYES) GO TO 420                                HPA0310
      CALL RCOPY2                                                        HPA0310
      GO TO 900                                                          HPA0310
                                                                         HPA0310
  420 SEGF = 2                                                           HPA0310
      SEGL = 2                                                           HPA0310
      WDEST = SCR5                                                       HPA0310
      CALL RCOPY2                                                        HPA0310
      SEGF = 3                                                           HPA0310
      GO TO 200                                                          HPA0310
                                                                         HPA0310
*                SEGF = 3                                                HPA0310
  430 WDEST = SCR4                                                       HPA0310
      RDEST = SCR5                                                       HPA0310
      CALL RMERG2                                                        HPA0310
      SEGF = 4                                                           HPA0310
      SEGL = 3                                                           HPA0310
      GO TO 200                                                          HPA0310
                                                                         HPA0310
  440 IF (FEOF(INF) .EQ. 3HYES) GO TO 450                                HPA0310
      RDEST = SCR4                                                       HPA0310
      WDEST = SCR5                                                       HPA0310
      CALL RMERG2                                                        HPA0310
      SEGF = 3                                                           HPA0310
      SEGL = 4                                                           HPA0310
      GO TO 200                                                          HPA0310
                                                                         HPA0310
  450 SEGF = 5                                                           HPA0310
      RDEST = WDEST                                                      HPA0310
      WDEST = OUTF                                                       HPA0310
      CALL RMERGF2                                                       HPA0310
      GO TO 900                                                          HPA0310
                                                                         HPA0310
                                                                         HPA0310
  900 CALL CLOSMS (RAMF2)                                                HPA0310
                                                                         HPA0310
      CALL RMREWND (SCR4) 
      CALL RMFILEM (SCR4) 
      CALL RMREWND (SCR5) 
      CALL RMFILEM (SCR5) 
                                                                         HPA0310
      PRINT 910,FLAGS(9),RINK                                            HPA0310
  910 FORMAT (' SORT(',I1,') -  INPUT RECORDS =',I5)
                                                                         HPA0310
      PRINT 915,FLAGS(9),ROUT                                            HPA0310
  915 FORMAT (' SORT(',I1,') - OUTPUT RECORDS =',I5)
                                                                         HPA0310
      RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE INIDAT2 (F)                                             HPA0310
*                                                                        HPA0310
*         INITIALIZE FOR SORT PROCES                                     HPA0310
*                                                                        HPA0310
*         CALLED BY -- STFACE2,HSORT2                                    HPA0310
*                                                                        HPA0310
                                                                         HPA0310
      IMPLICIT INTEGER (F-Z)
*CALL HPACOM3 
      COMMON /S1/ KDD,KPP,KQQ,KRR,PAS,PSTART                             HPA0310
      COMMON /S2/  IREC(8),IRA,IRB,IREC2(8),QRA,QRB,
     .RAMF2,RLIM,SA(1024,2),SCR4,SCR5,U,L 
      COMMON /S3/ KEYT(12,4),KYK, RINK,ROUT,RDEST,SEGF,SEGL,WDEST        HPA0310
                                                                         HPA0310
      DIMENSION IDEX(2048)
      EQUIVALENCE (IDEX(1), STOR(1,1))
  
      IF (F .EQ. 2) GO TO 10                                             HPA0310
      KYK = 0                                                            HPA0310
      RAMF2 = 14                                                         HPA0310
      SCR4 = 15                                                          HPA0310
      SCR5 = 16                                                          HPA0310
                                                                         HPA0310
      CALL RMREWND (SCR4) 
      CALL RMFILEM (SCR4) 
      CALL RMREWND (SCR4) 
      CALL RMREWND (SCR5) 
      CALL RMFILEM (SCR5) 
      CALL RMREWND (SCR5) 
                                                                         HPA0310
      DO 5 K = 1,12                                                      HPA0310
      DO 5 K2 = 1,4                                                      HPA0310
    5 KEYT(K,K2) = 0                                                     HPA0310
      GO TO 900                                                          HPA0310
                                                                         HPA0310
*         INITIALIZE 2   .........                                       HPA0310
   10 U = 1                                                              HPA0310
      L = 2                                                              HPA0310
      SEGF = 1                                                           HPA0310
      SEGL = 1                                                           HPA0310
      RLIM = 1024 
      RINK = 0                                                           HPA0310
      ROUT = 0                                                           HPA0310
      PSTART = 1                                                         HPA0310
                                                                         HPA0310
*        OPEN RAMHF FOR SORT SCRATCH                                     HPA0310
      CALL OPENMS (RAMF2,IDEX,2048,0)                                    HPA0310
                                                                         HPA0310
  900 RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE LOOPC2                                                  HPA0310
*                                                                        HPA0310
*       CONTROL OF THE LOOP THRU COMPARE OF (SA) PAIRS.                  HPA0310
*                                                                        HPA0310
*         CALLED BY  --  SAORD2                                          HPA0310
*                                                                        HPA0310
                                                                         HPA0310
      IMPLICIT INTEGER (F-Z)
      COMMON /S1/ KDD,KPP,KQQ,KRR,PAS,PSTART                             HPA0310
                                                                         HPA0310
      LOOPK = PAS - KDD                                                  HPA0310
                                                                         HPA0310
      DO 100 K = 1,LOOPK                                                 HPA0310
      IF ((K .AND. KPP) .NE. KRR) GO TO 100                              HPA0310
      P1 = K                                                             HPA0310
      P2 = K + KDD                                                       HPA0310
      CALL LOOPX2 (P1,P2)                                                HPA0310
                                                                         HPA0310
  100 CONTINUE                                                           HPA0310
                                                                         HPA0310
      RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE LOOPX2 (P1,P2)                                          HPA0310
*                                                                        HPA0310
*          COMPARE LOCATIONS PAIR GIVEN BY (PI),                         HPA0310
*          AND EXCHANGE IF NOT IN SEQUENCE.                              HPA0310
*                                                                        HPA0310
*          CALLED BY  --  LOOPC2                                         HPA0310
*                                                                        HPA0310
                                                                         HPA0310
      IMPLICIT INTEGER (F-Z)
      COMMON /S2/  IREC(8),IRA,IRB,IREC2(8),QRA,QRB,
     .RAMF2,RLIM,SA(1024,2),SCR4,SCR5,U,L 
                                                                         HPA0310
      IF (SA(P1,U) .LT. SA(P2,U)) GO TO 900                              HPA0310
      IF (SA(P1,L) .GT. SA(P2,L)) GO TO 200                              HPA0310
      IF (SA(P1,U) .EQ. SA(P2,U)) GO TO 900                              HPA0310
                                                                         HPA0310
*          EXCHANGE NEEDED                                               HPA0310
  200 HOLD = SA(P1,U)                                                    HPA0310
      HOLD2 = SA(P1,L)                                                   HPA0310
                                                                         HPA0310
      SA(P1,U) = SA(P2,U)                                                HPA0310
      SA(P1,L) = SA(P2,L)                                                HPA0310
      SA(P2,U) = HOLD                                                    HPA0310
      SA(P2,L) = HOLD2                                                   HPA0310
                                                                         HPA0310
  900 RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE PROUT2 (OUTR)                                           HPA0310
*                                                                        HPA0310
*          PROUT2  ---- CONTROL THE POST PROCESSING OF                   HPA0310
*                  SORT OUTPUT RECORDS BY OWNCODE ROUTINES.              HPA0310
*                                                                        HPA0310
*            CALLED BY -- RMERGF2,RCOPY2
*                                                                        HPA0310
*            PARAMETER  -- (OUTR) = ARRAY CONTAINING OUTPUT RECORD.      HPA0310
*CALL,HPACOM1                                                            HPA0310
                                                                         HPA0310
      COMMON /S3/ KEYT(12,4),KYK, RINK,ROUT,RDEST,SEGF,SEGL, WDEST       HPA0310
      DIMENSION OUTR(8),OUTR2(8)                                         HPA0310
      DATA IDUMMY /80/
                                                                         HPA0310
*        FLAGS(9) IS THE SORT KEY                                        HPA0310
                                                                         HPA0310
      GO TO (100,700,300) FLAGS(9)
                                                                         HPA0310
  100 CALL POST2 (OUTR,PFLAG,OUTR2)                                      HPA0310
      IF (PFLAG .NE. 0) RETURN
      CALL RMWRITE (WDEST,OUTR2,8)
      ROUT = ROUT + 1                                                    HPA0310
      RETURN                                                             HPA0310
                                                                         HPA0310
  300 IF (FROG(5).NE.L"SS") 
     .   CALL ISUM2 (OUTR,IDUMMY) 
                                                                         HPA0310
  700 CALL RMWRITE (WDEST,OUTR,8) 
      ROUT = ROUT + 1                                                    HPA0310
  800 RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE RCOPY2                                                  HPA0310
*                                                                        HPA0310
*             READ BLOCK FROM RANDOM FILE IN THE ORDER GIVEN BY          HPA0310
*            ARRAY (SA),  WRITE TO DESTINATION FILE.                     HPA0310
*                                                                        HPA0310
*           CALLED BY  --  HSORT2                                        HPA0310
*                                                                        HPA0310
      IMPLICIT INTEGER (F-Z)
                                                                         HPA0310
      COMMON /S2/  IREC(8),IRA,IRB,IREC2(8),QRA,QRB,
     .RAMF2,RLIM,SA(1024,2),SCR4,SCR5,U,L 
      COMMON /S3/ KEYT(12,4),KYK, RINK,ROUT,RDEST,SEGF,SEGL,WDEST        HPA0310
                                                                         HPA0310
                                                                         HPA0310
      DIMENSION QREC(10),QREC2(10)                                       HPA0310
                                                                         HPA0310
      EQUIVALENCE (IREC(1),QREC(1)),(IREC2(1),QREC2(1))                  HPA0310
                                                                         HPA0310
*        IF DESTINATION FILE NOT OUTPUT FILE, ADD KEY TO SCRATCH RECORD. HPA0310
      IF (SEGF .EQ. 2) GO TO 300                                         HPA0310
                                                                         HPA0310
      DO 200 K = 1,RLIM                                                  HPA0310
      KEY = SA(K,L) .AND. O"7777" 
      IF (KEY .EQ. 0) GO TO 900                                          HPA0310
      CALL READMS (RAMF2,IREC,8,KEY)                                     HPA0310
                                                                         HPA0310
*          CALL FOR POST SORT PROCESSING BY OWNCODE ROUTINES.            HPA0310
      CALL PROUT2 (IREC)                                                 HPA0310
                                                                         HPA0310
  200 CONTINUE                                                           HPA0310
      GO TO 900                                                          HPA0310
                                                                         HPA0310
*            COPY RAMF2 TO SCRATCH FILE WITH APPENDED KEY TO RECORD.     HPA0310
  300 DO 400 K = 1,RLIM                                                  HPA0310
      KEY = SA(K,L) .AND. O"7777" 
      IF (KEY .EQ. 0) GO TO 900                                          HPA0310
      CALL READMS (RAMF2,IREC2,8,KEY)                                    HPA0310
      QRA = SA(K,U)                                                      HPA0310
      QRB = SA(K,L) .AND. O"7777 7777 7777 7777 0000" 
      CALL RMWRITE (WDEST,QREC2,10) 
                                                                         HPA0310
  400 CONTINUE                                                           HPA0310
      GO TO 950                                                          HPA0310
                                                                         HPA0310
  900 CALL FLUSH2 (IREC,PFLAG)                                           HPA0310
      IF (PFLAG .EQ. 1) GO TO 950                                        HPA0310
      CALL RMWRITE (WDEST,IREC,8) 
      ROUT = ROUT + 1                                                    HPA0310
                                                                         HPA0310
  950 CALL RMFILEM (WDEST)
      CALL RMREWND (WDEST)
                                                                         HPA0310
      RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE RMERG2                                                  HPA0310
*                                                                        HPA0310
*         READ RAMF2 AND MERGE WITH (RDEST) FILE, WRITING TO (WDEST)     HPA0310
*        --  WITH APPENDED KEY, IF  SEGF  = 3 OR 4.                      HPA0310
*                                                                        HPA0310
*           CALLED BY  --  HSORT2                                        HPA0310
*                                                                        HPA0310
                                                                         HPA0310
*CALL,HPACOM1                                                            HPA0310
  
      COMMON /S2/  IREC(8),IRA,IRB,IREC2(8),QRA,QRB,
     .RAMF2,RLIM,SA(1024,2),SCR4,SCR5,U,L 
      COMMON /S3/ KEYT(12,4),KYK, RINK,ROUT,RDEST,SEGF,SEGL,WDEST        HPA0310
                                                                         HPA0310
      DIMENSION QREC(10),QREC2(10)                                       HPA0310
      EQUIVALENCE (IREC(1),QREC(1)),(IREC2(1),QREC2(1))                  HPA0310
                                                                         HPA0310
*         READ INITIAL RDEST RECORD.                                     HPA0310
      IF (FEOF(RDEST) .EQ. 3HYES) GO TO 185                              HPA0310
      CALL RMREAD (RDEST,QREC2,LENGTH)
                                                                         HPA0310
      DO 200 K = 1,RLIM                                                  HPA0310
      KEY = SA(K,L) .AND. O"7777" 
      IF (KEY .NE. 0) GO TO 120                                          HPA0310
      IF (FEOF(RDEST) .EQ. 3HYES) GO TO 800                              HPA0310
      FEOF(RAMF2) = 3HYES                                                HPA0310
      SA(K,L) = L"Z"
      GO TO 600                                                          HPA0310
                                                                         HPA0310
  120 CALL READMS (RAMF2,IREC,8,KEY)                                     HPA0310
                                                                         HPA0310
*        COMPARE KEYS                                                    HPA0310
  150 IF (SA(K,U) .LT. QRA) GO TO 190                                    HPA0310
      IF (QRA .LT. SA(K,U)) GO TO 180                                    HPA0310
      T = SA(K,L) .AND. O"7777 7777 7777 7777 0000" 
      IF (T .LT. QRB) GO TO 190                                          HPA0310
                                                                         HPA0310
  180 CALL RMWRITE (WDEST,QREC2,10) 
      IF (FEOF(RDEST) .EQ. 3HYES) GO TO 185                              HPA0310
      CALL RMREAD (RDEST,QREC2,LENGTH)
      IF (FEOF(RDEST) .NE. 3HYES) GO TO 150 
  
  185 CONTINUE
      QRA = L"Z"
      IF (FEOF(RAMF2) .EQ. 3HYES) GO TO 800                              HPA0310
      GO TO 150                                                          HPA0310
                                                                         HPA0310
  190 IRA = SA(K,U)                                                      HPA0310
      IRB = SA(K,L) .AND. O"7777 7777 7777 7777 0000" 
      CALL RMWRITE (WDEST,QREC,10)
  200 CONTINUE                                                           HPA0310
                                                                         HPA0310
      IF (FEOF(RDEST) .EQ. 3HYES) GO TO 800                              HPA0310
  600 CALL RMWRITE (WDEST,QREC2,10) 
      CALL RMREAD (RDEST,QREC2,LENGTH)
      IF (FEOF(RDEST) .NE. 3HYES) GO TO 600 
  
  800 CALL RMREWND (RDEST)
      CALL RMFILEM (RDEST)
      CALL RMREWND (RDEST)
      CALL RMFILEM (WDEST)
      CALL RMREWND (WDEST)
                                                                         HPA0310
  900 RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE RMERGF2                                                 HPA0310
*                                                                        HPA0310
*         READ RAMF2 AND MERGE WITH (RDEST) FILE, WRITING TO (WDEST)     HPA0310
*                                                                        HPA0310
*            CALLED BY  -- HSORT2                                        HPA0310
*                                                                        HPA0310
                                                                         HPA0310
*CALL,HPACOM1                                                            HPA0310
  
      COMMON /S2/  IREC(8),IRA,IRB,IREC2(8),QRA,QRB,
     .RAMF2,RLIM,SA(1024,2),SCR4,SCR5,U,L 
      COMMON /S3/ KEYT(12,4),KYK, RINK,ROUT,RDEST,SEGF,SEGL,WDEST        HPA0310
                                                                         HPA0310
      DIMENSION QREC(10),QREC2(10)                                       HPA0310
      EQUIVALENCE (IREC(1),QREC(1)),(IREC2(1),QREC2(1))                  HPA0310
                                                                         HPA0310
*         READ INITIAL RDEST RECORD.                                     HPA0310
      IF (FEOF(RDEST) .EQ. 3HYES) GO TO 185                              HPA0310
      CALL RMREAD (RDEST,QREC2,LENGTH)
                                                                         HPA0310
      DO 200 K = 1,RLIM                                                  HPA0310
      KEY = SA(K,L) .AND. O"7777" 
      IF (KEY .NE. 0) GO TO 120                                          HPA0310
      IF (FEOF(RDEST) .EQ. 3HYES) GO TO 800                              HPA0310
      FEOF(RAMF2) = 3HYES                                                HPA0310
      SA(K,L) = L"Z"
      GO TO 600                                                          HPA0310
                                                                         HPA0310
  120 CALL READMS (RAMF2,IREC,8,KEY)                                     HPA0310
                                                                         HPA0310
*        COMPARE KEYS                                                    HPA0310
  150 IF (SA(K,U) .LT. QRA) GO TO 190                                    HPA0310
      IF (QRA .LT. SA(K,U)) GO TO 180                                    HPA0310
      T = SA(K,L) .AND. O"7777 7777 7777 7777 0000" 
      IF (T .LT. QRB) GO TO 190                                          HPA0310
                                                                         HPA0310
  180 CALL PROUT2 (IREC2)                                                HPA0310
      IF (FEOF(RDEST) .EQ. 3HYES) GO TO 185                              HPA0310
      CALL RMREAD (RDEST,QREC2,LENGTH)
      IF (FEOF(RDEST) .NE. 3HYES) GO TO 150 
  
  185 CONTINUE
      QRA = L"Z"
      IF (FEOF(RAMF2) .EQ. 3HYES) GO TO 800                              HPA0310
      GO TO 150 
                                                                         HPA0310
  190 CALL PROUT2 (IREC)                                                 HPA0310
  200 CONTINUE                                                           HPA0310
                                                                         HPA0310
      IF (FEOF(RDEST) .EQ. 3HYES) GO TO 800                              HPA0310
                                                                         HPA0310
  600 CALL PROUT2 (IREC2)                                                HPA0310
      CALL RMREAD (RDEST,QREC2,LENGTH)
      IF (FEOF(RDEST) .NE. 3HYES) GO TO 600 
                                                                         HPA0310
  800 CALL FLUSH2 (IREC,PFLAG)                                           HPA0310
      IF (PFLAG .EQ. 1) GO TO 850                                        HPA0310
      CALL RMWRITE (WDEST,IREC,8) 
      ROUT = ROUT + 1                                                    HPA0310
                                                                         HPA0310
  850 CALL RMREWND (RDEST)
      CALL RMFILEM (RDEST)
      CALL RMREWND (RDEST)
      CALL RMFILEM (WDEST)
      CALL RMREWND (WDEST)
                                                                         HPA0310
  900 RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE SALOAD2 (INF)                                           HPA0310
*                                                                        HPA0310
**
*         *SALOAD2* READS THE RECORDS TO BE SORTED FROM FILE INF, LOADS 
*         THE SA ARRAY AND WRITES THEM TO FILE RAMHF.  IT ENABLES THE 
*         READING OF MULTI-FILES.  IT CALLS *EDIT2* TO PERFORM EDITING, 
*         HUID AND BYPASSING OPERATIONS.  *INVERPT2* IS CALLED TO 
*         EVOKE AN INTERVENTION REPORT FOR URGENT TAPE ERRORS.
* 
*         CALLED BY - HSORT2
* 
*CALL,HPACOM1                                                            HPA0310
      COMMON /S1/ KDD,KPP,KQQ,KRR,PAS,PSTART                             HPA0310
      COMMON /S2/  IREC(8),IRA,IRB,IREC2(8),QRA,QRB,
     .RAMF2,RLIM,SA(1024,2),SCR4,SCR5,U,L 
      COMMON /S3/ KEYT(12,4),KYK, RINK,ROUT,RDEST,SEGF,SEGL,WDEST        HPA0310
                                                                         HPA0310
*     DEFINE INTERVENTION REPORT ORDINALS 
      DIMENSION LISTERR(2,10) 
      DATA (LISTERR(1,I),I=1,10,1) /O"271", O"274",  O"24", O"261", O"26
     .2", O"263", O"264", O"000", O"000", O"000"/ 
      DATA (LISTERR(2,I), I=1,10,1) / 1,1,6,5,3,2,2,7,0,0 / 
      DATA NLIMIT / 8 / 
  
      PAS = 1                                                            HPA0310
                                                                         HPA0310
*        CLEAR (SA) ARRAY FOR NEW BLOCK.                                 HPA0310
      DO 50 K = 1,RLIM                                                   HPA0310
      SA(K,U) = L"Z"
   50 SA(K,L) = 0                                                        HPA0310
                                                                         HPA0310
  100 CALL RMREAD (INF,SEFREC,LENGTH) 
      IF (FEOF(INF) .NE. 3HYES) GO TO 150                                HPA0310
      IF (FLAGS(9) .NE. 1) GO TO 140
      FP = IFETCH(FITTBL(1,INF),L"FP")
      IF (FP .EQ. O"100") GO TO 140 
* 
*     HANDLE INF FILE FOR FIRST SORT AT END OF PARTITION (FP = 40B).
*     INF MAY BE MULTI-FILE, SO CLOSE AND OPEN TO SEQUENCE BEYOND EOI.
      CALL CLOSEM (FITTBL(1,INF),L"N")
      CALL OPENM (FITTBL(1,INF),L"INPUT",L"N")
      GO TO 100 
  
*        FILE TO BE SORTED HAS BEEN EXHAUSTED 
  140 SEGF = 5
      IF (SEGL .EQ. 1) SEGF = 1                                          HPA0310
      GO TO 900                                                          HPA0310
                                                                         HPA0310
  150 RINK = RINK + 1                                                    HPA0310
      IF (FLAGS(9) .NE. 1) GO TO 200
  
*     CHECK IF INTERVENTION REPORT NEEDED FOR URGENT TAPE ERRORS
      RTY = SHIFT(SEFREC(1),-42) .AND. O"777" 
      IF ((RTY .LT. O"30") .OR. (RTY .GT. O"37")) GO TO 200 
      MTY = SEFREC(1) .AND. O"7777" 
      DO 170 I = 1, NLIMIT
      IF (MTY .EQ. LISTERR(1,I)) THEN 
         CALL XOVCAP ('INVRPT2',SEFREC,LISTERR(2,I))
         CALL UOVCAP ('INVRPT2')
      ENDIF 
  170 CONTINUE
                                                                         HPA0310
*        WRITE RECORD TO RAMHF FROM (SEFREC)                             HPA0310
                                                                         HPA0310
  200 CALL WRITMS (RAMF2,SEFREC,8,PAS,-1)                                HPA0310
                                                                         HPA0310
*        EXTRACT KEYS AND WRITE IN (SA)                                  HPA0310
                                                                         HPA0310
*       USABLE SPACE , IN KEY WORD, COUNT                                HPA0310
      USP = 58                                                           HPA0310
      USP2 = 47                                                          HPA0310
      SAW = 1                                                            HPA0310
*       KEYT TABLE POINTER                                               HPA0310
      SA(PAS,1) = 0                                                      HPA0310
      KEK = 0                                                            HPA0310
                                                                         HPA0310
  300 KEK = KEK + 1                                                      HPA0310
*       TEST END OF KEYT TABLE                                           HPA0310
      IF (KEK .GT. KYK) GO TO 400                                        HPA0310
*        SET UP EXTRACT CONTROLS                                         HPA0310
      WD = KEYT(KEK,1)                                                   HPA0310
*            LEFT SHIFT COUNT                                            HPA0310
      LSK = KEYT(KEK,2) .AND. O"77" 
*            BIT COUNT                                                   HPA0310
      KBIT = SHIFT(KEYT(KEK,2),-30)                                      HPA0310
*            MASK                                                        HPA0310
      KMASK = KEYT(KEK,3)                                                HPA0310
                                                                         HPA0310
*            KEY PROCESSING                                              HPA0310
      FIELD = SHIFT(SEFREC(WD),LSK) .AND. KMASK                          HPA0310
      IF (KEYT(KEK,4) .EQ. 10HA           ) GO TO 320                    HPA0310
      FIELD = 0 - FIELD                                                  HPA0310
      FIELD = FIELD .AND. KMASK                                          HPA0310
                                                                         HPA0310
  320 IF (USP .GE. KBIT) GO TO 330                                       HPA0310
                                                                         HPA0310
*           LOAD PARTIAL KEY INTO END OF TABLE WORD                      HPA0310
      PKBIT = USP                                                        HPA0310
      RSHIFT = KBIT - USP                                                HPA0310
      PFIELD = SHIFT (FIELD,-RSHIFT)                                     HPA0310
      SA (PAS,SAW) = SHIFT(SA(PAS,SAW),PKBIT) .OR. PFIELD                HPA0310
      MRS = MASK(RSHIFT)                                                 HPA0310
      MRS = SHIFT(MRS,RSHIFT)                                            HPA0310
      FIELD = FIELD .AND. MRS                                            HPA0310
      USP2 = USP2 - RSHIFT                                               HPA0310
      GO TO 340                                                          HPA0310
                                                                         HPA0310
*             LOAD AND SHIFT KEY TO POSITION                             HPA0310
  330 SA(PAS,SAW) = SHIFT(SA(PAS,SAW),KBIT) .OR. FIELD                   HPA0310
      USP = USP - KBIT                                                   HPA0310
      GO TO 300                                                          HPA0310
                                                                         HPA0310
  340 SAW = SAW + 1                                                      HPA0310
*           ERROR EXIT (TOO MANY KEYS)                                   HPA0310
      IF (SAW .GT. 2) GO TO 500                                          HPA0310
      USP = USP2                                                         HPA0310
      SA(PAS,SAW) = FIELD                                                HPA0310
      GO TO 300                                                          HPA0310
                                                                         HPA0310
*           MAKE SPACE FOR ORDINAL                                       HPA0310
  400 SA(PAS,2) = SHIFT(SA(PAS,2),12)                                    HPA0310
                                                                         HPA0310
                                                                         HPA0310
      SA(PAS,L) = SA(PAS,L) .OR. PAS                                     HPA0310
      PAS = PAS + 1                                                      HPA0310
                                                                         HPA0310
      IF (PAS .LT. RLIM) GO TO 100                                       HPA0310
      GO TO 900                                                          HPA0310
                                                                         HPA0310
  500 PRINT 510                                                          HPA0310
  510 FORMAT (/,'  TOO MANY SORT KEYS  -- (SALOAD2) ',/)
                                                                         HPA0310
                                                                         HPA0310
*      PAD REMAINING BUFFER WITH MAX NUMBER                              HPA0310
  900 IF (PAS. GE. RLIM) GO TO 990                                       HPA0310
                                                                         HPA0310
      DO 910 K = PAS,RLIM                                                HPA0310
      SA(K,U) = L"Z"
  910 SA(K,L) = 0                                                        HPA0310
                                                                         HPA0310
  990 PAS = PAS - 1                                                      HPA0310
      RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE SAORD2                                                  HPA0310
*                                                                        HPA0310
*          ORDER DATA IN (SA) ARRAY BY DESIGNATED KEYS                   HPA0310
*                                                                        HPA0310
*          CALLED BY  -- HSORT2                                          HPA0310
*                                                                        HPA0310
*                                                                        HPA0310
      IMPLICIT INTEGER (F-Z)
      COMMON /S1/ KDD,KPP,KQQ,KRR,PAS,PSTART                             HPA0310
                                                                         HPA0310
*      COMPUTE PSTART                                                    HPA0310
   50 PSTART = PSTART * 2                                                HPA0310
      IF (PSTART .GE. PAS) GO TO 100                                     HPA0310
      GO TO 50                                                           HPA0310
                                                                         HPA0310
  100 PSTART = PSTART / 2                                                HPA0310
      KPP = PSTART                                                       HPA0310
                                                                         HPA0310
*         INITIALIZE Q,R,D                                               HPA0310
  200 KQQ = PSTART                                                       HPA0310
      KRR = 0                                                            HPA0310
      KDD = KPP                                                          HPA0310
                                                                         HPA0310
*         LOOP ON I                                                      HPA0310
  300 CALL LOOPC2                                                        HPA0310
                                                                         HPA0310
*         LOOP ON Q                                                      HPA0310
  500 IF (KQQ .EQ. KPP) GO TO 600                                        HPA0310
      KDD = KQQ - KPP                                                    HPA0310
      KQQ = KQQ / 2                                                      HPA0310
      KRR = KPP                                                          HPA0310
      GO TO 300                                                          HPA0310
                                                                         HPA0310
*         LOOP ON P                                                      HPA0310
  600 KPP = KPP / 2                                                      HPA0310
      IF (KPP .GE. 1) GO TO 200                                          HPA0310
      RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE SMKEY2 (KY1,KY2,KY3,KY4,KY5,KY6)                        HPA0310
*                                                                        HPA0310
*                                                                        HPA0310
*          SMKEY2  --  OBTAIN SORT KEY DEFINITIONS FROM PARAMETERS       HPA0310
*                      AND PLACE EXTRACT CODES IN ARRAY (KEYT),          HPA0310
*                      FOR USE BY ROUTINE (SALOAD).                      HPA0310
*                                                                        HPA0310
*           CALLED BY  -- STFACE2                                        HPA0310
*                                                                        HPA0310
      IMPLICIT INTEGER (F-Z)
      COMMON /S3/ KEYT(12,4),KYK, RINK,ROUT,RDEST, SEGF,SEGL,WDEST       HPA0310
                                                                         HPA0310
*     KY1 = CHAR POS OF KEY (6 BIT CHAR), FROM LEFT OF WD-1.             HPA0310
*     KY2 = POSITION OF 1ST BIT OF KEY                                   HPA0310
*     KY3 = NO. OF CHARACTERS OF KEY.                                    HPA0310
*     KY4 = NO. OF BITS IN EXCESS OF (N) CHAR.                           HPA0310
*     KY5 = CODE TYPE, (LOGICAL IS USED IN HPA)                          HPA0310
*     KY6 = ORDER  (-A-, OR -D-)                                         HPA0310
                                                                         HPA0310
*     KEY ARRAY (KEYT) USAGE .........                                   HPA0310
                                                                         HPA0310
*     N,1 = WORD POINTER IN INPUT RECORD.                                HPA0310
*     N,2 = (UPPER 30) = BITCOUNT OF KEY,                                HPA0310
*           (LOWER 30) = LEFT SHIFT COUNT, TO RIGHT JUSTIFY.             HPA0310
*     N,3 = MASK, TO EXTRACT KEY FROM WORD (RIGHT JUSTIFIED).            HPA0310
*     N,4 = ASCENDING, OR DESCENDING FLAG.                               HPA0310
*                                                                        HPA0310
*        KEYT ARRAY WORD POINTER                                         HPA0310
      KYK = KYK + 1                                                      HPA0310
      RS = KY1                                                           HPA0310
                                                                         HPA0310
*       EXTRACT WORD COUNT                                               HPA0310
   20 KEYT (KYK,1) = KEYT(KYK,1) +1                                      HPA0310
      IF (RS .LE. 10) GO TO 30                                           HPA0310
      RS = RS - 10                                                       HPA0310
      GO TO 20                                                           HPA0310
                                                                         HPA0310
*        EXTRACT BIT COUNT                                               HPA0310
   30 KBIT = KY3 * 6                                                     HPA0310
      KBIT = KBIT + KY4                                                  HPA0310
      KEYT(KYK,2) = SHIFT(KBIT,30)                                       HPA0310
                                                                         HPA0310
*       FORM MASK VALUE                                                  HPA0310
      TM = 60 - KBIT                                                     HPA0310
      KEYT (KYK,3) = (.NOT.MASK(TM))
                                                                         HPA0310
*       COMPUTE LEFT SHIFT COUNT                                         HPA0310
      LB = 66 - (RS*6)                                                   HPA0310
      LB = LB - (KY2-1)                                                  HPA0310
      LSK = 60 - LB +KBIT                                                HPA0310
      KEYT(KYK,2) = KEYT(KYK,2) .OR. LSK                                 HPA0310
                                                                         HPA0310
*      ORDER FLAG                                                        HPA0310
      KEYT(KYK,4) = KY6                                                  HPA0310
                                                                         HPA0310
      RETURN                                                             HPA0310
      END                                                                HPA0310
      SUBROUTINE STFACE2 (INF,OUTF)                                      HPA0310
*                                                                        HPA0310
***       DESCRIPTION                                                    HPA0310
*         -----------                                                    HPA0310
*         SELECT SORT TO BE PERFORMED AND SELECT SORT KEYS               HPA0310
*         PRIOR TO CALLING CONTROL ROUTINE HSORT2.                       HPA0310
*                                                                        HPA0310
*        CALLED BY  --  HPA2                                             HPA0310
*                                                                        HPA0310
*CALL,HPACOM1                                                            HPA0310
*CALL COMHPASPE 
      CALL INIDAT2 (1)                                                   HPA0310
  
*     TIME PRINT OUT CONTROLLED BY ( X=T) PARAMETER 
      IF (FROG(6) .NE. L"T") GO TO 5
      CP = SECOND ()
      PRINT 4,CP
    4 FORMAT ( ' ENTER HPA21, SECOND = ',F10.3) 
    5 CONTINUE
*                                                                        HPA0310
      SORTKEY = FLAGS(9)                                                 HPA0310
      DO 10 I=1,8 
10    IOUT1(I)=0
      IF (SORTKEY .EQ. 2) GO TO 40                                       HPA0310
      IF (SORTKEY .EQ. 3) GO TO 50                                       HPA0310
*                                                                        HPA0310
*     SORT BY DEVICE TYPE, HUID OR EST, RECORD TYPE,
*             EQUIPMENT/UNIT, ERROR TYPE, YEAR/DATE AND TIME
*     SORTKEY = 1                                                        HPA0310
*                                                                        HPA0310
*                                                                        HPA0310
*        SORT ON DEVICE TYPE                                             HPA0310
      CALL SMKEY2 (19,2,1,5,'LOGICAL','A')
      IF (FLAGS(25) .EQ. 0) GO TO 15
  
*        SORT ON HUID 
      CALL SMKEY2 (29,1,2,0,'LOGICAL','A')
      GO TO 25
   15 CONTINUE
*                                                                        HPA0310
*         SORT ON EST                                                    HPA0310
      CALL SMKEY2(17,1,2,0,'LOGICAL','A') 
   25 CONTINUE
*                                                                        HPA0310
*        SORT BY RECORD TYPE                                             HPA0310
      CALL SMKEY2(2,4,1,3,'LOGICAL','A')
*                                                                        HPA0310
*        SORT ON EQUIPMENT, UNIT                                         HPA0310
      CALL SMKEY2 (5,1,1,3,'LOGICAL','A') 
*                                                                        HPA0310
*        SORT ON ERROR TYPE                                              HPA0310
      CALL SMKEY2 (9,1,2,0,'LOGICAL','A') 
*                                                                        HPA0310
*        SORT ON YEAR, DATE                                              HPA0310
      CALL SMKEY2(6,4,2,3,'LOGICAL','A')
*                                                                        HPA0310
*        SORT ON TIME                                                    HPA0310
      CALL SMKEY2 (11,1,3,0,'LOGICAL','A')
      PASS = 0
      GO TO 65                                                           HPA0310
*                                                                        HPA0310
*     SORT BY YEAR, DAY, TIME                                            HPA0310
*     SORTKEY = 2                                                        HPA0310
*                                                                        HPA0310
   40 CONTINUE                                                           HPA0310
*                                                                        HPA0310
*        SORT ON YEAR, DATE                                              HPA0310
      CALL SMKEY2 ( 6,4,2,3,'LOGICAL','D')
*                                                                        HPA0310
*        SORT ON TIME                                                    HPA0310
      CALL SMKEY2 ( 11,1,3,0,'LOGICAL','A') 
      GO TO 65                                                           HPA0310
*                                                                        HPA0310
*     SORT BY TAPE VSN, EST, YEAR/DATE AND JOB NAME 
*     SORTKEY = 3                                                        HPA0310
*                                                                        HPA0310
   50 CONTINUE
      IF (FROG(5) .NE. L"SS") GO TO 55
* 
*       SORT ON MASSTOR 7990 CSN
      CALL SMKEY2(31,01,10,00,'LOGICAL','A')
      GO TO 60
* 
*        SORT ON TAPE VSN                                                HPA0310
   55 CALL SMKEY2(41,01,06,00,'LOGICAL','A')
*                                                                        HPA0310
*        SORT ON EST                                                     HPA0310
   60 CONTINUE
      CALL SMKEY2(17,01,02,00,'LOGICAL','A')
*                                                                        HPA0310
*        SORT ON YEAR, DATE                                              HPA0310
      CALL SMKEY2(6,4,2,3,'LOGICAL','A')
  
      IF (FROG(5) .EQ. L"SS") GO TO 62
  
*                                                                        HPA0310
*        SORT ON JOB NAME                                                HPA0310
*     NOTE: HPSORT - 3 USES ONLY 7 LOWER CHARACTERS OF JOB NAME,
*           DUE TO LIMITATIONS OF SUBROUTINE SALOAD2 ARRAY. 
      CALL SMKEY2 (22,01,07,00,'LOGICAL','A') 
                                                                         HPA0310
   62 CONTINUE
      AENTRYS = AERRSUM = ASUMM = IEST = INVSN = NEST = 0 
  
   65 CALL HSORT2 (INF,OUTF)                                             HPA0310
      RETURN                                                             HPA0310
      END                                                                HPA0310
*ENDIF
*IF,-DEF,HPSORT 
      SUBROUTINE STFACE2 (INF,OUTF) 
* 
***       DESCRIPTION 
*         ----------- 
*         SORT SEF FILE BY CALLS TOSORT/MERGE.
*CALL,HPACOM1 
*CALL COMHPASPE 
  
      EXTERNAL FLUSH2, ISUM2, POST2, RDSORT2, RDSRT2A 
  
  
*     TIME PRINT OUT CONTROLLED BY ( X=T) PARAMETER 
      IF (FROG(6) .NE. L"T") GO TO 10 
      CP = SECOND ()
      PRINT 9,CP
    9 FORMAT ( ' ENTER HPA21, SECOND = ',F10.3) 
   10 CONTINUE
      CALL SM5SORT(0) 
      CALL SM5OFL(80) 
      CALL SM5ENR(1450) 
      CALL SM5TO(FITTBL(1,OUTF))
      CALL SM5RETA ('YES')
* 
      SORTKEY = FLAGS(9)
      IF (SORTKEY .EQ. 2) GO TO 40
      IF (SORTKEY.EQ.3) GO TO 45
* 
*     SORT BY DEVICE TYPE, HUID OR EST, RECORD TYPE,
*             EQUIPMENT/UNIT, ERROR TYPE, YEAR/DATE AND TIME
*     SORTKEY = 1 
* 
*        SORT ON DEVICE TYPE                                             HPA402R
      CALL SM5KEY (110,11,'BINARY_BITS','A')
      IF(FLAGS(25).EQ.0) GO TO 15 
  
*         SORT ON HUID
      CALL SM5KEY (169,12,'BINARY_BITS','A')
      GO TO 25
   15 CONTINUE
*                                                                        HPA403T
*         SORT ON EST                                                    HPA403T
      CALL SM5KEY (97,12,'BINARY_BITS','A') 
   25 CONTINUE
*                                                                        HPA402R
*        SORT BY RECORD TYPE                                             HPA402R
      CALL SM5KEY (10,9,'BINARY_BITS','A')
*                                                                        HPA402R
*        SORT ON EQUIPMENT, UNIT                                         HPA402R
      CALL SM5KEY (25,9,'BINARY_BITS','A')
*                                                                        HPA402R
*        SORT ON ERROR TYPE                                              HPA402R
      CALL SM5KEY (49,12,'BINARY_BITS','A') 
*                                                                        HPA402R
*        SORT ON YEAR, DATE                                              HPA402R
      CALL SM5KEY (34,15,'BINARY_BITS','A') 
*                                                                        HPA402R
*        SORT ON TIME                                                    HPA402R
      CALL SM5KEY (61,18,'BINARY_BITS','A') 
      PASS=0
      CALL SM5OWN1 (RDSORT2)
      CALL SM5OWN2 (RDSRT2A)
      CALL SM5OWN3 (POST2)
      CALL SM5OWN4 (FLUSH2) 
      GO TO 65
* 
*     SORT BY YEAR, DAY, TIME 
*     SORTKEY = 2 
* 
   40 CONTINUE                                                           R2FCYBE
      CALL SM5FROM(FITTBL(1,INF)) 
*                                                                        HPA402R
*        SORT ON YEAR, DATE                                              HPA402R
      CALL SM5KEY (34,15,'BINARY_BITS','D') 
*                                                                        HPA402R
*        SORT ON TIME                                                    HPA402R
      CALL SM5KEY (61,18,'BINARY_BITS','A') 
      GO TO 65
* 
*     SORT BY TAPE VSN, EST, YEAR/DATE AND JOB NAME 
*     SORTKEY = 3 
* 
   45 CONTINUE
      CALL SM5FROM(FITTBL(1,INF)) 
      IF (FROG(5) .NE. L"SS") GO TO 50
* 
*      SORT ON MASSTOR 7990 CSN 
      CALL SM5KEY (181,60,'BINARY_BITS','A')
      GO TO 55
* 
*       SORT ON TAPE VSN AND CONTINUATION REEL NUMBER 
   50 CALL SM5KEY (241,48,'BINARY_BITS','A')
*                                                                        HPA402R
*        SORT ON EST                                                     HPA402R
   55 CALL SM5KEY (97,12,'BINARY_BITS','A') 
*                                                                        HPA402R
*        SORT ON YEAR, DATE                                              HPA402R
      CALL SM5KEY (34,15,'BINARY_BITS','A') 
*                                                                        HPA402R
*        SORT ON JOB NAME                                                HPA402R
      CALL SM5KEY (121,48,'BINARY_BITS','A')
  
      AENTRYS = AERRSUM = ASUMM = IEST = INVSN = NEST = 0 
      IF (FROG(5).EQ.L"SS") GO TO 65
      CALL SM5OWN3 (ISUM2)
* 
* 
   65 CALL SM5END 
      CALL OPENM(FITTBL(1,INF),'I-O','R') 
      CALL OPENM(FITTBL(1,OUTF),'I-O','R')
      RETURN
      END 
      SUBROUTINE RDSORT2(RETCODE,OUT,RL)
* 
**
*         *RDSORT2* IS THE FIRST SORT OWNCODE EXIT 1 ROUTINE, WHICH 
*         OBTAINS THE RECORDS TO BE SORTED.  IT ENABLES THE READING 
*         OF A MULTI-FILE RSEF.  *INVRPT2* IS CALLED TO 
*         EVOKE AN INTERVENTION REPORT FOR URGENT TAPE ERRORS.
* 
*         *RDSRT2A* IS THE FIRST SORT OWNCODE EXIT 2 ROUTINE WHICH
*         TERMINATES THE PROCESSING OF THE RSEF INPUT FILE. 
* 
*CALL HPACOM1 
  
      EXTERNAL RMDXIT 
  
      DIMENSION INX(8), IN(8), OUT(8) 
  
*     DEFINE INTERVENTION REPORT ORDINALS 
      DIMENSION LISTERR(2,10) 
      DATA (LISTERR(1,I),I=1,10,1) /O"271", O"274",  O"24", O"261", O"26
     ,2", O"263", O"264", O"000", O"000", O"000"/ 
      DATA (LISTERR(2,I), I=1,10,1) / 1,1,6,5,3,2,2,7,0,0 /              R2FTAPE
      DATA NLIMIT / 8 /                                                  R2FTAPE
  
      DATA ALTBF/0/, LASTP/0/ 
  
*     READ THE NEXT RSEF RECORD 
   10 CALL STOREF (FITTBL(1,RSEF),L"DX",RMDXIT) 
      CALL RMREAD (RSEF,INX,LENGTH) 
      IF (FEOF(RSEF) .NE. 3HYES) GO TO 20 
      FP = IFETCH(FITTBL(1,RSEF),L"FP") 
      IF (FP.EQ.O"100")  THEN 
          RETCODE = 3 
          RETURN
      ENDIF 
  
*     HANDLE RSEF FILE AT END OF PARTITION (FP = 40B).
*     RSEF MAY BE MULTI-FILE, SO CLOSE AND OPEN TO SEQUENCE BEYOND EOI. 
      CALL CLOSEM (FITTBL(1,RSEF),L"N") 
      CALL OPENM (FITTBL(1,RSEF),L"INPUT",L"N") 
      GO TO 10
  
*     CHECK FOR READING OF FIRST RSEF RECORD
   20 CONTINUE
  
*  DISCARD THE CARTRIDGE TAPE TYPE 61 ENTRIES 
  
      IF ((INX(1) .AND. O"0007 7700 0000 0000 7777") .EQ. 
     .  O"0000 4700 0000 0000 0061") GO TO 10 
  
      IF(ALTBF.NE.0)GO TO 50
      ALTBF=1 
* 
*     SKIP PROCESSING OF THIS RECORD (ARRAY IN), DUE TO PUMP PRIMING, 
*     EDITING OR BYPASSING.  IF RSEF FILE TERMINATED, (OWNCODE EXIT 2,
*     RDSRT2A), CONCLUDE PROCESSING.  ELSE, MOVE LAST RECORD READ 
*     (FROM ARRAY INX TO ARRAY IN) BEFORE READING THE NEXT RECORD.
  
      IF (LASTP.EQ.1)  THEN 
         RETCODE = 0
         RETURN 
      ENDIF 
      DO 40 I = 1,8 
   40 IN(I) = INX(I)
      GO TO 10
  
*     PROCESS THE RSEF RECORD (INX(8) = RECORD JUST READ) 
*                             (IN(8)  = RECORD SAVED FROM PREVIOUS READ)
*                             (OUT(8) = RECORD PASSED ON TO SORT) 
  
*     CHECK IF INTERVENTION REPORT NEEDED FOR URGENT TAPE ERRORS
   50 RTY = SHIFT(IN(1),-42) .AND. O"777" 
      IF (((RTY .LT. O"30") .OR. (RTY .GT. O"37")) .AND.
     .     (RTY .NE. O"47") .AND. (RTY .NE. O"55")) GO TO 100 
      MTY = IN(1) .AND. O"7777" 
      DO 70 I = 1, NLIMIT 
      IF (MTY .NE. LISTERR(1,I)) GO TO 70 
      CALL XOVCAP ('INVRPT2',IN,LISTERR(2,I)) 
      CALL UOVCAP ('INVRPT2') 
   70 CONTINUE
  
 100  CONTINUE
      DO 120 K=1,8
      OUT(K) = IN(K)
  120 IN(K)=INX(K)
                                                                        000350
*     PASS ON RSEF RECORD TO SORT VIA ARRAY OUT(8)
      RETCODE = LASTP 
      RL = 80 
      RETURN
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*     ENTRY RDSRT2A 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
      ENTRY RDSRT2A 
      LASTP=1 
      IF (ALTBF.EQ.0)  THEN 
         RETCODE = 0
         RETURN 
      ENDIF 
      ALTBF=0 
      GO TO 50
  
      END 
      SUBROUTINE FLUSH2(RETCODE,IOUT2,RL) 
**    FLUSH2 - FLUSH LAST RECORD OUT OF HOLDING AREA AT END OF SORT 
* 
*     ENTRY    LAST RECORD HAS BEEN WRITTEN TO OUTPUT FILE
* 
*     EXIT     REMAINING RECORD (IN OUT1) PASSED TO OUTPUT FILE 
* 
*     USES    OUT2
  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
      IMPLICIT INTEGER (F-Z)
  
*CALL COMHPASPE 
  
      DIMENSION IOUT2(8)
  
      DO 100 I = 1, 8 
  100 IOUT2(I) = IOUT1(I) 
      IF (IOUT1(1).EQ.0)  THEN
         RETCODE = RL = 0 
         RETURN 
      ENDIF 
      IOUT1(1) = 0
      RETCODE = 1 
      RL = 80 
      RETURN
      END 
*ENDIF                                                                   HPA0310
      OVCAP.
      SUBROUTINE INVRPT2 (IN, ICODE)
* 
**    INVRPT  -  INTERVENTION REPORT
* 
*     ENTRY      ICODE = WHICH MESSAGE TO PRINT 
*                     01 - TAPE CONTROLLER ERROR - RUN CTLR TEST
*                     02 - UNIT DOWNED,LOOP W/R  - RUN UNIT TEST
*                     03 - CTLR DOWNED,LOOP W/R  - RUN CTLR TEST
*                     04 - UNIT DOWNED BY SYSTEM - RUN UNIT TEST
*                     05 - CHAN DOWNED BY SYSTEM - RUN CTLR TEST
*                     06 - CHANNEL PARITY ERROR  - RUN CTLR TEST
*                     07 - STATUS WORD 3 ERROR=EEE
* 
*                     (ALL MESSAGES PREFACED BY DATE, TIME, CHANNEL,
*                     EQUIPMENT, AND UNIT.) 
* 
*                    IN - BUFFER CONTAINING RECORD CAUSING PROBLEM
* 
*      EXIT          LINE AND TWIC HAVE BEEN UPDATED
* 
*      CALLS         HEADER 
*                    UNJUL2 
* 
*      CALLED BY     SORT/MERGE *RDSORT2* AND HPSORT *SALOAD2*
* 
*CALL HPACOM1 
  
      DIMENSION IN(8) 
      DATA TOTLIN /0/ 
* 
*     TEST FOR CONTINUATION RECORD
* 
      IF ((IN(3) .AND. MASK(48)) .EQ. L" CONTINU") GO TO 900
* 
*     TEST IF LINE LIMIT HAS BEEN EXCEEDED
* 
      IF (TOTLIN  .GT. FROG(12)) GO TO 900
      TOTLIN = TOTLIN + 1 
      IF (TOTLIN .LE. FROG(12)) GO TO 30
      PRINT 20
   20 FORMAT(1X,'LINE LIMIT EXCEEDED FOR INTERVENTION REPORT')
      GO TO 800 
* 
*      TEST TO SEE IF HEADER IS NECESSARY 
* 
   30 IF (TWIC .NE. 0) GO TO 90 
  
      IHDR = 28 
      CALL HEADER 
      PRINT 40
   40 FORMAT (/,24X,31H****                       ****,/
     .,24X,         31H****  INTERVENTION REPORT  ****,/
     .,24X,         31H****                       ****,//)
      LINE = LINE + 5 
      TWIC = LINE 
* 
*     PARSE DATA FROM INPUT RECORD WHICH MESSAGES WILL REQUIRE
* 
   90 ICHAN = SHIFT (IN(2),-36) .AND. O"77" 
      IEQUIP = SHIFT (IN(1),-33) .AND.  O"7"
      IUNIT = SHIFT (IN(1),-27) .AND. O"77" 
      IMFID = SHIFT (IN(1),-51) .AND. O"77" 
      NYR = SHIFT (IN(1),-21) .AND. O"77" 
      NDY = SHIFT (IN(1),-12) .AND. O"777"
      CALL UNJUL2 (NYR,NDY) 
      HRS = SHIFT (IN(2),6) .AND. O"77" 
      MIN = SHIFT (IN(2),12) .AND. O"77"
      SEC = SHIFT (IN(2),18) .AND. O"77"
      ENCODE (10,95,ITIME) HRS,MIN,SEC
   95 FORMAT (I2.2,2(1H.,I2.2),2X)
* 
*     PROCESS PRINT DIRECTIVES FROM CALLING PROGRAM 
* 
      GO TO (100,200,300,400,500,600,700) ICODE 
  
  100 PRINT 110,IYEAR,ITIME,ICHAN,IEQUIP,IUNIT,IMFID
  110 FORMAT (1X,2A9,'CH=',O2,',EQ=',O1,',UN=',O2,',MF=',R1,1X, 
     .'TAPE CONTROLLER ERROR  -RUN UNIT TEST')
      GO TO 800 
  
  200 PRINT 220,IYEAR,ITIME,ICHAN,IEQUIP,IUNIT,IMFID
  220 FORMAT (1X,2A9,'CH=',O2,',EQ=',O1,',UN=',O2,',MF=',R1,1X, 
     .'UNIT DOWNED,LOOP R/W  -RUN CTLR TEST') 
      GO TO 800 
  
  300 PRINT 310,IYEAR,ITIME,ICHAN,IEQUIP,IUNIT,IMFID
  310 FORMAT (1X,2A9,'CH=',O2,',EQ=',O1,',UN=',O2,',MF=',R1,1X, 
     .'CTLR DOWNED,LOOP R/W  -RUN CTLR TEST') 
      GO TO 800 
  
  400 PRINT 410,IYEAR,ITIME,ICHAN,IEQUIP,IUNIT,IMFID
  410 FORMAT (1X,2A9,'CH=',O2,',EQ=',O1,',UN=',O2,',MF=',R1,1X, 
     .'UNIT DOWNED BY SYSTEM  -RUN UNIT TEST')
      GO TO 800 
  
  500 PRINT 510,IYEAR,ITIME,ICHAN,IEQUIP,IUNIT,IMFID
  510 FORMAT (1X,2A9,'CH=',O2,',EQ=',O1,',UN=',O2,',MF=',R1,1X, 
     .'CHAN DOWNED BY SYSTEM  -RUN CTLR TEST')
      GO TO 800 
  
  600 PRINT 610,IYEAR,ITIME,ICHAN,IEQUIP,IUNIT,IMFID
  610 FORMAT (1X,2A9,'CH=',O2,',EQ=',O1,',UN=',O2,',MF=',R1,1X, 
     .'CHAN PARITY ERROR  -RUN CTLR TEST')
      GO TO 800 
  
  700 ISTAT = SHIFT(IN(6),-36) .AND. O"177" 
      PRINT 710,IYEAR,ITIME,ICHAN,IEQUIP,IUNIT,IMFID,ISTAT
  710 FORMAT (1X,2A9,'CH=',O2,',EQ=',O1,',UN=',O2,',MF=',R1,1X, 
     .'STATUS WORD 3 ERROR=',O3)
  
  800 LINE = LINE +1
      TWIC = TWIC +1
      IF (TWIC .GT. PLF) TWIC = 0 
  
  900 RETURN
      END 
      SUBROUTINE UNJUL2 ( NYEAR,NDAY )
* 
**        UNJUL2 -  CONVERTS JULIAN DATE INTO CALENDER DATE,
* 
*         DATA AREAS
*         --------------------- 
*         IMON   - (12)/LOCAL TO SUBROUTINE/TABLE OF DAYS OF
*                  EACH MONTH IN THE YEAR.
*         IT     - (1)/LOCAL TO SUBROUTINE/TEMPORARY USAGE. 
*         NYEAR  - (1)/LOCAL TO SUBROUTINE/FORMAL PARAMETER OF
*                  YEAR IN BINARY FORM BIASED BY 1970 AT ENTRY, 
*                  AND THE CALENDER DATE IN CODED FORM AT EXIT. 
*         NDAY   - (1)/LOCAL TO SUBROUTINE/FORMAL PARAMETER OF
*                  JULIAN DAY IN BINARY FORM. 
*         JYEAR  - (1)/LOCAL TO SUBROUTINE/YEAR IN BINARY FORM
*                  BIASED BY 1900.
*         KM     - (1)/LOCAL TO SUBROUTINE/COUNTER TO SET THE MONTH 
*                  OF THE YEAR. 
* 
*        EXIT CONDITION 
*        -------------- 
*        CALENDER DAY ENCODED IN COMMON WORD ( IYEAR ). 
* 
*CALL HPACOM1 
  
      DIMENSION IMON(12)
      DATA (IMON(I),I=1,12) /31,28,31,30,31,30,31,31,30,31,30,31/ 
*       *********************************************************** 
  
      IMON(2) = 28
      IT = NYEAR - 2
      JDAY = NDAY 
  
*        TEST FOR INVALID YEAR INPUT
      IF ( IT .LT. 100) GO TO 10
      PRINT 5,NYEAR 
    5 FORMAT ( ' UNJUL2 -- INVALID YEAR PARAMETER = ',I10)
      GO TO 900 
  
*        TEST FOR LEAP YEAR 
   10 IT = IT - 4 
      IF (IT .EQ. 0) IMON(2) = 29 
      IF (IT .GT. 0) GO TO 10 
* 
      DO 20 KM=1,12 
      IF (JDAY .LE. IMON(KM)) GO TO 50
   20 JDAY = JDAY - IMON(KM)
  
   50 JYEAR = NYEAR + 70
      IF (JYEAR .GT. 99) JYEAR = JYEAR - 100
      ENCODE (8,100,IYEAR) JYEAR,KM,JDAY
  100 FORMAT (I2.2,2('/',I2.2)) 
  
*           CURRENT MONTH    *******
      FLAGS(6) = KM 
* 
  900 RETURN
      END 
