*** 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