Trailing-Edge
-
PDP-10 Archives
-
AP-4172F-BM
-
3a-sources/acct20.for
There are 3 other files named acct20.for in the archive. Click here to see a list.
C ACCT20
C PERFORMS ACCOUNTING FOR THE TOPS20 SYSTEM FROM
C THE BINARY FACT FILES
C JOHN MAKHOUL - DECEMBER 20,1971 - VERSION 6
C EDITED 3/23/76 BY LOU COHEN FOR TCO # 1201.
C THIS EDIT CHANGES ONE "HELP" TO START WITH A CHARACTER
C OTHER THAN "?".
C
C EDITED 10/18/76 BY T. HESS TO REMOVE DISC UTILIZATION
C CODE (CANNOT SUPPORT MULTIPLE STRUCTURES)
CTHIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
C OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
C
CCOPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION
PROGRAM ACCT20
IMPLICIT INTEGER (A-Z)
REAL DISCRT,CHARGE,TCHARG,SCHARG,OTHER,TOTHER,FILFIX,DOLLAR
REAL GRCPU,GRCON,GRCHAR,GRLINE,GRCARD
REAL CRCPU,CRCON,CRCHAR,CRLINE,CRCARD
REAL RCPU,RCON,CPU2,CON2,DCPU,DCON,XTEM
REAL CHARG,C,D,E,F,G
LOGICAL ALL,INSERT,DELETE,SPL,ITEM,REPORT,SUMARY
LOGICAL FIRST,EOF,WORDR,BOUTF,ACTINF
COMMON /OUTB/BOUTF,ACTINF
COMMON /ACCOUN/ID(1001),ACNT(10001),ACTNM(501),ACTAL(3000)
COMMON /DATES/ BEGTAD, ENDTAD
COMMON /ENTRY/WORD(40),NID,NENTRY,NNACT,NFLCK,NCRASH,UPTIME,
1 EMPTY, MINSIZ
COMMON /BDATA/BIT0,BIT1,BIT2,BIT12,BIT17,L7,R7,ACTMSK,NBIT2
COMMON /OUT/ZERO,CRLF,CRLF2,FORMF
COMMON /FACT/LOG(1001),ASCI(15),PAYDT(8)
COMMON /ACTDEF/ ACNTSZ, ACTACT, ACTSP, ACTPTR, ACTCPU, ACTCON,
1 ACTFIL, ACTLPT, ACTCDR
DIMENSION REASON(9),SP(1200),TEXT(10), CH(5)
DIMENSION DEFALT(3000), LEGACT(1000)
DATA GRCPU,GRCON,GRCHAR,GRLINE,GRCARD/6.,6.,.384,.01,.01/
DATA CRCPU,CRCON,CRCHAR,CRLINE,CRCARD/6.,6.,.384,.01,.01/
DATA BEGTAD, ENDTAD, YTDSIZ / "377777777777, 0, 8 /
DATA DEFUSR, DEFACT, DEFSIZ, DEFMAX, LEGMAX /0,1,2,3000,1000/
DATA CH / "774000000000, "003760000000, "000017700000,
1 "000000077400, "000000000376 /
DATA STAR4,BIT01,DISCRT/"251245225000,"600000000000,1./
DATA SIXMSK,LBYTE/"375767737576,"774000000000/
DATA CR,COLON,MINUS/"065004020100,"350000000000,"264000000000/
C CHARG(RCPU,RCONS,RPAGE,RLINES,RCARDS) - COMPUTES THE CHARGES USING GIVEN RATES
CHARG(C,D,E,F,G)= CPU*C/60. + CONS*D/3600. + PAGE*E*DISCRT
1 + LINES*F + CARDS*G + OTHER
TO = ' TO ' .AND. .NOT. CH(5)
C COMMANDS TO ACCT20
ASSIGN 20 TO CNTLE
CALL ION(CNTLE)
CALL CLOSE
CALL OPENOF('TTY:')
TYPE 5
5 FORMAT(' TOPS20 ACCOUNTING SYSTEM'/' [TYPE ? FOR
1 HELP]')
GO TO 170
10 ASSIGN 20 TO CNTLE
CALL ION(CNTLE)
GO TO 30
20 CALL CLOSI
30 CALL PSOUTR(ZERO)
40 TYPE 50
50 FORMAT(' ACCT20>'$)
COMND2=0
COMND3=0
CALL RCHAR(COMAND)
IF (COMAND.EQ. CR) GO TO 65
IF (COMAND.EQ.'S') GO TO 265
IF (COMAND.EQ.'I') GO TO 165
IF (COMAND.EQ.'O') GO TO 140
IF (COMAND.EQ.'L') GO TO 150
IF (COMAND.EQ.'R') GO TO 180
IF (COMAND.EQ.'W') GO TO 90
IF (COMAND.EQ.'F') GO TO 110
IF (COMAND.EQ.'G') GO TO 280
IF (COMAND.EQ.'A') GO TO 1800
IF (COMAND.EQ.'H') GO TO 190
IF (COMAND.EQ.'B') GO TO 200
IF (COMAND.EQ.'D') GO TO 250
IF (COMAND.EQ.'V') GO TO 4000
IF (COMAND.EQ.'E') GO TO 105
IF (COMAND.EQ.'?') GO TO 70
TYPE 60
60 FORMAT (/' ?Command error')
GO TO 40
65 CALL RCHAR(TEMP)
GO TO 40
70 TYPE 80
80 FORMAT(' ACCT20 - TYPE FIRST CHARACTER ',
1'TO HAVE EFFECT:'/' INITIALIZE ACCOUNTING SYSTEM'/
2' READ FACT FILE'/
3' OUTPUT ACCOUNTING INFORMATION'/' WRITE ONTO FILE'/
4' LOGOUT DATA FILE'/' GO TO REPORTING SEC',
5'TION'/' FILE DISCOUNT RATE DEFINITION'/' ADJUST CHARGES'/
6' SET CHARGING RATES'/' VALIDATE ACCOUNTS'/
7' HISTOGRAM'/' BINARY FILE LISTING'/' EXIT TO MONITOR'/
8' DATE CONVERSION (GIVE SYSTEM FORMAT)'/' '/
9' TYPE A QUESTION MARK (?) TO CAUSE ACCT20 TO TYPE THIS TEXT'/)
GO TO 40
90 TYPE 100
100 FORMAT ('+RITE ONTO FILE: '$)
CALL OPENOF
IF (COMND2.EQ.'W') GO TO 530
GO TO 40
C EXIT TO MONITOR
105 TYPE 106
106 FORMAT ('+XIT TO MONITOR')
CALL EXIT
C FILE DISCOUNT RATE - DISCRT
110 TYPE 120
120 FORMAT ('+ILE DISCOUNT RATE: '$)
ACCEPT 130, DISCRT
130 FORMAT (F)
GO TO 40
C OUTPUT ACCOUNTING INFORMATION
140 TYPE 142
142 FORMAT ('+UTPUT ACCOUNTING INFORMATION')
ACTINF = .TRUE.
GO TO 40
C LOGOUT DATA FILE
150 TYPE 152
152 FORMAT ('+OGOUT DATA FILE: '$)
CALL BINOF
BOUTF = .TRUE.
GO TO 40
C INITIALIZE ACCOUNTING SYSTEM
165 TYPE 167
167 FORMAT ('+NITIALIZE ACCOUNTING SYSTEM')
170 ACTINF=.FALSE.
BOUTF=.FALSE.
ID(1)=0
ACNT(1)=2
ACTNM(1)=-1
ACTAL(1)=0
LOG(1)=-2
SP(1)=2
CALL RFACT(-2)
NCRASH=0
NFLCK=0
NID=0
NENTRY=0
NNACT=0
EMPTY=0
UPTIME=-1
REPORT=.TRUE.
GO TO 40
C READ ACCOUNTS FROM FACT FILES
180 CALL RFACT(0)
CALL SOUTZ(CRLF)
REPORT=.FALSE.
GO TO 40
C CPU AND CONSOLE TIME HISTOGRAM
190 CALL PSOUTR('ISTOGRAM')
CALL PSOUTZ(' OUTPUT FILE:')
CALL OPENOF
CALL RFACT(-1)
CALL OPENOF('TTY:')
GO TO 40
C OUTPUT BINARY FILE AS OCTAL NUMBERS
200 CALL PSOUTR('INARY-FILE LISTING')
TYPE 210
210 FORMAT(' WRITE ONTO FILE: '$)
CALL OPENOF
CALL PSOUTZ(' READ BINARY FILE: ')
CALL OPENFZ(1)
ASSIGN 240 TO EOF
WORDNO=-1
220 CALL RWORD(BWORD,EOF)
WORDNO=WORDNO+1
ENCODE (20,230,ASCI) WORDNO,BWORD
230 FORMAT(O6,O14)
ASCI(5)=0
CALL SOUTCR(ASCI)
GO TO 220
240 CALL SOUTCR('END OF FILE')
CALL OPENOF('TTY:')
GO TO 40
C PRINT LOCAL TIME, GIVEN TOPS20 FORMAT TIME
250 CALL PSOUTZ('ATE (TOPS20 FORMAT): ')
ACCEPT 260,DATE
260 FORMAT(O)
CALL PSOUTZ(BIT1)
CALL ODTIMZ(DATE)
CALL PSOUTR(0)
GO TO 40
C SET CHARGING RATES
265 TYPE 266
266 FORMAT ('+ET CHARGING RATES'/
1' COMMERCIAL --'/' CPU TIME (PER MINUTE): '$)
ACCEPT 267, CRCPU
267 FORMAT (F)
TYPE 268
268 FORMAT (' CONSOLE TIME (PER HOUR): '$)
ACCEPT 267, CRCON
TYPE 269
269 FORMAT (' DISK STORAGE (PER FILE PAGE): '$)
ACCEPT 267, CRCHAR
TYPE 270
270 FORMAT (' PRINTER USAGE (PER PRINTED PAGE): '$)
ACCEPT 267, CRLINE
TYPE 271
271 FORMAT (' CARD READER USAGE (PER CARD): '$)
ACCEPT 267,CRCARD
TYPE 272
272 FORMAT (' GOVERNMENT --'/' CPU TIME (PER MINUTE): '$)
ACCEPT 267, GRCPU
TYPE 268
ACCEPT 267,GRCON
TYPE 269
ACCEPT 267,GRCHAR
TYPE 270
ACCEPT 267,GRLINE
TYPE 271
ACCEPT 267,GRCARD
GO TO 40
C REPORTS PROGRAM
280 CALL PSOUTR('O TO REPORTS')
IF(NENTRY.NE.0) GO TO 285
CALL PSOUTR('NO CHARGES')
GO TO 10
285 IACF=-3+ACNTSZ*NENTRY
IF(REPORT) GO TO 350
C PERFORM ACCOUNTING FOR JOBS NOT LOGGED OUT
CALL SOUTCR('ACCOUNTING FOR JOBS NOT LOGGED OUT')
CALL RFACT(1)
REPORT=.TRUE.
C CLOSE LOGOUT DATA FILE
IF(BOUTF) CALL CLOSB
BOUTF=.FALSE.
C OUTPUT ALPHANUMERIC ACCOUNTS
IF(.NOT.ACTINF) GO TO 310
CALL SOUTCR(0)
CALL SOUTCR('ALPHANUMERIC ACCOUNTS')
IA=0
SIZE=0
290 IA=IA+SIZE+1
IF(ACTAL(IA).EQ.0) GO TO 310
II=-IA
ENCODE(10,300,ASCI) II
300 FORMAT(1X,I6,3X)
ASCI(3)=0
CALL SOUTZ(ASCI)
DO 303 I = 1, 10
303 TEXT(I) = 0
SIZE=ACTAL(IA).AND.R7
DO 305 I = 1, SIZE
J = IA + I
305 TEXT(I) = ACTAL(J)
CALL SOUTCR(TEXT)
GO TO 290
C PUT CPU AND CONSOLE TIME IN SECONDS
C DIVIDE NO. OF PAGES BY NFLCK
310 DO 320 I=2,IACF,ACNTSZ
ACNT(I+ACTCPU)=IFIXR(ACNT(I+ACTCPU)/1000.)
ACNT(I+ACTCON)=IFIXR(ACNT(I+ACTCON)/1000.)
IF (ACNT(I+ACTFIL).EQ.0)GO TO 320
ACNT(I+ACTFIL)=IFIXR((ACNT(I+ACTFIL)+0.)/NFLCK)
320 CONTINUE
C CLASSIFY USERS:BIT0=1,ALPHANUMERIC; OTHERWISE NUMERIC
C GET FIRST WORD OF USER NAME
C LOG TABLE IS NOW USED TO ALPHABETIZE USER ID'S
CALL PSOUTR('CLASSIFICATION OF USERS AND ACCOUNTS, ETC.')
DO 340 I=1,NID
CALL CATEG(ID(I))
USER=ID(I).AND.R7
CALL DIRSTZ(USER,TEXT,NCHAR)
LOG(I+1) = TEXT(1)
IF(NCHAR.NE.0) GO TO 340
LOG(I+1)='?????'
TYPE 330,USER
330 FORMAT(' USER ID ',O6,' NOT IN USE'/)
340 LOG(I+1)=LOG(I+1).AND.SIXMSK
C ORDER NUMERIC ACCOUNTS
350 IF (NNACT.LE.1) GO TO 380
360 FLAG=0
DO 370 I=NNACT,2,-1
J=I-1
IF(ACTNM(I).GE.ACTNM(J)) GO TO 370
TEMP=ACTNM(I)
ACTNM(I)=ACTNM(J)
ACTNM(J)=TEMP
FLAG=1
370 CONTINUE
IF(FLAG.EQ.1) GO TO 360
C ORDER USERS ALPHABETICALLY
380 IF(NID.LE.1) GO TO 430
390 FLAG=0
DO 420 I=NID,2,-1
K=I+1
J=I-1
IF(LOG(K)-LOG(I)) 410,400,420
400 IF((ID(J).AND.R7).LT.(ID(I).AND.R7)) GO TO 420
410 TEMP=LOG(I)
LOG(I)=LOG(K)
LOG(K)=TEMP
TEMP=ID(I)
ID(I)=ID(J)
ID(J)=TEMP
FLAG=1
420 CONTINUE
IF(FLAG.EQ.1) GO TO 390
C CLASSIFY ACCOUNTS BY CHARGE CLASS
430 DO 460 I=1,NID
USER=ID(I).AND.R7
IAC=(ID(I).AND.L7)/BIT17
440 NACCT=ACNT(IAC+ACTACT)
ASSIGN 450 TO CLASS
GO TO 3140
450 ACNT(IAC+ACTACT)=NACCT
IF(ACNT(IAC+ACTPTR).LT.0) GO TO 460
IAC=ACNT(IAC+ACTPTR).AND.R7
GO TO 440
460 CONTINUE
C CLASSIFY SPECIAL CHARGES
470 K=0
S=2
480 S=S+K
IF(S.EQ.SP(1)) GO TO 500
USER=(SP(S).AND.L7)/BIT17
NACCT=SP(S+1)
ASSIGN 490 TO CLASS
GO TO 3140
490 SP(S+1)=NACCT
K=SP(S).AND.R7
GO TO 480
500 IF(COMAND.EQ.'A'.AND.COMND3.EQ.0) GO TO 1810
C COMMANDS TO REPORTS PROGRAM
ASSIGN 510 TO CNTLE
CALL ION(CNTLE)
GO TO 520
510 CALL CLOSI
520 CALL PSOUTR(ZERO)
530 TYPE 540
540 FORMAT (' REPORT>'$)
ALL=.FALSE.
COMND3=0
ITEM=.FALSE.
SUMARY=.FALSE.
CALL RCHAR(COMND2)
IF (COMND2.EQ.CR) GO TO 545
IF (COMND2.EQ.'E') GO TO 570
IF (COMND2.EQ.'D') GO TO 580
IF (COMND2.EQ.'C') GO TO 620
IF (COMND2.EQ.'F'.OR.COMND2.EQ.'T') GO TO 850
IF (COMND2.EQ.'J') GO TO 1150
IF (COMND2.EQ.'S') GO TO 1700
IF (COMND2.EQ.'U') GO TO 1290
IF (COMND2.EQ.'I') GO TO 1480
IF (COMND2.EQ.'A') GO TO 1800
IF (COMND2.EQ.'W') GO TO 90
IF (COMND2.EQ.'Y') GO TO 1580
IF (COMND2.EQ.'?') GO TO 550
TYPE 60
GO TO 530
545 CALL RCHAR(TEMP)
GO TO 530
550 TYPE 560
560 FORMAT(' ACCT20-REPORTING SECTION TYPE FIRST CHARACTER ',
1'TO HAVE EFFECT:'/' EXIT TO ACCT20'/' DO ALL COST '
2'SUMMARIES (C+F+T+J)'/' COST SUMMARY'/' FINAL COST SUMMARY'/
3' JOB SUMMARY'/' USER COST SUMMARY'/' INDIVIDUAL JOB SUMMARY'/
4' ADJUST CHARGES'/' WRITE FILE'/' YEAR TO DATE ACCOUNTING'
5/' SUMMARY FOR YEAR TO DATE FILE')
GO TO 530
570 CALL PSOUTR('XIT TO ACCT20')
ASSIGN 20 TO CNTLE
CALL ION(CNTLE)
GO TO 40
C DO ALL COST SUMMARIES
580 CALL PSOUTR('O ALL COST SUMMARIES')
ALL=.TRUE.
CALL PSOUTZ(' C')
GO TO 620
590 COMND2='F'
CALL PSOUTZ(' F')
GO TO 850
600 IF (COMND2.EQ.'T') GO TO 610
COMND2='T'
CALL PSOUTZ(' T')
GO TO 850
610 COMND2='J'
CALL PSOUTZ(' J')
GO TO 1150
C COST SUMMARY BY CATEGORY
620 CALL PSOUTR('OST SUMMARY')
CALL SOUTZ(FORMF)
CALL SOUTZ(' TOPS20 SUMMARY SHEET FOR ')
CALL ODTIMZ(BEGTAD)
CALL SOUTZ(TO)
CALL ODTIMZ(ENDTAD)
CALL SOUTZ(CRLF2)
CALL SOUTZ('JOB TYPE')
ENCODE (61,630,ASCI) BIT1
630 FORMAT(A1,' CPU TIME CONSOLE TIME FILE PAGES LPT PAGES',
1 ' CARDS ')
ASCI(13) = 0
CALL SOUTZ(ASCI)
ENCODE (21,635,ASCI) BIT1
635 FORMAT(A1,' OTHER CHARGES')
ASCI(5) = ASCI(5) .AND. CH(1)
CALL SOUTCR(ASCI)
CALL SOUTZ(CRLF)
TYPE=0
ASSIGN 640 TO TZERO
GO TO 3040
640 TYPE=TYPE+1
CPU=0
CONS=0
PAGE=0
LINES=0
CARDS=0
OTHER=0.
CHARGE=0.
GO TO (650,670,680,690,700,710) TYPE
C EXTERNAL CLIENTS - TYPE=1
C ACCOUNTS < 200000
650 CALL SOUTCR('EXTERNAL CLIENTS')
CALL SOUTZ(' ')
ACODE=BIT2
ASSIGN 660 TO SUM
GO TO 770
660 ASSIGN 640 TO OUT
GO TO 3050
C CHARGEABLE OVERHEAD - TYPE=2
670 CALL SOUTCR('CHARGEABLE OVERHEAD')
CALL SOUTZ(' ')
ACODE=BIT2
GO TO 770
C NONCHARGEABLE - TYPE=3
680 CALL SOUTCR('NONCHARGEABLE')
CALL SOUTZ(' ')
ACODE=0
GO TO 770
C COMPUTER CENTERS - TYPE=4
690 CALL SOUTCR('COMPUTER CENTERS')
CALL SOUTZ(' ')
ACODE=0
GO TO 770
C TOTAL
700 CALL SOUTZ(CRLF)
CALL SOUTZ('TOTAL ')
CPU=TCPU
CONS=TCONS
PAGE=TPAGE
LINES = TLINES
CARDS = TCARDS
OTHER=TOTHER
CHARGE=TCHARG
GO TO 3080
C FINAL SUMMARY
710 CALL SOUTZ(CRLF2)
ENCODE(60,720,ASCI) GRCPU,GRCON,GRCHAR
720 FORMAT(' $'F5.2,'/MIN $'F5.2,'/HR $',
1 F5.3,'/PAGE/PAY PERIOD')
ASCI(13)=0
CALL SOUTCR('GOVERNMENT CHARGE RATES --')
CALL SOUTCR(ASCI)
ENCODE (60,721,ASCI) GRLINE, GRCARD
721 FORMAT (' $',F5.3,'/PRINTED PAGE, $',F5.3,'/CARD READ')
ASCI(13)=0
CALL SOUTCR(ASCI)
ENCODE(60,720,ASCI) CRCPU, CRCON, CRCHAR
ASCI(13)=0
CALL SOUTCR('COMMERCIAL CHARGE RATES --')
CALL SOUTCR(ASCI)
ENCODE (60,721,ASCI) CRLINE, CRCARD
ASCI(13)=0
CALL SOUTCR(ASCI)
ENCODE(60,730,ASCI) BIT1
730 FORMAT(39X,'(1 PAGE=512*5 CHARS)',A1)
ASCI(13)=0
CALL SOUTCR(ASCI)
CALL SOUTZ(CRLF)
ENCODE(50,740,ASCI) NCRASH
740 FORMAT('THERE WERE'I4,' SYSTEM RESTARTS THIS PAY PERIOD ')
ASCI(11)=0
CALL SOUTCR(ASCI)
CALL SOUTZ(CRLF)
IF(UPTIME.EQ.-1) UPTIME=0
MIN=UPTIME/60
SEC=UPTIME-MIN*60
HOUR=MIN/60
MIN=MIN-HOUR*60
ENCODE(40,750,ASCI) HOUR,MIN,SEC
750 FORMAT('TOTAL UPTIME THIS PAY PERIOD:',I4,':'I2,':'I2,1X)
ASCI(9)=0
CALL SOUTCR(ASCI)
CALL SOUTZ(CRLF)
CALL SOUTZ('FILE CHARGES HAVE BEEN DISCOUNTED BY A FACTOR OF')
ENCODE(5,760,ASCI) DISCRT
760 FORMAT(F5.3)
ASCI(2)=0
CALL SOUTCR(ASCI)
IF (ALL) GO TO 590
GO TO 530
C (SUM) - SUM ACCOUNTS
770 DO 790 I=2,IACF,ACNTSZ
IF(ACNT(I).EQ.NBIT2) GO TO 790
NACCT=ACNT(I).AND.ACTMSK
ASSIGN 780 TO SCLASS
ASSIGN 790 TO NOSUM
GO TO 830
780 CPU = CPU + ACNT(I+ACTCPU)
CONS = CONS + ACNT(I+ACTCON)
PAGE = PAGE + ACNT(I+ACTFIL)
LINES = LINES + ACNT(I+ACTLPT)
CARDS = CARDS + ACNT(I+ACTCDR)
790 CONTINUE
K=0
S=2
800 S=S+K
IF(S.EQ.SP(1)) GO TO SUM
IF(SP(S).LT.0) GO TO 820
IF((SP(S+1).AND.BIT12).NE.ACODE) GO TO 820
NACCT=SP(S+1).AND.ACTMSK
ASSIGN 810 TO SCLASS
ASSIGN 820 TO NOSUM
GO TO 830
810 OTHER=OTHER+SP(S+2)/100.
820 K=SP(S).AND.R7
GO TO 800
C (SCLASS) - SUBCLASSIFY
C (NOSUM) - DO NOT SUM
C CURRENT SUB-CLASSIFICATION ALGORITHM --
C NUMERIC ACCOUNTS < 1000 ARE NON-CHARGEABLE
C ALL OTHER ACCOUNTS ARE EXTERNAL CLIENTS
830 IF ( TYPE .EQ. 1 .AND. NACCT .LT. 0 ) GO TO SCLASS
IF ( TYPE .EQ. 1 .AND. NACCT .GE. 1000 ) GO TO SCLASS
GO TO NOSUM
C COST SUMMARY BY ACCOUNT NUMBER
850 IF (COMND2.EQ.'F') GO TO 860
CALL PSOUTR('OTAL COST')
GO TO 870
860 CALL PSOUTR('INAL COST SUMMARY FOR ACCOUNTING')
870 CALL SOUTZ(FORMF)
CALL SOUTZ (' TOPS20 TIME SHEET FOR ')
CALL ODTIMZ(BEGTAD)
CALL SOUTZ(TO)
CALL ODTIMZ(ENDTAD)
CALL SOUTZ(CRLF)
CALL SOUTZ('JOB NUMBER')
ENCODE(61,630,ASCI) BIT1
ASCI(13) = 0
CALL SOUTZ(ASCI)
ENCODE (21,635,ASCI) BIT1
ASCI(5) = ASCI(5) .AND. CH(1)
CALL SOUTCR(ASCI)
C NUMERIC ACCOUNTS
880 IA=0
ASSIGN 890 TO TZERO
GO TO 3040
890 IA=IA+1
900 CPU=0
CONS=0
PAGE=0
LINES=0
CARDS=0
OTHER=0.
CHARGE=0.
SPL=.FALSE.
IF(COMND2.NE.'Y') GO TO 910
ASSIGN 910 TO READB
GO TO 1640
910 IF(IA.GT.NNACT) GO TO 930
NACCT=ACTNM(IA)
IF(COMND2.NE.'Y') GO TO 940
ACNUM=NACCT
IF(WORD(1).LT.0.OR.WORD(1).GE.NACCT.OR.EOF.OR.FIRST) GO TO 940
920 ASSIGN 900 TO BINO
GO TO 1670
930 IF(COMND2.NE.'Y') GO TO 1000
IF(WORD(1).LT.0.OR.EOF.OR.FIRST) GO TO 1000
GO TO 920
940 DO 960 I=1,NID
C IF(ID(I).LT.0) GO TO 960
ASSIGN 950 TO LOCENT
ASSIGN 960 TO ENTNF
GO TO 3320
950 IF ( ACNT(IAC+ACTACT) .LT. 0 ) GO TO 960
ACODE=ACNT(IAC+ACTACT).AND.BIT12
IF(COMND2.EQ.'F'.AND.ACODE.EQ.0) GO TO 890
IF((ACNT(IAC+ACTSP).AND.L7).NE.0) SPL=.TRUE.
CPU=CPU+ACNT(IAC+ACTCPU)
CONS=CONS+ACNT(IAC+ACTCON)
PAGE=PAGE+ACNT(IAC+ACTFIL)
LINES=LINES+ACNT(IAC+ACTLPT)
CARDS=CARDS+ACNT(IAC+ACTCDR)
960 CONTINUE
IF(COMND2.EQ.'Y') GO TO 970
ASSIGN 970 TO ACTNO
GO TO 3280
970 IF(.NOT.SPL) GO TO 980
NACCT1=NACCT
USER=-1
ASSIGN 980 TO SPAD
GO TO 3340
980 ASSIGN 890 TO OUT
IF(COMND2.EQ.'Y') ASSIGN 990 TO OUT
GO TO 3050
990 ASSIGN 890 TO BINO
IF(WORD(1).EQ.NACCT) GO TO 1680
GO TO 1690
C ALPHANUMERIC ACCOUNTS
1000 SUMARY=.TRUE.
DO 1100 I=1,NID
IF(ID(I).GE.0) GO TO 1100
USER=ID(I).AND.R7
IAC=(ID(I).AND.L7)/BIT17
1010 SCPU=0
SCONS=0
SPAGE=0
SLINES=0
SCARDS=0
OTHER=0.
SCHARG=0.
SPL=.FALSE.
IF(COMND2.NE.'Y') GO TO 1050
ASSIGN 1020 TO READB
GO TO 1640
1020 ACNUM=-USER
IF(ACNUM.EQ.WORD(1).OR.EOF.OR.FIRST) GO TO 1050
USER2=-WORD(1)
CALL DIRSTZ(USER2,ASCI,NCHAR)
ASCI(1)=ASCI(1).AND.SIXMSK
IF(ASCI(1)-LOG(I+1)) 1040,1030,1050
1030 IF(WORD(1).LT.ACNUM) GO TO 1050
1040 ASSIGN 1010 TO BINO
GO TO 1670
1050 CPU=ACNT(IAC+ACTCPU)
CONS=ACNT(IAC+ACTCON)
PAGE=ACNT(IAC+ACTFIL)
LINES=ACNT(IAC+ACTLPT)
CARDS=ACNT(IAC+ACTCDR)
ACODE=ACNT(IAC+ACTACT).AND.BIT12
IF((ACNT(IAC+ACTSP).AND.L7).NE.0) SPL=.TRUE.
ASSIGN 1060 TO OUT
GO TO 3050
1060 SCPU=SCPU+CPU
SCONS=SCONS+CONS
SPAGE=SPAGE+PAGE
SLINES=SLINES+LINES
SCARDS=SCARDS+CARDS
SCHARG=SCHARG+CHARGE
IF(ACNT(IAC+ACTPTR).LT.0) GO TO 1070
IAC=ACNT(IAC+ACTPTR).AND.R7
GO TO 1050
1070 IF(.NOT.SPL) GO TO 1080
NACCT1=NBIT2
ASSIGN 1080 TO SPAD
GO TO 3340
1080 CPU=SCPU
CONS=SCONS
PAGE=SPAGE
LINES=SLINES
CARDS=SCARDS
CHARGE=SCHARG
TOTHER=TOTHER+OTHER
IF(COMND2.EQ.'Y') GO TO 1090
IF(CHARGE.EQ.0.AND.COMND2.EQ.'F') GO TO 1100
ASSIGN 1100 TO OUT
ASSIGN 3080 TO NAME
GO TO 3190
1090 ASSIGN 1100 TO BINO
IF(ACNUM.EQ.WORD(1)) GO TO 1680
GO TO 1690
1100 CONTINUE
IF(COMND2.NE.'Y') GO TO 1120
ASSIGN 1110 TO READB
GO TO 1640
1110 IF(EOF.OR.FIRST) GO TO 1630
ASSIGN 1640 TO BINO
GO TO 1670
C TOTAL
1120 SUMARY=.FALSE.
ASSIGN 1130 TO OUT
GO TO 700
1130 IF(COMND2.EQ.'T') GO TO 1140
CALL SOUTZ(CRLF2)
CALL SOUTCR('APPROVED BY: ..............................')
CALL SOUTCR(' (SIGNATURE)')
1140 IF (ALL) GO TO 600
GO TO 530
C JOB SUMMARIES
1150 CALL PSOUTR('OB SUMMARIES')
IA=0
1160 IA=IA+1
IF (IA.GT.NNACT) GO TO 1300
1170 CALL SOUTZ(FORMF)
CALL SOUTZ(' TOPS20 CHARGES FOR ')
CALL ODTIMZ(BEGTAD)
CALL SOUTZ(TO)
CALL ODTIMZ(ENDTAD)
CALL SOUTZ(CRLF)
ENCODE(40,1180,ASCI) ACTNM(IA)
1180 FORMAT(23X,'ACCOUNT:',I9)
ASCI(9)=0
CALL SOUTZ(ASCI)
CALL SOUTZ(CRLF2)
CALL SOUTZ(' USER ')
ENCODE(61,630,ASCI) BIT1
ASCI(13) = 0
CALL SOUTZ(ASCI)
ENCODE (21,635,ASCI) BIT1
ASCI(5) = ASCI(5) .AND. CH(1)
CALL SOUTCR(ASCI)
SPL=.FALSE.
NACCT=ACTNM(IA)
ASSIGN 1190 TO TZERO
GO TO 3040
1190 DO 1230 I=1,NID
ASSIGN 1200 TO LOCENT
ASSIGN 1230 TO ENTNF
GO TO 3320
1200 IF (ACNT(IAC+ACTACT).LT.0) GO TO 1230
USER=ID(I).AND.R7
ASSIGN 1210 TO NAME
GO TO 3190
1210 CPU=ACNT(IAC+ACTCPU)
CONS=ACNT(IAC+ACTCON)
PAGE=ACNT(IAC+ACTFIL)
LINES=ACNT(IAC+ACTLPT)
CARDS=ACNT(IAC+ACTCDR)
OTHER=0.
CHARGE=0.
ASSIGN 1230 TO OUT
ACODE=ACNT(IAC+ACTACT).AND.BIT12
IF((ACNT(IAC+ACTSP).AND.L7).NE.0) GO TO 1220
GO TO 3050
1220 NACCT1=NACCT
ASSIGN 3050 TO SPAD
GO TO 3340
1230 CONTINUE
ASSIGN 1240 TO OUT
GO TO 700
C ITEMIZE OTHER
1240 IF(.NOT.SPL) GO TO 1280
CALL SOUTCR(CRLF2)
ENCODE(50,1250,ASCI) ACTNM(IA)
1250 FORMAT(15X,'ITEMIZED OTHER COSTS FOR',I9,2X)
ASCI(11)=0
CALL SOUTZ(ASCI)
CALL SOUTZ(CRLF2)
CALL SOUTZ(' USER ')
ENCODE (50,1260,ASCI) BIT1
1260 FORMAT(12X,'ITEM',A1,26X,'CHARGE')
CALL SOUTCR(ASCI)
ITEM=.TRUE.
USER=-1
ASSIGN 1270 TO SPAD
GO TO 3340
1270 ITEM=.FALSE.
1280 IF (COMND2.EQ.'I') GO TO 530
GO TO 1160
C USER COST SUMMARIES
1290 CALL PSOUTR('SER COST SUMMARIES')
1300 DO 1470 I=1,NID
IF(COMND2.EQ.'J'.AND.ID(I).GE.0) GO TO 1470
USER=ID(I).AND.R7
1310 IAC=(ID(I).AND.L7)/BIT17
CALL SOUTZ(FORMF)
CALL SOUTZ(' TOPS20 CHARGES FOR ')
CALL ODTIMZ(BEGTAD)
CALL SOUTZ(TO)
CALL ODTIMZ(ENDTAD)
CALL SOUTZ(CRLF)
CALL DIRSTZ(USER,ASCI,NCHAR)
CALL SOUTZ(' USER: ')
CALL SOUTZ(ASCI)
CALL SOUTZ(CRLF2)
SPL=.FALSE.
IF(ID(I).LT.0) GO TO 1320
CALL SOUTZ(' ACCOUNT ')
GO TO 1330
1320 CALL SOUTZ('ACCOUNT ')
1330 ENCODE (61,630,ASCI) BIT1
ASCI(13) = 0
CALL SOUTZ(ASCI)
ENCODE (21,635,ASCI) BIT1
ASCI(5) = ASCI(5) .AND. CH(1)
CALL SOUTCR(ASCI)
ASSIGN 1340 TO TZERO
GO TO 3040
1340 ASSIGN 1400 TO OUT
ASSIGN 1380 TO ACTNO
1350 NACCT=ACNT(IAC+ACTACT)
IF ( NACCT .EQ. NBIT2 ) GO TO 1400
ACODE=ACNT(IAC+ACTACT).AND.BIT12
GO TO 3280
1380 CPU=ACNT(IAC+ACTCPU)
CONS=ACNT(IAC+ACTCON)
PAGE=ACNT(IAC+ACTFIL)
LINES=ACNT(IAC+ACTLPT)
CARDS=ACNT(IAC+ACTCDR)
OTHER=0.
CHARGE=0.
IF((ACNT(IAC+ACTSP).AND.L7).NE.0) GO TO 1390
GO TO 3050
1390 NACCT1=NACCT
ASSIGN 3050 TO SPAD
GO TO 3340
1400 IF(ACNT(IAC+ACTPTR).LT.0) GO TO 1410
IAC=ACNT(IAC+ACTPTR).AND.R7
GO TO 1350
1410 ASSIGN 1420 TO OUT
GO TO 700
C ITEMIZE OTHER
1420 IF(.NOT.SPL) GO TO 1460
CALL SOUTZ(CRLF2)
CALL SOUTZ(CRLF)
CALL DIRSTZ(USER,ASCI,NCHAR)
CALL SOUTZ(' ITEMIZED OTHER COSTS FOR ')
CALL SOUTZ(ASCI)
CALL SOUTZ(CRLF2)
IF(ID(I).LT.0) GO TO 1430
CALL SOUTZ(' ACCOUNT ')
GO TO 1440
1430 CALL SOUTZ('ACCOUNT ')
1440 ENCODE(50,1260,ASCI) BIT1
ASCI(11)=0
CALL SOUTCR(ASCI)
ITEM=.TRUE.
NACCT1=NBIT2
ASSIGN 1450 TO SPAD
GO TO 3340
1450 ITEM=.FALSE.
1460 IF(COMND2.EQ.'I') GO TO 530
1470 CONTINUE
GO TO 530
C INDIVIDUAL JOB SUMMARY
1480 TYPE 1490
1490 FORMAT('+NDIVIDUAL JOB SUMMARY FOR (N,U): '$)
CALL RCHAR(NA)
IF(NA.EQ.'N'.OR.NA.EQ.'U') GO TO 1500
TYPE 60
GO TO 530
1500 TYPE 1510
1510 FORMAT(2H+ $)
IF(NA.EQ.'U') GO TO 1550
C NUMERIC
1520 ACCEPT 1530,NACCT
1530 FORMAT(I)
DO 1540 IA=1,NNACT
IF(ACTNM(IA).EQ.NACCT) GO TO 1170
1540 CONTINUE
CALL PSOUTR(' NONEXISTENT ACCOUNT')
GO TO 530
C USER
1550 ASSIGN 1570 TO DIRERR
CALL STDIRZ(USER,TYPE,DIRERR)
DO 1560 I=1,NID
IF((ID(I).AND.R7).EQ.USER) GO TO 1310
1560 CONTINUE
CALL PSOUTR(' USER NOT ON USER LIST FOR THIS PAY PERIOD')
GO TO 530
1570 CALL PSOUTR(' USER ID NOT IN DIRECTORY')
GO TO 530
C YEAR-TO-DATE ACCOUNTING
1580 CALL PSOUTR('EAR-TO-DATE ACCOUNTING')
1590 CALL PSOUTZ('IS THIS THE FIRST PAY PERIOD OF THE YEAR? (Y,N)
1 ')
CALL RCHAR(CHAR)
CALL PSOUTR(BIT1)
IF(CHAR.EQ.'Y'.OR.CHAR.EQ.'N') GO TO 1600
TYPE 60
GO TO 1590
1600 FIRST=.FALSE.
IF(CHAR.EQ.'Y') FIRST=.TRUE.
IF(FIRST) GO TO 1610
CALL PSOUTZ('MOST RECENT YEAR-TO-DATE FILE:')
ASSIGN 1660 TO ENDF
REASON(1)=0
CALL OPENFZ(REASON)
EOF=.FALSE.
1610 CALL PSOUTZ('NEW YEAR-TO-DATE OUTPUT FILE:')
CALL BINOF
DO 1620 I=1,6
CALL WWORD(PAYDT(I))
IF(FIRST) GO TO 1620
CALL RWORD(WORD(I),ENDF)
1620 CONTINUE
WORD(1)=-1
WORDR=.FALSE.
SUMARY=.TRUE.
GO TO 880
C CLOSE BINARY FILE
1630 CALL CLOSB
GO TO 530
C (READB) - READ FROM BINARY FILE
1640 IF(EOF.OR.FIRST.OR.WORDR) GO TO READB
DO 1650 II=1,6
1650 CALL RWORD(WORD(II),ENDF)
WORDR=.TRUE.
GO TO READB
C END OF FILE
1660 EOF=.TRUE.
GO TO READB
C (BINO) - OUTPUT TO BINARY FILE
1670 CPU=0
CONS=0
PAGE=0
LINES=0
CARDS=0
OTHER=0.
CHARGE=0.
1680 ACNUM=WORD(1)
CPU=CPU+WORD(2)
CONS=CONS+WORD(3)
PAGE=PAGE+WORD(4)
OTHER=OTHER+WORD(5)/100.
CHARGE=CHARGE+WORD(6)/100.
WORDR=.FALSE.
1690 CALL WWORD(ACNUM)
CALL WWORD(CPU)
CALL WWORD(CONS)
CALL WWORD(PAGE)
TEMP=IFIXR(OTHER*100.)
CALL WWORD(TEMP)
TEMP=IFIXR(CHARGE*100.)
CALL WWORD(TEMP)
CALL WWORD(LINES)
CALL WWORD(CARDS)
GO TO BINO
C YEAR-TO-DATE SUMMARY
1700 CALL PSOUTZ('UMMARY FOR YEAR-TO-DATE FILE: ')
SCOMND='S1'
ASSIGN 1770 TO ENDF
REASON(1)=0
1710 CALL OPENFZ(REASON)
CALL SOUTZ(FORMF)
CALL SOUTCR(' CUMULATIVE YEAR-TO-DATE
1 TIME SHEET')
CALL SOUTZ(' ENDING IN PAY PERIOD ')
DO 1720 I=1,6
1720 CALL RWORD(ASCI(I),ENDF)
CALL SOUTZ(ASCI)
CALL SOUTZ(CRLF2)
CALL SOUTZ('JOB NUMBER')
ENCODE(61,630,ASCI) BIT1
ASCI(13) = 0
CALL SOUTZ(ASCI)
ENCODE (21,635,ASCI) BIT1
ASCI(5) = ASCI(5) .AND. CH(1)
CALL SOUTCR(ASCI)
ASSIGN 1730 TO TZERO
GO TO 3040
1730 DO 1740 I=1,YTDSIZ
1740 CALL RWORD(WORD(I),ENDF)
IF(SCOMND.EQ.'S1'.AND.WORD(6).EQ.0) GO TO 1730
CPU=WORD(2)
CONS=WORD(3)
PAGE=WORD(4)
OTHER=WORD(5)/100.
CHARGE=WORD(6)/100.
LINES=WORD(7)
CARDS=WORD(8)
IF(WORD(1).LT.0) GO TO 1750
NACCT=WORD(1)
ASSIGN 1760 TO ACTNO
GO TO 3280
1750 USER=-WORD(1)
ASSIGN 1760 TO NAME
GO TO 3190
1760 ASSIGN 1730 TO OUT
GO TO 3070
C TOTAL
1770 ASSIGN 1780 TO OUT
GO TO 700
1780 IF(SCOMND.EQ.'S2') GO TO 530
CALL SOUTZ(CRLF2)
CALL SOUTCR('APPROVED BY: ..............................')
CALL SOUTCR(' (SIGNATURE)')
SCOMND='S2'
GO TO 1710
C ADJUST CHARGES PROGRAM
1790 CALL PSOUTR(' *OK*')
GO TO 1830
1800 CALL PSOUTR('DJUST CHARGES')
IF(.NOT.REPORT.AND.NENTRY.GT.0) GO TO 285
1810 ASSIGN 1820 TO CNTLE
CALL ION(CNTLE)
1820 CALL PSOUTR(ZERO)
1830 NACCT1=NBIT2
WORD(5)=NBIT2
USER=-1
NACCT2=NBIT2
CONS=0
CPU=0
PAGE=0
LINES=0
CARDS=0
FILFIX=1.
DELETE=.FALSE.
REASON(1)=0
DOLLAR=0.
INSERT=.FALSE.
COMND=0
1850 TYPE 1860
1860 FORMAT(' ADJUST>'$)
CALL RCHAR(COMND3)
IF (COMND3.EQ.'I') GO TO 1920
COMND=COMND+1
IF (COMND3.EQ.CR ) GO TO 1875
IF (COMND3.EQ.'L') GO TO 2215
IF (COMND3.EQ.'C') GO TO 2217
IF (COMND3.EQ.'E') GO TO 1900
IF (COMND3.EQ.'G') GO TO 280
IF (COMND3.EQ.'D') GO TO 1910
IF (COMND3.EQ.'A') GO TO 1940
IF (COMND3.EQ.'U') GO TO 2000
IF (COMND3.EQ.'N') GO TO 2050
IF (COMND3.EQ.'T') GO TO 2090
IF (COMND3.EQ.'F') GO TO 2220
IF (COMND3.EQ.'$') GO TO 2250
IF (COMND3.EQ.'R') GO TO 2270
IF (COMND3.EQ.'P') GO TO 2300
IF (COMND3.EQ.'B') GO TO 2320
IF (COMND3.EQ.'?') GO TO 1880
TYPE 60
1870 COMND=COMND-1
GO TO 1850
1875 CALL RCHAR(TEMP)
GO TO 1850
1880 TYPE 1890
1890 FORMAT(' ADJUSTMENT SECTION TYPE FIRST CHARACTER',
1'TO HAVE EFFECT:'/' EXIT TO ACCT20'/' GO TO REPORT ',
2'SECTION'/' DELETE'/' ACCOUNT NR.'/' USER ID'/' NEW ACCOUNT ',
3'NR.'/' CPU AND CONSOLE TIME'/' LINE PRINTER PAGES'/' CARDS READ'/
4' FILE PAGE DISCOUNT'/' $ TO BE CHARGED'/' REASON FOR CHARGE'/
5' PAGE ADJUSTMENT'/' BEGIN ADJUSTMENT'/' ?-THIS TEXT'/)
GO TO 1870
1900 CALL PSOUTR('XIT TO ACCT20')
GO TO 10
C DELETE,INSERT
1910 CALL PSOUTR('ELETE')
IF(INSERT) GO TO 1930
DELETE=.TRUE.
GO TO 1850
1920 CALL PSOUTR('NSERT')
IF (COMND.NE.0) GO TO 1930
INSERT=.TRUE.
GO TO 1850
1930 CALL PSOUTR(' INCONSISTENT COMMAND')
GO TO 1850
C ACCOUNT NUMBER
1940 TYPE 1950
1950 FORMAT('+CCOUNT NUMBER (N,A)= '$)
CALL RCHAR(NA)
IF(NA.EQ.'N'.OR.NA.EQ.'A') GO TO 1960
TYPE 60
GO TO 1850
1960 TYPE 1510
IF(NA.EQ.'A') GO TO 1990
C NUMERIC
1970 ACCEPT 1530,WORD(5)
CALL ACCT(-2,0,NACCT1,0,0,0,0,0)
1980 IF(NACCT1.NE.NBIT2) GO TO 1850
IF(INSERT) GO TO 1850
CALL PSOUTR(' NONEXISTENT ACCOUNT')
GO TO 1870
C ALPHANUMERIC
1990 DO 1991 II = 6,20
1991 WORD(II) = 0
MINSIZ = 5
CALL RALPH(WORD(6),NCHAR)
WORD(MINSIZ)=-NCHAR
SIZE=(NCHAR+4)/5
WORD(1)=SIZE+MINSIZ
CALL ACCT(-2,0,NACCT1,0,0,0,0,0)
GO TO 1980
C USER ID CODE
2000 TYPE 2010
2010 FORMAT('+SER ID CODE: '$)
ASSIGN 2020 TO DIRERR
CALL STDIRZ(USER,TYPE,DIRERR)
IF(INSERT) GO TO 1850
GO TO 2030
2020 CALL PSOUTR(' USER ID NOT IN DIRECTORY')
GO TO 1870
2030 DO 2040 I=1,NID
IF((ID(I).AND.R7).EQ.USER) GO TO 1850
2040 CONTINUE
CALL PSOUTR(' USER NOT IN USER TABLE THIS PAY PERIOD')
USER=-1
GO TO 1870
C NEW ACCOUNT NUMBER
2050 TYPE 2060
2060 FORMAT('+EW ACCOUNT NUMBER (N,A)= '$)
IF(INSERT) GO TO 1930
CALL RCHAR(NA)
IF(NA.EQ.'N'.OR.NA.EQ.'A') GO TO 2070
TYPE 60
GO TO 1850
2070 TYPE 1510
IF(NA.EQ.'A') GO TO 2080
ACCEPT 1530,NACCT2
GO TO 1850
2080 CALL RALPH(ASCI,NCHAR2)
NACCT2=-1
GO TO 1850
C TIME CHANGE
2090 TYPE 2100
2100 FORMAT('+IME CHANGE'/' CPU TIME = '$)
2110 CALL RALPH(ASCI,NCHAR)
IF(NCHAR.EQ.0) GO TO 2150
CALL GETTIM(ASCI,TIME)
CPU = TIME
2190 TYPE 2200
2200 FORMAT(' CONSOLE TIME = '$)
CALL RALPH(ASCI,NCHAR)
IF(NCHAR.EQ.0) GO TO 2150
CALL GETTIM(ASCI,TIME)
CONS = TIME
GO TO 1850
2150 CALL PSOUTR(' INCORRECT FORMAT')
GO TO 1850
C FILE PAGE DISCOUNT
2220 TYPE 2230
2230 FORMAT('+ILE PAGE DISCOUNT = '$)
ACCEPT 2240,FILFIX
2240 FORMAT(F)
GO TO 1850
C LINES PRINTED
2215 TYPE 2216
2216 FORMAT ('+INE PRINTER PAGES = '$)
ACCEPT 1530, LINES
GO TO 1850
C CARDS READ
2217 TYPE 2218
2218 FORMAT ('+ARDS READ = '$)
ACCEPT 1530,CARDS
GO TO 1850
C $ TO BE CHARGED
2250 TYPE 2260
2260 FORMAT('+ TO BE CHARGED = '$)
ACCEPT 2240,DOLLAR
GO TO 1850
C REASON FOR CHARGE:
2270 TYPE 2280
2280 FORMAT('+EASON FOR CHARGE: '$)
DO 2285 II = 1, 9
2285 REASON(II) = 0
CALL RALPH(REASON,NCHAR)
IF(NCHAR.EQ.0) GO TO 1850
SIZE=NCHAR/5+1
REASON(9)=SIZE
TEMP=SIZE*5-NCHAR-1
IF(TEMP.EQ.0) GO TO 1850
C FILL IN SPACES
J="100
DO 2290 I=1,TEMP
J=128*J
2290 REASON(SIZE)=REASON(SIZE).OR.J
GO TO 1850
C PAGE ADJUSTEMT
2300 TYPE 2310
2310 FORMAT('+AGE ADJUSTMENT = '$)
ACCEPT 1530,PAGE
GO TO 1850
C BEGIN ADJUSTMENT
2320 CALL PSOUTR('EGIN ADJUSTMENT')
IF(INSERT) GO TO 2370
IF(NACCT1.NE.NBIT2.AND.USER.NE.-1) GO TO 2360
IF(USER.NE.-1) GO TO 2340
IF(NACCT1.EQ.NBIT2) GO TO 2330
IF(NACCT1.GE.0) GO TO 2430
2330 CALL PSOUTR(' ILLEGAL ACCOUNT-USER COMBINATION')
GO TO 1830
2340 IF(TYPE.GE.0) GO TO 2330
IF(NACCT2.EQ.NBIT2) GO TO 2350
CALL PSOUTR(' OLD ACCOUNT NOT GIVEN')
GO TO 1830
2350 IF(DELETE) GO TO 2430
GO TO 2330
2360 CALL ACCT(-1,USER,NACCT1,0,0,0,0,0)
IF(NACCT1.NE.NBIT2) GO TO 2430
CALL PSOUTR(' ACCOUNT-USER COMBINATION NONEXISTENT')
GO TO 1830
C INSERT
2370 IF(REASON(1).NE.0.OR.DOLLAR.EQ.0.) GO TO 2380
CALL PSOUTR(' REASON FOR $ TO BE CHARGED NOT GIVEN')
GO TO 1830
2380 IF(WORD(5).NE.NBIT2.AND.USER.NE.-1) GO TO 2400
IF(USER.NE.-1) GO TO 2390
CALL PSOUTR(' USER ID MISSING')
GO TO 1830
2390 IF(TYPE.LT.0) GO TO 2410
CALL PSOUTR(' NUMERIC ACCOUNT MISSING')
GO TO 1830
2400 IF((WORD(5).XOR.TYPE).GE.0) GO TO 2420
CALL PSOUTR(' ACCOUNT NO. AND USER ID OF MIXED TYPES')
GO TO 1830
2410 IF(WORD(5).NE.NBIT2) GO TO 2420
WORD(5)=-4
WORD(6)=STAR4
WORD(1)=6
2420 TEMP=NID
CALL ACCT(0,USER,NACCT1,0,0,0,0,0)
IF(TEMP.EQ.NID) GO TO 2430
CALL CATEG(ID(NID))
CALL DIRSTZ(USER,LOG(NID+1),NCHAR)
LOG(NID+1)=LOG(NID+1).AND.SIXMSK
C ADJUSTMENTS
2430 IF(.NOT.DELETE) GO TO 2630
C DELETE
NACCT=NACCT1
IF(USER.EQ.-1) GO TO 2570
DO 2440 I=1,NID
IF((ID(I).AND.R7).EQ.USER) GO TO 2460
2440 CONTINUE
2450 CALL PSOUTR(' OPERATION ABORTED')
GO TO 1830
2460 IF(NACCT1.EQ.NBIT2) GO TO 2540
ASSIGN 2470 TO LOCENT
ASSIGN 2450 TO ENTNF
GO TO 3320
2470 ACNT(IAC)=NBIT2
EMPTY=EMPTY+1
IF(IAC2.EQ.0) GO TO 2490
ACNT(IAC2+1)=(ACNT(IAC+1).AND.R7).OR.(ACNT(IAC2+1).AND.L7)
1 .OR.(ACNT(IAC+1).AND.BIT0)
2480 IF((ACNT(IAC+1).AND.L7).EQ.0) GO TO 2530
ASSIGN 2530 TO SPAD
GO TO 3340
2490 IF(ACNT(IAC+1).LT.0) GO TO 2500
ID(I)=(ID(I).AND.R7).OR.((ACNT(IAC+1).AND.R7)*BIT17).OR.
1 (ID(I).AND.BIT0)
GO TO 2480
2500 IF((ACNT(IAC+1).AND.L7).EQ.0) GO TO 2510
ASSIGN 2510 TO SPAD
GO TO 3340
2510 DO 2520 J=I,NID
LOG(J+1)=LOG(J+2)
2520 ID(J)=ID(J+1)
NID=NID-1
I=I-1
2530 IF(.NOT.DELETE) GO TO 2710
IF(NACCT1.EQ.NBIT2) GO TO 1790
IF(USER.EQ.-1) GO TO 2580
GO TO 1790
C DELETE ALPHANUMERIC USER
2540 IAC=(ID(I).AND.L7)/BIT17
2550 IAC=IAC.AND.R7
NACCT=ACNT(IAC).AND.ACTMSK
ACNT(IAC)=NBIT2
EMPTY=EMPTY+1
IF((ACNT(IAC+1).AND.L7).EQ.0) GO TO 2560
ASSIGN 2560 TO SPAD
GO TO 3340
2560 IAC=ACNT(IAC+1)
IF(IAC.GT.0) GO TO 2550
GO TO 2510
C DELETE ACCOUNT
2570 I=0
2580 I=I+1
IF(ID(I).EQ.0) GO TO 2590
ASSIGN 2470 TO LOCENT
ASSIGN 2580 TO ENTNF
GO TO 3320
2590 IF(NACCT1.LT.0) GO TO 1790
DO 2600 I=1,NNACT
IF(NACCT1.EQ.ACTNM(I)) GO TO 2610
2600 CONTINUE
GO TO 2450
2610 DO 2620 J=I,NNACT
2620 ACTNM(J)=ACTNM(J+1)
NNACT=NNACT-1
GO TO 1790
C NEW ACCOUNT
2630 IF(NACCT2.EQ.NBIT2) GO TO 2760
WORD(5)=NACCT2
IF(NACCT2.GE.0) GO TO 2650
WORD(5)=-NCHAR2
SIZE=(NCHAR2+4)/5
WORD(1)=SIZE+5
DO 2640 I=1,SIZE
2640 WORD(5+I)=ASCI(I)
2650 IF(USER.EQ.-1) GO TO 2730
DO 2660 I=1,NID
IF((ID(I).AND.R7).EQ.USER) GO TO 2670
2660 CONTINUE
GO TO 2450
2670 NACCT=NACCT1
ASSIGN 2680 TO LOCENT
ASSIGN 2450 TO ENTNF
GO TO 3320
2680 AC1=IAC
TEMP=ID(I).AND.R7
CALL ACCT(0,TEMP,NACCT2,0,0,0,0,0)
NACCT=NACCT2
ASSIGN 2690 TO LOCENT
ASSIGN 2450 TO ENTNF
GO TO 3320
2690 DO 2700 J=2,4
2700 ACNT(IAC+J)=ACNT(IAC+J)+ACNT(AC1+J)
NACCT=NACCT1
GO TO 2460
2710 IF(USER.EQ.-1) GO TO 2740
IF(NACCT1.LT.0) GO TO 1790
DO 2720 IA=2,IACF,ACNTSZ
IF((ACNT(IA).AND.ACTMSK).EQ.NACCT1) GO TO 1790
2720 CONTINUE
GO TO 2590
C ALL USERS
2730 I=0
2740 I=I+1
IF(ID(I).EQ.0) GO TO 2590
NACCT=NACCT1
ASSIGN 2750 TO LOCENT
ASSIGN 2740 TO ENTNF
GO TO 3320
2750 GO TO 2680
C SPECIAL CHARGES
2760 IF(REASON(1).EQ.0) GO TO 2840
IF(USER.NE.-1) GO TO 2770
CALL PSOUTR(' USER ID MISSING')
GO TO 1830
2770 DO 2780 I=1,NID
IF((ID(I).AND.R7).EQ.USER) GO TO 2790
2780 CONTINUE
GO TO 2450
2790 NACCT=NACCT1
ASSIGN 2800 TO CLASS
GO TO 3140
2800 IF((NACCT.AND.BIT12).NE.0) GO TO 2810
CALL PSOUTR(' NO SPECIAL CHARGES FOR NONCHARGEABLE ACCOUNTS')
GO TO 1830
2810 NACCT=NACCT1
ASSIGN 2820 TO LOCENT
ASSIGN 2450 TO ENTNF
GO TO 3320
2820 ACNT(IAC+1)=ACNT(IAC+1).OR.BIT17
S=SP(1)
K=REASON(9)+3
SP(1)=SP(1)+K
SP(S)=K.OR.(USER*BIT17)
SP(S+1)=NACCT1
SP(S+2)=DOLLAR*100.
DO 2830 I=1,REASON(9)
2830 SP(S+I+2)=REASON(I)
GO TO 1790
C CONS,CPU & PAGE CHARGES
C FILE CHARGE DISCOUNT
C DOLLARS TO BE CHARGED
2840 NACCT=NACCT1
ASSIGN 2850 TO CLASS
GO TO 3140
2850 ACODE=NACCT.AND.BIT12
IF(ACODE.EQ.BIT1) GO TO 2870
IF(ACODE.EQ.BIT2) GO TO 2860
IF(DOLLAR.EQ.0.) GO TO 2870
CALL PSOUTR(' NO DOLLAR CHARGES FOR NONCHARGEABLE ACCOUNTS')
GO TO 1830
2860 RCPU=GRCPU
RCON=GRCON
GO TO 2880
2870 RCPU=CRCPU
RCON=CRCON
2880 IF(USER.EQ.-1) GO TO 2950
DO 2890 I=1,NID
IF((ID(I).AND.R7).EQ.USER) GO TO 2900
2890 CONTINUE
GO TO 2450
2900 NACCT=NACCT1
ASSIGN 2910 TO LOCENT
ASSIGN 2450 TO ENTNF
GO TO 3320
2910 TCPU=ACNT(IAC+2)
TCONS=ACNT(IAC+3)
2920 DCPU=TCPU/60.*RCPU
DCON=TCONS/3600.*RCON
CHARGE=DCPU+DCON
CPU2=CPU
CON2=CONS
IF(CHARGE.EQ.0.) GO TO 2930
CPU2=DCPU/CHARGE*DOLLAR/RCPU*60.+CPU2
CON2=DCON/CHARGE*DOLLAR/RCON*3600.+CON2
2930 IF((CPU2+TCPU).GE.0..AND.(CON2+TCONS).GE.0.) GO TO 2940
CALL PSOUTR(' ADJUSTMENT RESULTS IN NEGATIVE CPU OR CONSOLE
1 TIME')
GO TO 1830
2940 IF(USER.EQ.-1) GO TO 2980
ACNT(IAC+ACTCPU)=IFIXR(TCPU+CPU2)
ACNT(IAC+ACTCON)=IFIXR(TCONS+CON2)
ACNT(IAC+ACTFIL)=IFIXR((ACNT(IAC+ACTFIL)+PAGE)*FILFIX)
IF ( ACNT(IAC+ACTCDR)+CARDS .GE. 0 ) GO TO 2943
CALL PSOUTR ('? ADJUSTMENT RESULTS IN NEGATIVE # OF CARDS READ')
GO TO 1850
2943 IF ( ACNT(IAC+ACTLPT)+LINES .GE. 0 ) GO TO 2945
CALL PSOUTR('? ADJUSTMENT RESULTS IN NEGATIVE # OF LINES PRINTED')
2945 ACNT(IAC+ACTLPT)=ACNT(IAC+ACTLPT)+LINES
ACNT(IAC+ACTCDR)=ACNT(IAC+ACTCDR)+CARDS
GO TO 1790
C ALL USERS
2950 NACCT=NACCT1
TCPU=0
TCONS=0
TPAGE=0
DO 2970 I=1,NID
ASSIGN 2960 TO LOCENT
ASSIGN 2970 TO ENTNF
GO TO 3320
2960 TCPU=TCPU+ACNT(IAC+2)
TCONS=TCONS+ACNT(IAC+3)
TPAGE=TPAGE+ACNT(IAC+4)
2970 CONTINUE
GO TO 2920
2980 DO 3030 I=1,NID
ASSIGN 2990 TO LOCENT
ASSIGN 3030 TO ENTNF
GO TO 3320
2990 IF(TCPU.EQ.0) GO TO 3000
ACNT(IAC+2)=IFIXR(ACNT(IAC+2)*(1.+CPU2/TCPU))
3000 IF(TCONS.EQ.0) GO TO 3010
ACNT(IAC+3)=IFIXR(ACNT(IAC+3)*(1.+CON2/TCONS))
3010 XTEM=ACNT(IAC+4)*FILFIX
IF(TPAGE.EQ.0) GO TO 3020
XTEM=ACNT(IAC+4)*(1.+(PAGE+0.)/TPAGE)*FILFIX
3020 ACNT(IAC+4)=IFIXR(XTEM)
3030 CONTINUE
GO TO 1790
C (TZERO) - ZERO TOTALS
3040 TCPU=0
TCONS=0
TPAGE=0
TLINES=0
TCARDS=0
TOTHER=0.
TCHARG=0.
GO TO TZERO
C (OUT) - OUTPUT CHARGES
3050 CHARGE=0.
IF(ACODE.EQ.BIT1) GO TO 3060
IF(ACODE.EQ.0) GO TO 3070
CHARGE=CHARG(GRCPU,GRCON,GRCHAR,GRLINE,GRCARD)
GO TO 3070
3060 CHARGE=CHARG(CRCPU,CRCON,CRCHAR,CRLINE,CRCARD)
3070 CHARGE=IFIXR(CHARGE*100.)/100.
TCPU=TCPU+CPU
TCONS=TCONS+CONS
TPAGE=TPAGE+PAGE
TLINES=TLINES+LINES
TCARDS=TCARDS+CARDS
TOTHER=TOTHER+OTHER
TCHARG=TCHARG+CHARGE
IF(SUMARY) GO TO OUT
3080 TIME=CPU
IND=1
GO TO 3130
3090 ENCODE(20,3100,ASCI) HOUR,MIN,SEC
3100 FORMAT(I6,':'I2,':'I2,2X)
ASCI(3)=ASCI(3).AND..NOT."377
CALL SOUTZ(ASCI)
TIME=CONS
IND=2
GO TO 3130
3110 ENCODE (20,3100,ASCI) HOUR,MIN,SEC
ASCI(3)=ASCI(3).AND..NOT."377
CALL SOUTZ(ASCI)
ENCODE(53,3120,ASCI) PAGE,LINES,CARDS,OTHER,CHARGE
3120 FORMAT(I10,2X,I8,2X,I8,F11.2,F12.2)
ASCI(11)=ASCI(11).AND."777777700000
CALL SOUTCR(ASCI)
GO TO OUT
3130 MIN=TIME/60
SEC=TIME-MIN*60
HOUR=MIN/60
MIN=MIN-HOUR*60
GO TO (3090,3110),IND
C (CLASS) - CLASSIFY ACCOUNT NUMBERS BY CHARGE CLASS
C GOVERNMENT RATE(01),COMMERCIAL RATE(10),FREE(00)
C
C CURRENT CLASSIFICATION ALGORITHM --
C NUMERIC ACCOUNTS < 1000 ARE NON-CHARGEABLE
C ALL OTHER ACCOUNTS ARE COMMERCIAL RATE
C GOVERNMENT RATE IS NOT USED
3140 IF((NACCT.AND.BIT12).NE.0) GO TO CLASS
IF ( NACCT .LT. 0 ) GO TO 3180
C NUMERIC ACCOUNTS
TEMP = NACCT
C NON-CHARGEABLE ACCOUNTS
IF(TEMP.LE.999) GO TO CLASS
C COMMERCIAL RATE
3150 NACCT=TEMP.OR.BIT1
GO TO CLASS
C GOVERNMENT RATE
3160 NACCT=TEMP.OR.BIT2
3170 GO TO CLASS
C ALPHANUMERIC ACCOUNTS
C COMMERCIAL RATE
3180 NACCT = NACCT .OR. BIT1
GO TO CLASS
C (NAME) - OUTPUT USER NAME
3190 CALL DIRSTZ(USER,ASCI,NCHAR)
IF(NCHAR.GT.0) GO TO 3210
ENCODE(31,3200,ASCI) USER
3200 FORMAT('*USER ID CODE ',O6,' NOT IN USE')
ASCI(7)=ASCI(7).AND.LBYTE
CALL SOUTZ(ASCI)
GO TO 3260
3210 CALL SOUTZ(ASCI)
3220 IF (NCHAR-10) 3230,3270,3260
3230 IF (NCHAR.GT.5) GO TO 3240
CALL SOUTZ(' ')
IF (NCHAR.EQ.5) GO TO 3270
3240 TEMP=5-NCHAR+NCHAR/5*5
DO 3250 J=1,TEMP
3250 CALL SOUTZ(BIT1)
GO TO 3270
3260 CALL SOUTZ(CRLF)
CALL SOUTZ(' ')
3270 GO TO NAME
C (ACTNO) - OUTPUT ACCOUNT NUMBER
3280 IF(NACCT.LT.0) GO TO 3300
C NUMERIC
NACCT=NACCT.AND.ACTMSK
ENCODE(10,3290,ASCI) NACCT
3290 FORMAT(I9,1X)
ASCI(3)=0
CALL SOUTZ(ASCI)
GO TO ACTNO
C ALPHANUMERIC
3300 IA=(NACCT.XOR.BIT0).AND.ACTMSK
NCHAR=(ACTAL(IA).AND.L7)/BIT17
LIM = NCHAR / 5
IF ( NCHAR .GT. LIM*5 ) LIM = LIM + 1
DO 3304 I = 1,10
3304 TEXT(I) = 0
DO 3305 I = 1, LIM
3305 TEXT(I) = ACTAL(I+IA)
CALL SOUTZ(TEXT)
ASSIGN 3310 TO NAME
GO TO 3220
3310 GO TO ACTNO
C (LOCENT) - LOCATE ENTRY
C (ENTNF) - ENTRY NOT FOUND
3320 IAC2=0
NACCT=NACCT.AND.ACTMSK
IAC=(ID(I).AND.L7)/BIT17
3330 TEM=ACNT(IAC+ACTACT).AND.ACTMSK
IF(TEM.EQ.NACCT) GO TO LOCENT
IF(ACNT(IAC+ACTPTR).LT.0) GO TO ENTNF
IAC2=IAC
IAC=ACNT(IAC+ACTPTR).AND.R7
GO TO 3330
C (SPAD) - SPECIAL CHARGES - ADDED OR DELETED
3340 K=0
S=2
3350 S=S+K
IF(S.EQ.SP(1)) GO TO SPAD
IF(SP(S).LT.0) GO TO 3390
IF(USER.EQ.-1) GO TO 3360
USE=(ID(I).AND.R7)*BIT17
IF(USE.NE.(SP(S).AND.L7)) GO TO 3390
3360 IF(NACCT1.EQ.NBIT2) GO TO 3370
TEM=SP(S+1).AND.ACTMSK
IF((NACCT.AND.ACTMSK) .NE. TEM) GO TO 3390
3370 IF(COMND3.EQ.0) GO TO 3380
SP(S)=SP(S).OR.BIT0
GO TO 3390
3380 IF(ITEM) GO TO 3400
OTHER=OTHER+SP(S+2)/100.
SPL=.TRUE.
3390 K=SP(S).AND.R7
GO TO 3350
C ITEMIZE
3400 IF(NACCT1.EQ.NBIT2) GO TO 3420
USER=(SP(S).AND.L7)/BIT17
ASSIGN 3410 TO NAME
GO TO 3190
3410 USER=-1
GO TO 3430
3420 NACCT=SP(S+1)
ASSIGN 3430 TO ACTNO
GO TO 3280
3430 CALL SOUTZ(BIT1)
CALL SOUTZ(SP(S+3))
SIZE=(SP(S).AND.R7)-3
TEMP=8-SIZE
IF(SIZE.EQ.0) GO TO 3450
DO 3435 II = 1, 10
3435 TEXT(II) = 0
DO 3440 II=1,SIZE
3440 TEXT(II) = SP( (S+3)+II-1 )
NCHAR = 0
DO 3442 II = 1, 8
DO 3442 J = 1, 5
K = CH(J) .AND. TEXT(II)
IF ( K .NE. 0 ) NCHAR = NCHAR + 1
3442 CONTINUE
CALL SOUTZ(TEXT)
DO 3444 II = 1, 39-NCHAR
3444 CALL SOUTZ( BIT1 )
3450 OTHER=SP(S+2)/100.
ENCODE(10,3460,ASCI) OTHER
3460 FORMAT(F9.2,1X)
ASCI(3)=0
CALL SOUTCR(ASCI)
GO TO 3390
C READ DEFAULT ACCOUNT FILE
4000 TYPE 4100
4100 FORMAT ('+ALIDATE ACCOUNTS'/' FILE OF DEFAULT ACCOUNTS: '$)
CALL ASCIF (0)
ASSIGN 5000 TO EOF
DEFNDX = 1 - DEFSIZ
4200 DEFNDX = DEFNDX + DEFSIZ
4210 NCHAR = 39
DO 4250 II = 1, 15
4250 ASCI(II) = 0
CALL SINA (ASCI,EOF,NCHAR)
CALL STDIR2(ASCI,USER)
IF ( USER .EQ. -1 ) GO TO 4210
DEFALT(DEFNDX+DEFUSR) = USER
DO 4270 II = 1, 15
4270 ASCI(II) = 0
CALL SINA2 (ASCI,EOF,NCHAR)
CALL TSTNUM (ASCI, NACCT)
IF (NACCT .EQ. -1) GO TO 4300
DEFALT(DEFNDX+DEFACT) = NACCT
GO TO 4200
C HERE FOR ALPHANUMERIC ACCOUNTS
4300 I = 1
NWORDS = NCHAR / 5
IF ( MOD(NCHAR,5) .NE. 0 )NWORDS=NWORDS+1
4400 K = ACTAL(I) .AND. R7
IF ( K .EQ. 0 ) GO TO 4700
IF ( K .NE. NWORDS ) GO TO 4600
DO 4500 J = 1, NWORDS
4500 IF ( ACTAL(I+J) .NE. ASCI(J) )GO TO 4600
DEFALT(DEFNDX+DEFACT) = I .OR. BIT0
GO TO 4200
4600 I = I + K + 1
GO TO 4400
4700 DEFALT(DEFNDX+DEFACT) = I .OR. BIT0
ACTAL(I) = NCHAR*BIT17 + NWORDS
DO 4800 J = 1, NWORDS
ACTAL(I+J) = ASCI(J)
4800 ACTAL(I+J+1) = 0
GO TO 4200
5000 DO 5010 I = 1, LEGMAX
5010 LEGACT(I) = -1
TYPE 5025
5025 FORMAT (' FILE OF VALID ACCOUNTS: '$)
CALL ASCIF(0)
ASSIGN 6000 TO EOF
LEGNDX = 1
5050 DO 5100 II = 1, 15
5100 ASCI(II) = 0
NCHAR = 39
CALL SINA2 (ASCI,EOF,NCHAR)
CALL TSTNUM (ASCI, NACCT)
IF (NACCT .EQ. -1) GO TO 5200
LEGACT(LEGNDX) = NACCT
LEGNDX = LEGNDX + 1
IF ( LEGNDX .GE. LEGMAX ) GO TO 5900
GO TO 5050
5200 I = 1
NWORDS = NCHAR / 5
IF ( MOD(NCHAR,5) .NE. 0 )NWORDS=NWORDS+1
5400 K = ACTAL(I) .AND. R7
IF ( K .EQ. 0 ) GO TO 5700
IF ( K .NE. NWORDS ) GO TO 5600
DO 5500 J = 1, NWORDS
5500 IF ( ACTAL(I+J) .NE. ASCI(J) )GO TO 5600
LEGACT(LEGNDX) = I .OR. BIT0
LEGNDX = LEGNDX + 1
IF ( LEGNDX .GE. LEGMAX ) GO TO 5900
GO TO 5050
5600 I = I + K + 1
GO TO 5400
5700 LEGACT(LEGNDX) = I .OR. BIT0
ACTAL(I) = NCHAR*BIT17 + NWORDS
DO 5800 J = 1, NWORDS
ACTAL(I+J) = ASCI(J)
5800 ACTAL(I+J+1) = 0
LEGNDX = LEGNDX + 1
IF ( LEGNDX .GE. LEGMAX ) GO TO 5900
GO TO 5050
5900 TYPE 5950
5950 FORMAT ('? ACCT20: INTERNAL ERROR')
C VALIDATE THE ACCOUNT FOR EACH ACCOUNT-USER ENTRY
6000 IF ( NID .LT. 1 ) GO TO 40
DO 6900 I = 1, NID
USER = ID(I) .AND. R7
OLDIAC = 0
IAC = ( ID(I) .AND. L7 )/BIT17
DEFIAC = 0
6200 NACCT = ACNT( IAC+ACTACT ) .AND. ACTMSK
DO 6300 J = 1,LEGNDX-1
6300 IF ( NACCT .EQ. LEGACT(J) )GO TO 6800
DO 6400 J = 1,DEFNDX,DEFSIZ
6400 IF ( DEFALT(J+DEFUSR) .EQ. USER )GO TO 6600
CALL PSOUTZ (' DEFAULT ACCOUNT NOT FOUND FOR USER ')
DO 6450 II = 1,15
6450 ASCI(II) = 0
CALL DIRSTZ (USER,ASCI,NCHAR)
CALL PSOUTR (ASCI)
GO TO 6900
6600 IF ( DEFALT(J+DEFACT) .LT. 0 ) ID(I) = ID(I) .OR. BIT0
IF ( DEFALT(J+DEFACT) .LT. 0 ) GO TO 6650
NNACT = NNACT + 1
ACTNM(NNACT) = DEFALT(J+DEFACT)
ACTNM(NNACT+1) = -1
6650 IF ( DEFIAC .NE. 0 ) GO TO 6700
ACNT(IAC+ACTACT) = DEFALT(J+DEFACT)
1 .OR. (ACNT(IAC+ACTACT).AND.BIT12)
DEFIAC = IAC
GO TO 6800
6700 ACNT(DEFIAC+ACTCPU) = ACNT(DEFIAC+ACTCPU) + ACNT(IAC+ACTCPU)
ACNT(DEFIAC+ACTCON) = ACNT(DEFIAC+ACTCON) + ACNT(IAC+ACTCON)
ACNT(DEFIAC+ACTFIL) = ACNT(DEFIAC+ACTFIL) + ACNT(IAC+ACTFIL)
ACNT(DEFIAC+ACTLPT) = ACNT(DEFIAC+ACTLPT) + ACNT(IAC+ACTLPT)
ACNT(DEFIAC+ACTCDR) = ACNT(DEFIAC+ACTCDR) + ACNT(IAC+ACTCDR)
ACNT(IAC+ACTACT) = NBIT2
EMPTY = EMPTY + 1
IF ( OLDIAC .EQ. 0 ) GO TO 6720
ACNT(OLDIAC+ACTPTR) = ( ACNT(IAC+ACTPTR) .AND. R7 )
1 .OR. ( ACNT(IAC+ACTPTR) .AND. BIT0 )
2 .OR. ( ACNT(OLDIAC+ACTSP) .AND. L7 )
GO TO 6800
6720 IF ( ACNT(IAC+ACTPTR) .LT. 0 ) GO TO 6740
ID(I) = ( ID(I) .AND. R7 ) .OR. ( ID(I) .AND. BIT0 )
1 .OR. (( ACNT(IAC+ACTPTR).AND.R7)*BIT17)
GO TO 6800
6740 DO 6760 J = I, NID
LOG(J+1) = LOG(J+2)
6760 ID(J) = ID(J+1)
6800 OLDIAC = IAC
IAC = ACNT(IAC+ACTPTR) .AND. R7
IF (IAC .NE. 0) GO TO 6200
6900 CONTINUE
7000 IF (IACF .EQ. 0) IACF = -3+ACNTSZ*NENTRY
I = 1
7100 DO 7200 IAC = 2, IACF, ACNTSZ
IF ( ACNT(IAC+ACTACT) .EQ. NBIT2 ) GO TO 7200
IF (ACTNM(I).EQ.(ACNT(IAC+ACTACT).AND.ACTMSK)) GO TO 7400
7200 CONTINUE
NNACT = NNACT - 1
J = I
7300 ACTNM(J) = ACTNM(J+1)
IF (ACTNM(J) .EQ. -1) GO TO 7500
J = J + 1
GO TO 7300
7400 I = I + 1
7500 IF ( ACTNM(I) .NE. -1 ) GO TO 7100
GO TO 40
END
C DATA
BLOCK DATA
IMPLICIT INTEGER (A-Z)
COMMON /BDATA/BIT0,BIT1,BIT2,BIT12,BIT17,L7,R7,ACTMSK,NBIT2
COMMON /OUT/ZERO,CRLF,CRLF2,FORMF
COMMON /ACTDEF/ ACNTSZ, ACTACT, ACTSP, ACTPTR, ACTCPU, ACTCON,
1 ACTFIL, ACTLPT, ACTCDR
DATA ACNTSZ, ACTACT, ACTSP, ACTPTR, ACTCPU / 7, 0, 1, 1, 2 /
DATA ACTCON, ACTFIL, ACTLPT, ACTCDR / 3, 4, 5, 6 /
DATA BIT0,BIT1,BIT2/"400000000000,"200000000000,"100000000000/
DATA BIT12,BIT17/"300000000000,"1000000/
DATA L7,R7,ACTMSK/"377777000000,"777777,"477777777777/
DATA CRLF,CRLF2,ZERO/"64240000000,"64241505000,0/
DATA FORMF/"60000000000/
DATA NBIT2/"677777777777/
END
C RFACT
C SUBROUTINE THAT READS IN BINARY FACT FILES
SUBROUTINE RFACT(N)
C N=-2; ZERO HIST(I,J)
C N=-1; OUTPUT HISTOGRAM
C N=0 ; READ FACT FILE
C N=1 ; PERFORM ACCOUNTING FOR JOBS NOT LOGGED OUT
IMPLICIT INTEGER (A-Z)
REAL XTEM
LOGICAL BOUTF,ACTINF
COMMON /OUTB/BOUTF,ACTINF
COMMON /DATES/ BEGTAD, ENDTAD
COMMON /ENTRY/WORD(40),NID,NENTRY,NNACT,NFLCK,NCRASH,UPTIME,
1 EMPTY, MINSIZ
COMMON /FACT/LOG(1001),ASCI(15),PAYDT(8)
COMMON /BDATA/BIT0,BIT1,BIT2,BIT12,BIT17,L7,R7
COMMON /ACTDEF/ ACNTSZ, ACTACT, ACTSP, ACTPTR, ACTCPU, ACTCON,
1 ACTFIL, ACTLPT, ACTCDR
DIMENSION ETYPES(5), MINLEN(5)
DIMENSION HIST(40,20), TEXT(10)
DATA ETYPES / "401000000000, "402000000000, "501000000000,
1 "502000000000, "601000000000 /
DATA MINLEN / 8, 8, 5, 5, 5 /
DATA DEBUG /.FALSE./
DATA NTYPES / 4 /
DATA JBMSK, DETFLG/"777000000, "001000000000 /
DATA T1,N1,M1,T2,N2,M2/5,3,9,5,3,5/
C CONSTM(A,B) - COMPUTES THE CONSOLE TIME IN MSEC BETWEEN DATE A
C AND DATE B ; A & B ARE IN SYSTEM FORMAT
CONSTM(A,B)=(((B.AND.L7)-(A.AND.L7))/BIT17*86400+
1 (B.AND.R7)-(A.AND.R7))*1000
IF (N) 830,10,610
10 TYPE 20
20 FORMAT ('+EAD FACT FILE: '$)
ASSIGN 120 TO EOF
CALL OPENFZ(1)
IF(ACTINF) GO TO 30
IF ( .NOT. DEBUG ) GO TO 40
CALL SOUTCR(' INT. DATE LOCAL TIME COMMENT')
GO TO 40
30 CALL SOUTZ(' USER DIR ACCOUNT DATE ')
CALL SOUTCR('CPU CONSOLE')
40 WORDNO=-1
50 IF ( LASTDT .LT. WORD(3) ) LASTDT=WORD(3)
60 CALL RWORD(WORD(1),EOF)
WORDNO=WORDNO+1
SIZE=WORD(1).AND."77
IF(SIZE.NE.0) GO TO 70
SIZE=1
GO TO 180
70 CODE=WORD(1).AND."777000000000
DO 71 AETYPE = 1, NTYPES
71 IF ( CODE .EQ. ETYPES(AETYPE) ) GO TO 130
IF (CODE .EQ. "601000000000) GO TO 75
COD=WORD(1).AND."777000000077
IF(COD.NE."141000000005.AND.COD.NE."142000000003.AND. COD.NE."143
1000000003.AND.COD.NE."201000000005.AND. COD.NE."740000000001.AND.
2COD.NE."741000000003.AND. COD.NE."540000000001) GO TO 180
IF (SIZE.EQ.1) GO TO 90
75 DO 80 I=2,SIZE
CALL RWORD(WORD(I),EOF)
80 WORDNO=WORDNO+1
WORD(2)=WORD(2) .AND. R7
90 IF(WORD(3).EQ.-1) WORD(3)=LASTDT
ENCODE(15,100,ASCI) WORD(3)
100 FORMAT(2X,O12,1X)
ASCI(4)=0
DATE=WORD(3)
IF ( DATE .LT. BEGTAD ) BEGTAD=DATE
IF ( DATE .GT. ENDTAD ) ENDTAD=DATE
IF(UPTIME.GE.0.OR.SIZE.LT.3) GO TO 110
OLDATE=WORD(3)
UPTIME=0
110 IF (CODE.EQ."143000000000) GO TO 2000
IF (CODE.EQ."142000000000) GO TO 2500
IF (CODE.EQ."501000000000) GO TO 220
IF (CODE.EQ."401000000000) GO TO 1000
IF (CODE.EQ."402000000000) GO TO 1500
IF (CODE.EQ."141000000000) GO TO 330
IF (CODE.EQ."502000000000) GO TO 390
IF (CODE.EQ."201000000000) GO TO 440
IF (CODE.EQ."601000000000) GO TO 50
IF (CODE.EQ."540000000000) GO TO 50
IF (CODE.EQ."740000000000) GO TO 520
IF (CODE.EQ."741000000000) GO TO 550
GO TO 50
120 CALL SOUTCR('END OF FILE')
DO 121 II = 1,20
121 ASCI(II) = 0
CALL GETPER(BEGTAD,ENDTAD,PAYDT)
RETURN
C CHECK 501,502 AND 601 ENTRIES
130 MINSIZ = MINLEN(AETYPE)
IF( SIZE .LT. MINSIZ ) GO TO 180
IF( SIZE .GT. MINSIZ+8 ) GO TO 180
DO 140 I=2,MINSIZ
CALL RWORD(WORD(I),EOF)
140 WORDNO=WORDNO+1
WORD(2)=WORD(2) .AND. R7
IF(WORD(MINSIZ).LT.0) GO TO 150
IF(SIZE.EQ.MINSIZ) GO TO 90
GO TO 170
150 TEMP = - WORD(MINSIZ)
TSIZE = TEMP/5
IF ( MOD(TEMP,5) .NE. 0 ) TSIZE=TSIZE+1
TSIZE = TSIZE + MINSIZ
IF ( TSIZE .NE. SIZE ) GO TO 170
DO 160 I=1,SIZE-MINSIZ
CALL RWORD(WORD(I+MINSIZ),EOF)
TEXT(I) = WORD(I+MINSIZ)
TEXT(I+1)=0
160 WORDNO=WORDNO+1
CALL TSTNUM(TEXT,NACCT)
IF (NACCT .NE. -1 ) WORD(MINSIZ)=NACCT
GO TO 90
170 NERR=5
GO TO 190
C FACT FILE ERROR
180 NERR=1
190 WORDNO=WORDNO-NERR
DO 210 I=1,NERR
IF ( .NOT. DEBUG ) GO TO 60
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTZ('FACT FILE ERROR')
WORDNO=WORDNO+1
ENCODE(20,200,WORD(6)) WORDNO,WORD(I)
200 FORMAT(2X,O5,O13)
WORD(10)=0
210 CALL SOUTCR(WORD(6))
GO TO 60
C LOGIN
220 JOBN=WORD(1).AND.JBMSK
ILG=1
230 IF (LOG(ILG).EQ.-2) GO TO 240
IF ((LOG(ILG).AND.JBMSK).EQ.JOBN) GO TO 280
ILG=ILG+5
GO TO 230
C CORRECT LOGIN
240 DO 250 JLG=1,ILG,5
IF (LOG(JLG).EQ.-1) GO TO 270
250 CONTINUE
LOG(ILG+5)=-2
260 JLG=ILG
270 LOG(JLG)=JOBN.OR.WORD(2)
CALL ACCT(0,WORD(2),NACCT,0,0,0,0,0)
LOG(JLG+1)=NACCT
LOG(JLG+2)=WORD(3)
LOG(JLG+3)=-1
GO TO 50
C ALREADY LOGGED IN
280 USER=LOG(ILG).AND.R7
IF (.NOT. DEBUG ) GO TO 300
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
IF (USER.NE.WORD(2)) GO TO 290
CALL SOUTCR('ALREADY LOGGED IN')
GO TO 300
290 CALL SOUTCR('ALREADY LOGGED IN UNDER DIFFERENT ID')
300 IF (LOG(ILG+3).NE.-1) GO TO 310
CPUT=0
CONST=0
GO TO 320
310 CPUT=LOG(ILG+4)
CONST=CONSTM(LOG(ILG+2),LOG(ILG+3))
320 ASSIGN 260 TO ACOUNT
GO TO 640
C LOGOUT
330 JOBN=WORD(1).AND.JBMSK
ILG=1
340 IF (LOG(ILG).EQ.-2) GO TO 380
IF ((LOG(ILG).AND.JBMSK).EQ.JOBN) GO TO 350
ILG=ILG+5
GO TO 340
350 USER=LOG(ILG).AND.R7
IF (USER.EQ.WORD(2)) GO TO 360
IF (.NOT. DEBUG ) GO TO 360
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('LOGOUT ID CODE DIFFERENT FROM LOGIN')
360 CPUT=WORD(4)
CONST=WORD(5)
ASSIGN 370 TO ACOUNT
GO TO 640
370 LOG(ILG)=-1
IF (LOG(ILG+5).EQ.-2) LOG(ILG)=-2
GO TO 740
380 IF (.NOT. DEBUG ) GO TO 740
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('LOGOUT WITHOUT LOGIN')
GO TO 740
C ACCOUNT NUMBER CHANGE
390 JOBN=WORD(1).AND.JBMSK
ILG=1
400 IF (LOG(ILG).EQ.-2) GO TO 430
IF ((LOG(ILG).AND.JBMSK).EQ.JOBN) GO TO 410
ILG=ILG+5
GO TO 400
410 USER=LOG(ILG).AND.R7
IF (USER.EQ.WORD(2)) GO TO 420
IF (.NOT. DEBUG ) GO TO 420
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('ACCT NO. CHANGE WITH DIFFERENT ID CODE')
420 CONST=CONSTM(LOG(ILG+2),WORD(3))
CPUT=WORD(4)
ASSIGN 260 TO ACOUNT
GO TO 640
430 IF (.NOT. DEBUG ) GO TO 240
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('ACCT NO. CHANGE WITHOUT LOGIN')
GO TO 240
C CHKPNT
440 JOBN=WORD(1).AND.JBMSK
IF (JOBN.NE.0) GO TO 450
IF (.NOT. DEBUG ) GO TO 450
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('START CHECKPOINT')
450 ILG=1
460 IF (LOG(ILG).EQ.-2) GO TO 490
IF ((LOG(ILG).AND.JBMSK).EQ.JOBN) GO TO 470
ILG=ILG+5
GO TO 460
470 IF ( LOG(ILG+2) .GE. WORD(3) ) GO TO 50
IF ((LOG(ILG).AND.R7).EQ.WORD(2)) GO TO 480
IF (.NOT. DEBUG ) GO TO 480
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('CHKPNT WITH DIFFERENT ID CODE')
480 IF ( (LOG(ILG) .AND. DETFLG) .NE. 1 ) LOG(ILG+3)=WORD(3)
LOG(ILG+4)=WORD(4)
GO TO 50
490 IF (.NOT. DEBUG ) GO TO 50
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('CHKPNT FOR JOB NOT LOGGED IN')
GO TO 50
C START OF DISC UTILIZATION STATISTICS
500 IF (.NOT. DEBUG ) GO TO 505
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('START DISC UTILIZATION STATISTICS')
505 NFLCK=NFLCK+1
GO TO 50
C DISK UTILIZATION
510 CALL ACCT(0,WORD(2),NACCT,0,0,0,0,0)
CALL ACCT(1,WORD(2),NACCT,0,0,WORD(4),0,0)
GO TO 50
C SYSTEM RESTARTED FROM SCRATCH
520 IF (.NOT. DEBUG ) GO TO 525
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('SYSTEM RESTARTED')
525 NCRASH=NCRASH+1
ILG=-4
530 ILG=ILG+5
IF (LOG(ILG).EQ.-2) GO TO 540
IF (LOG(ILG).EQ.-1) GO TO 530
CONST = 0
IF ( (LOG(ILG) .AND. DETFLG) .NE. 1 ) GO TO 535
IF ( LOG(ILG+3) .EQ. -1 ) GO TO 538
CONST=CONSTM( LOG(ILG+2), LOG(ILG+3) )
GO TO 538
535 CONST=CONSTM(LOG(ILG+2),LASTDT)
538 CPUT=0
IF (LOG(ILG+3).NE.-1) CPUT=LOG(ILG+4)
USER=LOG(ILG).AND.R7
ASSIGN 530 TO ACOUNT
GO TO 640
540 LOG(1)=-2
UPTIME=UPTIME+CONSTM(OLDATE,LASTDT)/1000
OLDATE=LASTDT
GO TO 50
C TIME SET
550 IF (.NOT. DEBUG ) GO TO 555
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('TIME RESET')
555 IF(LOG(1).EQ.-2) GO TO 600
DAY=(WORD(3).AND.L7)-(LASTDT.AND.L7)
SEC=(WORD(3).AND.R7)-(LASTDT.AND.R7)
ILG=-4
560 ILG=ILG+5
IF (LOG(ILG).EQ.-2) GO TO 600
IF (LOG(ILG).EQ.-1) GO TO 560
I=2
570 NSEC=(LOG(ILG+I).AND.R7)+SEC
NDAY=DAY
IF(NSEC.LT.0) GO TO 580
IF(NSEC.LT.86400) GO TO 590
NSEC=NSEC-86400
NDAY=DAY+BIT17
GO TO 590
580 NSEC=NSEC+86400
NDAY=DAY-BIT17
590 LOG(ILG+I)=(LOG(ILG+I).AND.L7)+NDAY+NSEC
IF(I.EQ.3) GO TO 560
IF(LOG(ILG+3).EQ.-1) GO TO 560
I=3
GO TO 570
600 UPTIME=UPTIME+CONSTM(OLDATE,LASTDT)/1000
OLDATE=DATE
GO TO 50
C PERFORM ACCOUNTING FOR JOBS NOT LOGGED OUT
610 ILG=-4
620 ILG=ILG+5
IF(LOG(ILG).EQ.-2) GO TO 630
IF(LOG(ILG).EQ.-1.OR.LOG(ILG+3).EQ.-1) GO TO 620
CONST=CONSTM(LOG(ILG+2),LOG(ILG+3))
USER=LOG(ILG).AND.R7
CPUT=LOG(ILG+4)
DATE=LOG(ILG+3)
ENCODE (15,100,ASCI) DATE
ASCI(4)=0
ASSIGN 620 TO ACOUNT
GO TO 640
630 LOG(1)=-2
UPTIME=UPTIME+CONSTM(OLDATE,DATE)/1000
OLDATE=DATE
RETURN
C (ACOUNT) - PERFORM ACCOUNTING AND CHECK FOR NEGATIVE CONST
640 IF(CONST.GE.0) GO TO 650
CONST=0
IF (.NOT. DEBUG ) GO TO 650
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('NEGATIVE CONSOLE TIME')
650 IF(CPUT.GE.0) GO TO 660
CPUT=0
IF (.NOT. DEBUG ) GO TO 660
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('NEGATIVE CPU TIME')
660 CALL ACCT(1,USER,LOG(ILG+1),CPUT,CONST,0,0,0)
C OUTPUT ACCOUNTING INFORMATION
IF(.NOT.ACTINF) GO TO 730
CALL DIRSTZ(USER,ASCI(5),NCHAR)
ASCI(7)=0
CALL SOUTZ(ASCI(5))
NCHAR=10-NCHAR
IF(NCHAR.LE.0) GO TO 680
DO 670 I=1,NCHAR
670 CALL SOUTZ(BIT1)
680 IACCT=LOG(ILG+1)
IF(IACCT.LT.0) IACCT=-(IACCT.XOR.BIT0)
ENCODE(30,690,ASCI(5)) USER,IACCT,DATE
690 FORMAT(1X,O5,I9,3X,O12)
ASCI(11)=0
CALL SOUTZ(ASCI(5))
TIME=IFIXR(CPUT/1000.)
IND=0
700 MIN=TIME/60
SEC=TIME-MIN*60
HOUR=MIN/60
MIN=MIN-HOUR*60
ENCODE(10,710,ASCI(5)) HOUR,MIN,SEC
710 FORMAT(I4,':'I2,':'I2)
ASCI(7)=0
CALL SOUTZ(ASCI(5))
IF(IND.EQ.1) GO TO 720
TIME=IFIXR(CONST/1000.)
IND=1
GO TO 700
720 CALL SOUTCR(0)
730 GO TO ACOUNT
C HISTOGRAM ENTRY
740 T=T1*1000
NN=N1
M=M1
TIME=WORD(4)
IND=1
GO TO 760
750 TEMP=DIM
IND=2
T=T2*60000
NN=N2
M=M2
TIME=WORD(5)
760 TAU=T
TTL=0
DO 770 I=1,M
TTL=TTL+NN*TAU
IF(TIME.LE.TTL) GO TO 780
770 TAU=TAU*2
DIM=M*NN+1
GO TO 810
780 TTL=TTL-NN*TAU
DO 790 J=1,NN
TTL=TTL+TAU
IF(TIME.LE.TTL) GO TO 800
790 CONTINUE
800 DIM=(I-1)*NN+J
810 IF(IND.EQ.1) GO TO 750
HIST(TEMP,DIM)=HIST(TEMP,DIM)+1
C OUTPUT LOGOUT DATA
IF(.NOT.BOUTF) GO TO 50
DO 820 I=2,5
820 CALL WWORD(WORD(I))
GO TO 50
C OUTPUT HISTOGRAM
830 MAX1=N1*M1+1
MAX2=N2*M2+1
IF (N.EQ.-2) GO TO 870
ENCODE(25,840,ASCI) T1,N1,M1,T2,N2,M2,MAX1,MAX2
840 FORMAT(8(I2,1H,),1X)
ASCI(6)=0
CALL SOUTZ(ASCI)
ASCI(2)=0
DO 860 I=1,MAX1
DO 860 J=1,MAX2
ENCODE(5,850,ASCI) HIST(I,J)
850 FORMAT(I4,1H,)
860 CALL SOUTZ(ASCI)
RETURN
C ZERO HIST(I,J)
870 DO 880 I=1,MAX1
DO 880 J=1,MAX2
880 HIST(I,J)=0
RETURN
C LPT ENTRIES
1000 CALL ACCT(0,WORD(2),NACCT,0,0,0,0,0)
CALL ACCT(1,WORD(2),NACCT,WORD(4),0,0,WORD(6),0)
GO TO 50
C CDR ENTRIES
1500 CALL ACCT(0,WORD(2),NACCT,0,0,0,0,0)
CALL ACCT(1,WORD(2),NACCT,WORD(4),0,0,0,WORD(6))
GO TO 50
C DETACH ENTRIES
2000 JOBN = WORD(1) .AND. JBMSK
ILG=-4
2100 ILG=ILG+5
IF ( LOG(ILG) .EQ. -2 ) GO TO 2400
IF ((LOG(ILG).AND.JBMSK) .EQ. JOBN) GO TO 2200
GO TO 2100
2200 IF ( (LOG(ILG).AND.R7) .EQ. (WORD(2).AND.R7) ) GO TO 2300
IF ( .NOT. DEBUG ) GO TO 2300
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('DETACH WITH DIFFERENT ID CODE')
2300 LOG(ILG) = LOG(ILG) .OR. DETFLG
GO TO 50
2400 IF ( .NOT. DEBUG ) GO TO 50
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('DETACH FOR JOB NOT LOGGED IN')
GO TO 50
C ATTACH ENTRIES
2500 JOBN = WORD(1) .AND. JBMSK
ILG=-4
2600 ILG=ILG+5
IF ( LOG(ILG) .EQ. -2 ) GO TO 2900
IF ((LOG(ILG).AND.JBMSK) .EQ. JOBN) GO TO 2800
GO TO 2600
2700 IF ( (LOG(ILG).AND.R7) .EQ. (WORD(2).AND.R7) ) GO TO 2800
IF ( .NOT. DEBUG ) GO TO 2800
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('ATTACH WITH DIFFERENT ID CODE')
2800 LOG(ILG) = LOG(ILG) .AND. ( .NOT. DETFLG )
GO TO 50
2900 IF ( .NOT. DEBUG ) GO TO 50
CALL SOUTZ(ASCI)
CALL ODTIM2(DATE)
CALL SOUTCR('ATTACH FOR JOB NOT LOGGED IN')
GO TO 50
END
C ACCT - A SUBROUTINE THAT PERFORMS THE ACCOUNTING FOR EACH JOB
SUBROUTINE ACCT(N,USER,NACCT,CPUT,CONST,NPAGE,LINES,CARDS)
C N=-2 CHECK IF ACCOUNT IS IN ACCOUNT TABLES
C N=-1 CHECK IF ACCT-USER ENTRY IS IN TABLE
C AND IF NOT RETURN NACCT=NBIT2
C N=0 GET ACCOUNT NUMBER, INSERT POSSIBLE ENTRY
C N=1 PERFORM ACCOUNTING
C USER - USER ID CODE
C NACCT - ACCOUNT NUMBER
C CPUT - CPU TIME IN MSEC
C CONST - CONSOLE TIME IN MSEC
C NPAGE - NUMBER OF FILE BLOCKS IN PAGES
C LINES - NUMBER OF LINES PRINTED
C CARDS - NUMBER OF CARDS READ
IMPLICIT INTEGER (A-Z)
COMMON /ACCOUN/ID(1001),ACNT(10001),ACTNM(501),ACTAL(3000)
COMMON /ENTRY