DFSORT
***       THE *DFSORT* CONTROL STATEMENT SORTS THE *OUTPUT* FROM
*         THE DAYFILE DUMPING UTILITIES TO THE FILE SPECIFIED.
* 
*         THE CONTROL STATEMENT FORMAT IS - 
* 
*         DFSORT(D=LFN1,L=LFN2,S=AAA,F=999,TN=NAME) 
* 
*                LFN1 - NAME OF THE FILE TO SORT FROM.  IF THIS 
*                       PARAMETER IS OMITTED, FILE *DAYFILE* IS 
*                       ASSUMED.
* 
*                LFN2 - NAME OF THE FILE TO WRITE TO.  IF THIS
*                       PARAMETER IS OMITTED, FILE *OUTPUT* IS
*                       ASSUMED.
* 
*                AAA  - LAST THREE CHARACTERS OF THE JOB SEQUENCE 
*                       NUMBER TO START THE SORT.  IF THIS PARAMETER
*                       IS OMITTED, THE SORT BEGINS WITH THE
*                       CHARACTER STRING *AAA*. 
* 
*                999  - LAST THREE CHARACTERS OF THE JOB SEQUENCE 
*                       NUMBER TO STOP THE SORT.  IF THIS PARAMETER 
*                       IS OMITTED, THE SORT ENDS WITH THE
*                       CHARACTER STRING *999*. 
* 
*                NAME - TEST NAME IS ONE OF THE FOLLOWING - 
*                       P - THE TEST JOB PASSED.
*                       F - THE TEST JOB FAILED.
*                       QAQ - TEST JOB NAME.
  
  
          OVERLAY(DFSORT,0,0) 
          PROGRAM DFSORT(TAPE1,OUTPUT,TAPE2=OUTPUT, 
     1    TAPE3,TAPE4)
          COMMON /DATA/JOBS,JOBF,ITN
          DIMENSION JJOB(1000),III(1000),KK(1000) 
          DIMENSION LINE(8) 
          DIMENSION ICHAR(50) 
          DIMENSION JOB(1000) 
          DIMENSION TIMES(1000,4) 
          DIMENSION IRUN(1000)
          DIMENSION MSG(1000,3) 
          DIMENSION NTIME(3)
          DIMENSION MRUN(50,3)
          INTEGER SJOB
          INTEGER STIME 
          INTEGER FJOB
          INTEGER FTIME 
          REAL   MSTIME 
          REAL   MTTIME 
1000      FORMAT (BZ,8A10)
1001      FORMAT (50R1) 
2000      FORMAT(1H1,19X,'DAYFILE SUMMARY - ',A10,2X, 
     1    ' (FROM ....',R3,'. TO ....',R3,'.)',11X,'PAGE',I4,/, 
     2    3X,' JOB',3X,' NAME     ',3X,'  CP TIME',3X,'SYS RSRCE',
     3    3X,' MS USAGE',3X,' MT USAGE',
     4    3X,'   RUN   ',5X,'LAST DAYFILE MESSAGE.'/
     5    26X,'(SECS)',6X,'(UNTS)',6X,'(KUNS)',6X,'(KUNS)'//) 
2001      FORMAT (2X,I4,1H.,3X,A10,4(3X,F9.3),3X,A10,5X,3A10) 
2002      FORMAT (/,14X,'TOTALS',4(1X,F11.3)) 
2003      FORMAT (/,13X,'FINISH TIME - ',A10,2X,' AT END OF - ',A10,
     1    /14X,'START TIME - ',A10,' AT START OF - ',A10) 
2004      FORMAT (12X,'ELAPSED TIME - ',I2,' HR. ',I2,' MIN. ',I2,
     1   ' SEC.','   (',I6,' SEC.)')
2005      FORMAT (1H1,19X,'DAYFILE SUMMARY - ',A10,40X,'PAGE',I4,/, 
     1    10X,'RUN',7X,' USED'//) 
2006      FORMAT (10X,A10,I5) 
2007      FORMAT(1H1,19X,' A C R  SUMMARY - ',A10,2X, 
     1    '(FROM ....',R3,'. TO ....',R3,'.)',11X,'PAGE',I4)
2008      FORMAT (10X,4A10) 
2009      FORMAT (BZ,I4,3A10,3A10)
2010      FORMAT(//36X,'NUMBER OF PASSES =',I4/)
2011      FORMAT(//36X,'NUMBER OF FAILS  =',I4/)
2012      FORMAT(//36X,'TOTAL NUMBER     =',I4/)
2013      FORMAT (2X,I4,1H.,3X,A10,3X,A10,3X,3A10,6X,A10) 
2014      FORMAT (3X,' JOB',2X,'  NAME    ',3X,' TEST NAME ', 
     1    3X,'ACR MESSAGE    ',22X,'  TYPE    ',/)
2015      FORMAT(3X,' JOB',2X,'  NAME    ',3X,' TEST NAME ',
     1    3X,'ACR MESSAGE    ',22X,'  TYPE    ',/,19X,'(TN=',A3,')')
3000      FORMAT (26X,F10.3,4X) 
3001      FORMAT (1X,I2,1X,I2,1X,I2,1X) 
3002      FORMAT (5X,I3,2X) 
  
**        ACCOUNTING CONSTANTS. 
  
          DATA   BFILL /10H            /
          DATA   IRUN /1000 * O"5555 5555 5555 5555 5555"/
          DATA   NUECP /L"UECP"/
          DATA   NSECS /R"SECS"/
          DATA   NAESR /L"AESR"/
          DATA   NUNTS /R"UNTS"/
          DATA   NUEMS /L"UEMS"/
          DATA   NKUNS /R"KUNS"/
          DATA   NUEMT /L"UEMT"/
          DATA   MASK1 /O"7700 0000 0000 0000 0000"/
          DATA   MASK2 /O"7777 0000 0000 0000 0000"/
          DATA   MASK3 /O"7777 7700 0000 0000 0000"/
          DATA   MASK4R/O"0000 0000 0000 7777 7777"/
          DATA   MASK4L/O"7777 7777 0000 0000 0000"/
          DATA   MASK8 /O"7777 7777 7777 7777 0000"/
          DATA   MASK9  /O"0077 7777 7700 0000 0000"/ 
          DATA   MASK10 /O"0000 0000 0000 0000 0077"/ 
          DATA   IQM1  /O"0021 0121 0100 0000 0000"/
          DATA   IQM2  /O"0000 0000 0000 0000 0020"/
* 
**       INITIALIZE CPU, MS, MT, SRU ACCUMULATORS.
* 
          DATA   CPTIME /0.0/ 
          DATA   MSTIME /0.0/ 
          DATA   MTTIME /0.0/ 
          DATA   SRTIME /0.0/ 
          DATA   TIMES /4000 * 0.0/ 
* 
**        INITIALIZE LAST DAYFILE MESSAGE TO *(NONE)*.
* 
          DATA   MSG /1000 * 8H  (NONE), 2000 * 1H /
  
**        COMPILER TABLE. 
  
          DATA   MRUN(1,1) /L"COMPASS"/ 
          DATA   MRUN(1,2) /O"7777 7777 7777 7700 0000"/
          DATA   MRUN(1,3) /O"0000 0000 0000 0055 5555"/
          DATA   MRUN(2,1) /L"SORTMRG"/ 
          DATA   MRUN(2,2) /O"7777 7777 7777 7700 0000"/
          DATA   MRUN(2,3) /O"0000 0000 0000 0055 5555"/
          DATA   MRUN(3,1) /L"ALGOL"/ 
          DATA   MRUN(3,2) /O"7777 7777 7700 0000 0000"/
          DATA   MRUN(3,3) /O"0000 0000 0055 5555 5555"/
          DATA   MRUN(4,1) /L"COBOL"/ 
          DATA   MRUN(4,2) /O"7777 7777 7700 0000 0000"/
          DATA   MRUN(4,3) /O"0000 0000 0055 5555 5555"/
          DATA   MRUN(5,1) /L"RUN23"/ 
          DATA   MRUN(5,2) /O"7777 7777 7700 0000 0000"/
          DATA   MRUN(5,3) /O"0000 0000 0055 5555 5555"/
          DATA   MRUN(6,1) /L"BASIC"/ 
          DATA   MRUN(6,2) /O"7777 7777 7700 0000 0000"/
          DATA   MRUN(6,3) /O"0000 0000 0055 5555 5555"/
          DATA   MRUN(7,1) /L"FTN"/ 
          DATA   MRUN(7,2) /O"7777 7700 0000 0000 0000"/
          DATA   MRUN(7,3) /O"0000 0055 5555 5555 5555"/
          DATA   MRUN(8,1) /L"RUN"/ 
          DATA   MRUN(8,2) /O"7777 7700 0000 0000 0000"/
          DATA   MRUN(8,3) /O"0000 0055 5555 5555 5555"/
          DATA   MRUN(9,1) /L"FTN5"/
          DATA   MRUN(9,2) /O"7777 7777 0000 0000 0000"/
          DATA   MRUN(9,3) /O"0000 0000 5555 5555 5555"/
          DATA   MRUN(10,1) /L"SYMPL"/
          DATA   MRUN(10,2) /O"7777 7777 7700 0000 0000"/ 
          DATA   MRUN(10,3) /O"0000 0000 0055 5555 5555"/ 
  
          CALL REMARK(' VERSION 3') 
          REWIND 1
          REWIND 3
          REWIND 4
          CALL DATER(DATE)
          IJOB = 1
          ITNM = 0
          IF(ITN.EQ.0) GO TO 7
          IF((ITN.AND. .NOT.MASK3).EQ.0)ITNM = MASK3
          IF((ITN.AND. .NOT.MASK2).EQ.0)ITNM = MASK2
          IF((ITN.AND. .NOT.MASK1).EQ.0)ITNM = MASK1
7         CONTINUE
          STIME = 0 
          JOBS = SHIFT(JOBS,-42).AND.O"777777"
          JOBF = SHIFT(JOBF,-42).AND.O"777777"
          ITIME = 1 
1         READ(1,1000,END=10000) LINE 
10000     IF(EOF(1)) 100,2,100
  
**        CHANGE 00B TO BLANK(55B)
  
 2        CONTINUE
          DECODE(50,1001,LINE(1)) (ICHAR(I),I=1,50) 
          DO 201 L=1,50 
          IF(ICHAR(L) .EQ. O"00") ICHAR(L) = O"55"
 201      CONTINUE
          ENCODE(50,1001,LINE(1)) (ICHAR(I),I=1,50) 
  
**        DETERMINE JOB LIMITS. 
  
          JOBN = SHIFT(LINE(2),-18).AND.O"777777" 
          IF (ITIME.EQ.0) GO TO 21
          IF ((LINE(2).AND.MASK8).EQ.L"SYSTEM  ") GO TO 1 
          IF ((LINE(2).AND.MASK8).EQ.L"TELEX  S") GO TO 1 
          IF ((LINE(2).AND.MASK8).EQ.L"BATCHIOS") GO TO 1 
          IF ((LINE(2).AND.MASK8).EQ.L"EXPORTLS") GO TO 1 
          IF ((LINE(2).AND.MASK8).EQ.L"IAFEX  S") GO TO 1 
          IF ((LINE(2).AND.MASK8).EQ.L"MSSEXECS") GO TO 1 
          IF ((LINE(2).AND.MASK8).EQ.L"NAM    S") GO TO 1 
          IF ((LINE(2).AND.MASK8).EQ.L"RBF    S") GO TO 1 
          IF ((LINE(2).AND.MASK8).EQ.L"MAGNET S") GO TO 1 
          IF (LINE(3).EQ.6HINPUT.) GO TO 1
          ITIME = 0 
          STIME = LINE(1) 
          SJOB = LINE(2)
21        IF(JOBN.LT.JOBS) GO TO 1
          IF(JOBN.GT.JOBF) GO TO 1
          IF(STIME.NE.0) GO TO 23 
          STIME = LINE(1) 
23        FTIME = LINE(1) 
          FJOB = LINE(2)
  
**        ADD JOB NAME TO JOB LIST IF NOT IN. 
  
          INJ=0 
          DO 31 II=1,IJOB 
          I = II
          IF(JOB(I).EQ.LINE(2)) GO TO 4 
31        CONTINUE
          JOB(I) = LINE(2)
          ICNT = 60 
          JB = LINE(3)
  
**        DETERMINE JOB NAME LENGTH 
  
 32       JB = SHIFT(JB,6)
          ICNT = ICNT - 6 
          IF((JB.AND.O"77").LT.R"A") GO TO 33 
          IF((JB.AND.O"77").GT.R"9") GO TO 33 
          IF(ICNT.NE.0) GO TO 32
          JJOB(I) = LINE(3) 
          GO TO 34
  
**        ADD BLANKS TO JOB NAME FIELD
  
33        N = ICNT + 6
          JB = SHIFT(JB,ICNT) 
          JJOB(I) = (JB.AND.MASK(60-N)).OR.(SHIFT(MASK(N),N).AND.BFILL) 
34        CONTINUE
          IJOB = IJOB+1 
          INJ=1 
  
**        ENTER JOB TIMES.
  
4         IF((LINE(4).AND.MASK4R).NE.NSECS)   GO TO 41
          IF((LINE(3).AND.MASK4L).NE.NUECP)   GO TO 41
          DECODE(40,3000,LINE) TIME 
          CPTIME = CPTIME+TIME
          TIMES(I,1) = TIMES(I,1)+TIME
          GO TO 44
41        IF((LINE(4).AND.MASK4R).NE.NUNTS)   GO TO 42
          IF((LINE(3).AND.MASK4L).NE.NAESR)   GO TO 42
          DECODE(40,3000,LINE) TIME 
          SRTIME = SRTIME+TIME
          TIMES(I,2) = TIMES(I,2)+TIME
          GO TO 44
42        IF((LINE(4).AND.MASK4R).NE.NKUNS)   GO TO 5 
          IF((LINE(3).AND.MASK4L).NE.NUEMS)   GO TO 43
          DECODE(40,3000,LINE) TIME 
          MSTIME = MSTIME+TIME
          TIMES(I,3) = TIMES(I,3)+TIME
          GO TO 44
43        IF((LINE(3).AND.MASK4L).NE.NUEMT)   GO TO 1 
          DECODE(40,3000,LINE) TIME 
          MTTIME = MTTIME+TIME
          TIMES(I,4) = TIMES(I,4)+TIME
44        GO TO 1 
  
**        DETERMINE RUN TYPE. 
  
5         IF(INJ.EQ.0) GO TO 50 
          IF(JOBN.GE.JOBS) GO TO 1
50        DO 51 J=1,50
          IF (MRUN(J,1).EQ.0) GO TO 6 
          IF ((LINE(3).AND.MRUN(J,2)).NE.(MRUN(J,1).AND.MRUN(J,2))) 
     1    GO TO 51
          IRUN(I) = SHIFT(((MRUN(J,1).AND.MRUN(J,2)).OR.MRUN(J,3)),42)
          MRUN(J,1) = MRUN(J,1)+1 
          GO TO 6 
51        CONTINUE
  
**        ENTER DAYFILE MESSAGE.
  
6         DO 61 J=1,3 
61        MSG(I,J) = LINE(J+2)
          IF((LINE(3).AND.MASK9).NE.IQM1) GO TO 62
          ITAPE =4
          IF((LINE(4).AND.MASK10).EQ.IQM2) ITAPE = 3
          IF((JJOB(I).AND.ITNM).NE.(ITN)) GO TO 62
          WRITE(ITAPE,2009)I,JOB(I),JJOB(I),IRUN(I),(LINE(L),L=3,5) 
62        CONTINUE
          GO TO 1 
  
  
**        PRINT JOB TABLES
  
100       LINES = 64
          J = IJOB-1
          IPAGE = 1 
          DO 105 I=1,J
          IF (LINES.LT.60) GO TO 101
          WRITE(2,2000)DATE,JOBS,JOBF,IPAGE 
          LINES = 4 
          IPAGE = IPAGE+1 
101       M = R"999"
          DO 102 K=1,J
          IF (JOB(K).EQ.0) GO TO 102
          IF ((SHIFT(JOB(K),-18).AND.O"777777").GE.M) GO TO 102 
          L = K 
          M = SHIFT(JOB(K),-18).AND.O"777777" 
102       CONTINUE
          K = L 
          WRITE(2,2001) I,JOB(K),(TIMES(K,L),L=1,4),IRUN(K),(MSG(K,L),
     1    L=1,3)
          JOB(K) = 0
          III(K) = I
105       LINES = LINES+1 
  
**        LIST TOTALS.
  
          WRITE(2,2002) CPTIME,SRTIME,MSTIME,MTTIME 
          WRITE(2,2003) FTIME,FJOB,STIME,SJOB 
          DECODE(10,3001,STIME) NTIME 
          ITIME = 3600*NTIME(1)+60*NTIME(2)+NTIME(3)
          DECODE(10,3001,FTIME) NTIME 
          JTIME = 3600*NTIME(1)+60*NTIME(2)+NTIME(3)
          KTIME = JTIME-ITIME 
          NTIME(1) = KTIME/3600 
          ITIME = KTIME/60
          NTIME(2) = ITIME-(NTIME(1)*60)
          NTIME(3) = KTIME-(NTIME(2)*60)-(NTIME(1)*3600)
          WRITE(2,2004) NTIME,KTIME 
  
**        LIST RUN USAGE. 
  
          WRITE(2,2005) DATE,IPAGE
          LINES = 4 
          IPAGE = IPAGE+1 
          DO 110 I=1,50 
          IF (MRUN(I,1).EQ.0) GO TO 111 
          J = (MRUN(I,1).AND.MRUN(I,2)) .OR. MRUN(I,3)
          K = MRUN(I,1).AND.O"777777" 
110       WRITE(2,2006) J, K
* 
**        AUTOMATIC CHECKOUT ROUTINES SUMMARY PROCESSOR.
* 
111       ENDFILE 3 
          ENDFILE 4 
          REWIND 3
          REWIND 4
          ITOT = 0
          IPASS = 0 
          IFAIL = 0 
          DO 112 I=1,1000 
          KK(I)=0 
112       CONTINUE
          ITAPE = 3 
          DO 114 J=1,1000 
          READ(ITAPE,2009,END=10001)I,JOB(I),JJOB(I),IRUN(I),(MSG(I,L)
     +,L=1,3) 
10001     IF(EOF(ITAPE)) 115,113,115
113       IPASS = IPASS + 1 
          ITOT = ITOT + 1 
          KK(I) = III(I)
114       CONTINUE
115       IF(IPASS.EQ.0) GO TO 119
          LINES = 64
          J = J - 1 
          DO 118 I = 1,J
          IF(LINES.LT.60) GO TO 116 
          WRITE(2,2007)DATE,JOBS,JOBF,IPAGE 
          IF(ITN.EQ.0)WRITE(2,2014) 
          IF(ITN.NE.0)WRITE(2,2015)ITN
          LINES = 4 
          IPAGE = IPAGE + 1 
116       M = 1001
          DO 117 K=1,1000 
          IF(KK(K).EQ.0) GO TO 117
          IF(KK(K).GE.M) GO TO 117
          L = K 
          M = KK(K) 
117       CONTINUE
          K = L 
          WRITE(2,2013)KK(K),JOB(K),JJOB(K),(MSG(K,L),L=1,3),IRUN(K)
          KK(K) = 0 
          LINES = LINES + 1 
118       CONTINUE
          WRITE(2,2010)IPASS
* 
119       ITAPE = 4 
          DO 121 J = 1,1000 
          READ(ITAPE,2009,END=10002)I,JOB(I),JJOB(I),IRUN(I),(MSG(I,L)
     +,L=1,3) 
10002     IF(EOF(ITAPE)) 122,120,122
120       IFAIL = IFAIL + 1 
          ITOT = ITOT + 1 
          KK(I) = III(I)
121       CONTINUE
122       IF(IFAIL.EQ.0)GO TO 126 
          LINES = 64
          J = J - 1 
          DO 125 I=1,J
          IF(LINES.LT.60) GO TO 123 
          WRITE(2,2007)DATE,JOBS,JOBF,IPAGE 
          IF(ITN.EQ.0)WRITE(2,2014) 
          IF(ITN.NE.0)WRITE(2,2015)ITN
          LINES = 4 
          IPAGE = IPAGE + 1 
123       M = 1001
          DO 124 K = 1,1000 
          IF(KK(K).EQ.0)GO TO 124 
          IF(KK(K).GE.M)GO TO 124 
          L = K 
          M = KK(K) 
124       CONTINUE
          K = L 
          WRITE(2,2013)KK(K),JOB(K),JJOB(K),(MSG(K,L),L=1,3),IRUN(K)
          KK(K) = 0 
          LINES = LINES + 1 
125       CONTINUE
          WRITE(2,2011)IFAIL
126       IF(ITOT.EQ.0) GO TO 127 
          WRITE(2,2007)DATE,JOBS,JOBF,IPAGE 
          WRITE(2,2010)IPASS
          WRITE(2,2011)IFAIL
          WRITE(2,2012)ITOT 
127       ENDFILE 2 
          END 
          SUBROUTINE DATER(I) 
          CALL DATE(I)
          RETURN
          END 
          IDENT  PRESET 
          ENTRY  PRESET 
          SYSCOM
          SPACE  4,10 
*CALL     COMCMAC 
          SPACE  4,10 
 PRESET   SB1    1
          SA1    ACTR 
          SB4    X1 
          SA4    ARGR 
          SB5    PRSA 
          RJ     ARG         PROCESS ARGUMENTS
          ZR     X1,PRS1     IF NO ARGUMENT ERRORS
          MESSAGE (=C*DFSORT ARGUMENT ERROR.*)
          ABORT 
 PRS1     SA1    D           SET DAYFILE NAME 
          SA2    L           SET LIST FILE NAME 
          BX6    X1 
          LX7    X2 
          SA6    ARGR 
          SA7    A6+B1
          SX6    B1+B1       ARGUMENT COUNT = 2 
          SA6    ACTR 
          EQ     =XDFSORT    ENTER FORTRAN PROGRAM
  
 PRSA     BSS    0
          VFD    12/0LD,18/D,30/D 
          VFD    12/0LL,18/L,30/L 
          VFD    12/0LS,18/JOBS,30/JOBS 
          VFD    12/0LF,18/JOBF,30/JOBF 
          VFD    12/0LTN,18/ITN,30/ITN
          CON    0
  
 D        CON    0LDAYFILE
 L        CON    0LOUTPUT 
          SPACE  4
**        COMMON DECKS. 
  
  
*CALL     COMCARG 
*CALL     COMCSYS 
          SPACE  4
          USE    /DATA/ 
 JOBS     CON    0LAAA
 JOBF     CON    0L999
 ITN      CON    0
          SPACE  4
          END    PRESET 
