Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50363/ungarb.for
There are no other files named ungarb.for in the archive.
IMPLICIT INTEGER (A-Z)
REAL SUT,RET,FET,EKPSD,KILTIM,TOTIME,USRLSR(500)
DIMENSION NAME(2),ANAME(3),DTCT(24),REASON(16),USRLST(500,6)
DIMENSION SYSNAM(5)
DATA REASON/'CS','OT','OE','OC','VI','DX','CX','^C',
16*' ','SG','RG'/
DATA USRMAX/500/
DO 50 I=1,5
SYSNAM(I)=' '
50 CALL GETTAB(SYSNAM(I),(I-1)*"1000000+9)
OPEN(UNIT=5,DEVICE='NUL',FILE='PIRETS',ACCESS='SEQIN',
1MODE='IMAGE')
NGAM=0
TOTIME=0.0
TOTEMY=0
USRCNT=0
DO 100 I=1,USRMAX
100 USRLST(I,1)=0
C
C BEGIN NEXT PAGE OF THE GAMES LISTING
DO 120 PAGE=1,999
1 FORMAT('1',5A5,25X,'PIRETS SCORE LISTING',25X,'PAGE',I3/
1/5X,'CREATION',9X,'TERMINATION',10X,
2'PPN',11X,'NAME I-K&R R-K&R T-K&R GS RS I-TIM R-TIM T-TIM',
3' PRTG TNRTG EK/SD VERSN RC'/2(1X,17('-')),1X,15('-'),1X,
412('-'),3(' -----'),2(' --'),3(' -----'),' ----',3(' -----'),
5' --'/)
DO 120 L=1,53
C
C READ AND UNGARBAGE A GAME SCORE RECORD
READ(5,END=77776)DATIC,DATIT,PPN,NAME,JUNK,TIMLIM,JUNK2
IF(L.EQ.1) PRINT 1,(SYSNAM(I),I=1,5),PAGE
CALL UGDT(DATIC,DTCT)
CALL UGDT(DATIT,DTCT(13))
DO 103 CC=1,23,2
T1=DTCT(CC)
T2=T1/10
DTCT(CC)=T2
103 DTCT(CC+1)=T1-T2*10
PP1=GFIELD(PPN,18,18)
PP2=GFIELD(PPN,18,0)
N1=0
A1=0
N2=0
A2=0
DO 108 CC=1,12
N1=N1-6
IF (N1.GE.0) GOTO 106
N1=30
N2=N2+1
106 A1=A1-7
IF (A1.GE.0) GOTO 107
A1=29
A2=A2+1
107 T=GFIELD(NAME(N2),6,N1)+32
108 CALL SFIELD(ANAME(A2),7,A1,T)
IK=GFIELD(JUNK2,7,29)
IR=GFIELD(JUNK2,7,22)
RK=GFIELD(JUNK,7,29)
RR=GFIELD(JUNK,7,22)
FK=GFIELD(JUNK,7,15)
FR=GFIELD(JUNK,7,8)
GS=GFIELD(JUNK,4,4)
R=REASON(GFIELD(JUNK,4,0)+1)
SUT=GFIELD(TIMLIM,12,24)/100.0
RET=GFIELD(TIMLIM,12,12)/100.0
FET=GFIELD(TIMLIM,12,0)/100.0
RC=GFIELD(JUNK2,7,15)
VER=GFIELD(JUNK2,5,10)
EDITNO=GFIELD(JUNK2,10,0)
INEMY=IK+IR
REEMY=RK+RR
FNEMY=FK+FR
KILLED=REEMY-FNEMY
KILTIM=RET-FET
IF(KILTIM.EQ.0.0)KILTIM=5.0E-3
PRTG=(INEMY-FNEMY)*1000/INEMY+0.5
TNRTG=KILLED*1000*RET/(KILTIM*REEMY)+0.5
EKPSD=KILLED/KILTIM
NGAM=NGAM+1
TOTEMY=TOTEMY+REEMY-FNEMY
TOTIME=TOTIME+RET-FET
110 PRINT 2,DTCT,PP1,PP2,ANAME,IK,IR,RK,RR,FK,FR,GS,R,SUT,RET,
1FET,PRTG,TNRTG,EKPSD,VER,EDITNO,RC
2 FORMAT(2(I2,I1,2('/',2I1),I2,I1,2(':',2I1)),' [',O6,',',O6,'] ',
12A5,A2,7I3,1X,A2,3F6.2,I5,I6,F6.1,I2,'-',O3,I3)
C
C LOOKUP AND RECORD THIS GAME IN THE USER LIST
IL=1
IH=USRCNT+1
200 IB=(IL+IH)/2
IF(IH.LE.IL) GOTO 230
IF(PPN-USRLST(IB,1)) 210,270,220
210 IH=IB
GOTO 200
220 IL=IB+1
GOTO 200
230 IF(PPN.EQ.USRLST(IB,1)) GOTO 270
IF(USRCNT.GE.USRMAX)GOTO 77775
USRCNT=USRCNT+1
IF(IB.EQ.USRCNT)GOTO 255
DO 250 IH=USRCNT,IB+1,-1
DO 240 IL=1,6
240 USRLST(IH,IL)=USRLST(IH-1,IL)
250 USRLSR(IH)=USRLSR(IH-1)
255 USRLST(IB,1)=PPN
DO 260 I=1,3
260 USRLST(IB,I+1)=ANAME(I)
USRLST(IB,5)=0
USRLST(IB,6)=0
USRLSR(IB)=0.0
270 USRLST(IB,5)=USRLST(IB,5)+1
USRLST(IB,6)=USRLST(IB,6)+KILLED
USRLSR(IB)=USRLSR(IB)+KILTIM
120 CONTINUE
77775 TYPE 4
4 FORMAT(' %USER LIST OVERFLOW -- INCREASE USRMAX')
GOTO 120
C
C PRINT THE USER LIST AND OVERALL TOTALS
77776 IB=0
DO 350 PAGE=PAGE+1,99
6 FORMAT('1',5A5,25X,'PIRETS SCORE LISTING',25X,
1'PAGE',I3//14X,'PPN',11X,'NAME',5X,
2'#GAMES KILLED STARDATES EK/SD'/9X,13('-'),2X,12('-'),
33(1X,'------'),'--- -------'/)
DO 350 L=1,53
IF(IB.GE.USRCNT) GOTO 77777
IF(L.EQ.1) PRINT 6,(SYSNAM(I),I=1,5),PAGE
IB=IB+1
EKPSD=USRLST(IB,6)/USRLSR(IB)
PPN=USRLST(IB,1)
PP1=GFIELD(PPN,18,18)
PP2=GFIELD(PPN,18,0)
PRINT 7,IB,PP1,PP2,(USRLST(IB,IL),IL=2,6),USRLSR(IB),EKPSD
7 FORMAT(I4,5X,O6,',',O6,2X,2A5,A2,I5,I8,F9.2,F8.1)
350 CONTINUE
77777 PRINT 5,NGAM,TOTEMY,TOTIME
5 FORMAT(//'/TOTAL GAMES =',I5/' TOTAL ENEMIES KILLED =',I6/
1' TOTAL STARDATES USED =',F9.2)
STOP
END
SUBROUTINE UGDT(DAYTIM,DATIA)
IMPLICIT INTEGER (A-Z)
DIMENSION DATIA(12)
T1=GFIELD(DAYTIM,16,20)
T2=T1/31
DATIA(3)=T1-T2*31+1
T1=T2/12
DATIA(1)=T2-T1*12+1
DATIA(5)=T1+64
T1=GFIELD(DAYTIM,20,0)/10
T2=T1/60
DATIA(11)=T1-T2*60
DATIA(7)=T2/60
DATIA(9)=T2-DATIA(7)*60
RETURN
END
BLOCK DATA MACSUB
COMMON /GFIELD/GFIELD(7)
COMMON /SFIELD/SFIELD(8)
COMMON /GETTAB/GETTAB(5)
C FUNCTION GFIELD(LOCATION,SIZE,SHIFT)
DATA GFIELD/"200076000002,"242040000006,"434076000001,
1 "242040000030,"541076000000,"135000000001,
2 "263740000000/
C MOVE 1,@2(16)
C LSH 1,6
C OR 1,@1(16)
C LSH 1,^D24
C HRRI 1,@0(16)
C LDB 0,1
C POPJ 17,
C SUBROUTINE SFIELD(LOCATION,SIZE,SHIFT,VALUE)
DATA SFIELD/"200076000002,"242040000006,"434076000001,
1 "242040000030,"541076000000,"200036000003,
2 "137000000001,"263740000000/
C MOVE 1,@2(16)
C LSH 1,6
C OR 1,@1(16)
C LSH 1,^D24
C HRRI 1,@0(16)
C MOVE 0,@3(16)
C DPB 0,1
C POPJ 17,
C SUBROUTINE GETTAB(VALUE,CODE)
DATA GETTAB/"200036000001,"047000000041,"604000000000,
1 "202036000000,"263740000000/
C MOVE 0,@1(16)
C GETTAB 0,
C TRNA
C MOVEM 0,@0(16)
C POPJ 17,
END