Google
 

Trailing-Edge - PDP-10 Archives - BB-F494Z-DD_1986 - 10,7/netdat.for
There are 4 other files named netdat.for in the archive. Click here to see a list.
	IMPLICIT INTEGER (A-Z) 
	REAL RANGES, CUMSUM
	REAL TIMER, SUMTIM, SUMSQT, MEAN, VAR, STDV, SQRT
	COMMON WRDCNT, LASTWR
	COMMON /R/ RANGES(55), CUMSUM
	COMMON /M/ MCNT, MHIST(100), MRUN, MGOOD, MBAD
	INTEGER HISTO(55)
	INTEGER MONTHS(12),TIMFV(6),TIMLV(6)
	DATA RANGES/ 0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0,
	1 1.5,2.0,2.5,3.0,3.5,4.0,4.5,5.0,5.5,6.0,6.5,7.0,7.5,8.0,
	2 8.5,9.0,9.5,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,
	3 19.0,20.0,25.0,30.0,35.0,40.0,45.0,50.0,55.0,60.0,65.0,70.0,
	4 75.0,80.0,85.0,90.0,95.0,100.0/
	DATA MONTHS/3hJan,3HFeb,3hMar,3hApr,3hMay,3hJun,3hJul,3hAug,
	1           3hSep,3hOct,3HNov,3hDec/
	DATA STAR  /1H*/
C
C
C
C	Program to read NETRSP.DAT, and interpret the results.
C
C	This program computes the following:
C
C		The MEAN response for the interval.
C		The VARIANCE of response for the interval
C		The standard deviation of response for the interval
C		A histogram of responses, as follows:
C			by tenths of seconds, up to 1 second
C			by half seconds, up to 10 seconds
C			by full seconds, up to 20
C			by five second intervals, up to 100
C	A total of 55 intervals
C
	MAPSW = 1
	OPEN(UNIT=1,DEVICE='DSK',ACCESS='SEQIN',MODE='IMAGE',
	1    FILE='NETRSP')
12	WORD = RDONEW(EOFFLG)
	IF (EOFFLG.EQ.0) GO TO 15
	TYPE 16
16	FORMAT(' NETRSP.DAT contains no data')
	GO TO 50
C	
15	IF(WORD.EQ.0) GO TO 12
	IF(WORD.EQ.1) GO TO 20
C
C Bad first word
C
	TYPE 1
1	FORMAT('?First word of file is not a text record')
	STOP

20	CALL NEWREC
C
C Process one experiment
C
	CNT = 0
	TIMFIR = 0
	SUMTIM = 0
	SUMSQT = 0
	DO 21 I = 1, 55
		HISTO(I) = 0
21	CONTINUE
	MCNT = 0
	MRUN = 0
	MGOOD = 0
	MBAD = 0
	DO 22 I = 1, 100
		MHIST(I) = 0
22	CONTINUE
C
C	
25	WORD = RDONEW(EOFFLG)
	IF(EOFFLG.NE.0) GO TO 40
	IF (WORD.EQ.2) GO TO 30
	IF (WORD.EQ.1.OR.WORD.EQ.0) GO TO 40
	TYPE 2, WRDCNT
2	FORMAT('?Illegal record type at word ',I8)
	GOTO 40

30	TIMEST = RDONEW(EOFFLG)
	IF(TIMFIR.EQ.0)TIMFIR = TIMEST
	TIMER = FLOAT(RDONEW(EOFFLG)) / 1000.0
	CNT = CNT + 1
	SUMTIM = SUMTIM + TIMER
	SUMSQT = SUMSQT + (TIMER * TIMER)
	IF (MAPSW.NE.0) CALL MAPRSP(IFIX(TIMER * 1000.0))
	CALL HSTCNT(TIMER, HISTO)
	GO TO 25

C
C  Print out the results of this experiment
C
40	IF (CNT.GT.1) GO TO 45
	PRINT 43
43	FORMAT(' Less than 2 datapoints, statistics are meaningless')
	GO TO 48

45	MEAN = SUMTIM / FLOAT(CNT)
	VAR = (SUMSQT - FLOAT(CNT) * (MEAN * MEAN)) / FLOAT(CNT)
	STDV = SQRT((FLOAT(CNT) * VAR) / (FLOAT(CNT) - 1))
	CALL UDT2DT(TIMFIR,TIMFV)
	CALL UDT2DT(TIMEST,TIMLV)
	T = TIMFV(2)
	TIMFV(2) = MONTHS(TIMFV(1))
	TIMFV(1) = T
	T = TIMLV(2)
	TIMLV(2) = MONTHS(TIMLV(1))
	TIMLV(1) = T
	PRINT 8, TIMFV, TIMLV
8	FORMAT(1X,'Test ran from ',I2,'-',A3,'-',I2,2X,I2,':',I2
	1      ,':'I2,' through ',I2,'-',A3,'-',I2,2X,I2,':',I2
	2      ,':'I2)

	PRINT 4, CNT
4	FORMAT(/I8,'  Observations.')
	PRINT 5, MEAN
5	FORMAT(F8.3, '  Mean response time.')
	PRINT 6, VAR
6	FORMAT(F8.3, '  Variance.')
	PRINT 7, STDV
7	FORMAT(F8.3, '  Standard deviation.',//)
	CALL PRNHST(HISTO,CNT)
	IF (MAPSW.NE.0) CALL PMHIST
48	CALL FNNXTR
	IF (EOFFLG .EQ. 0) GO TO 20

50	CONTINUE
	END
	SUBROUTINE MAPRSP(TIM)
	IMPLICIT INTEGER (A-Z)
	LOGICAL TYPMAP	
	COMMON /M/ MCNT, MHIST(100), MRUN, MGOOD, MBAD
	DATA STAR /1H*/
C
C  Count the number of consecutive good responses
C
	TYPMAP = .FALSE.
	IF (TIM .LE. 200) GO TO 20
	MBAD = MBAD + 1
	IF (CNT.NE.0) MRUN = MRUN + 1
	IF (CNT.GT.100) CNT = 100
	MHIST(CNT) = MHIST(CNT) + 1
	CNT = 0
	GO TO 30
C
20	IF (CNT.EQ.0) MRUN = MRUN + 1
	CNT = CNT + 1
	MGOOD = MGOOD + 1
30	IF (.NOT.TYPMAP) RETURN
	REP = (TIM + 25) / 50
	IF (REP.NE.0) GO TO 10
	TYPE 1
	RETURN

10	TYPE 1, (STAR, I = 1, REP)
	RETURN 

1	FORMAT(1X,100A1)
	END
	SUBROUTINE PMHIST
	IMPLICIT INTEGER (A-Z)
	REAL SQRT, Z, ZN, ZD, ZDN, ZDD, GOOD, BAD, COUNT
	COMMON /M/ MCNT, MHIST(100), MRUN, MGOOD, MBAD
	DATA STAR /1H*/

	PRINT 1
1	FORMAT('1Histogram of runs of good responses'//)

	HIGH = 0
	DO 10 I = 1, 100
		IF (MHIST(I) .NE. 0) HIGH = I
10	CONTINUE

	IF (HIGH .EQ. 0) RETURN
	DO 20 I = 1, HIGH
		REP = MHIST(I)
		IF (REP.GT.100) REP = 100
		IF (REP.NE.0) PRINT 2, I, MHIST(I), (STAR, K = 1, REP)
		IF (REP.EQ.0) PRINT 2, I, REP
20	CONTINUE
C
C  Compute the Run statistic
C
	COUNT = MGOOD + MBAD
	GOOD = MGOOD
	BAD = MBAD
	ZN = FLOAT(MRUN) - (2.0 * GOOD * BAD) / COUNT - 1.0
	ZDN = 2.0 * GOOD * BAD * (2.0 * GOOD * BAD - COUNT)
	ZDD = COUNT ** 2 * (COUNT - 1.0)
	ZD = SQRT(ZDN/ZDD)
	Z = ZN / ZD
	PRINT 3, MGOOD, MBAD, MRUN, Z
3	FORMAT(//,1X,'Number good',I5,', number bad',I5,', runs ',I5,
	1', run statistic is ',F10.7)

	RETURN

2	FORMAT(1X, I4, I6, 3X, 100A1)
	END

	SUBROUTINE FNNXTR
	IMPLICIT INTEGER (A-Z)
	COMMON WRDCNT, LASTWR
C
C  Routine to find the next record.  Looks for a type 1 record, flushes
C  other junk.  Stops at end of file.

10	IF (LASTWR.EQ.1) RETURN
	X = RDONEW(EOFFLG)
	IF (EOFFLG.EQ.0) GO TO 10
	RETURN
	END

	INTEGER FUNCTION RDONEW(F)
	IMPLICIT INTEGER (A-Z)
	COMMON WRDCNT, LASTWR
C
C   Routine to read one word from the input file
C

	F = 0
	READ (1,END=10), LASTWR
	WRDCNT = WRDCNT + 1
	RDONEW = LASTWR
	RETURN

10	F = 1
	RDONEW = 0
	END
	SUBROUTINE NEWREC
	IMPLICIT INTEGER (A-Z)
	COMMON WRDCNT
	INTEGER X(130)
C
C  Routine to process the header
C

	CNT1 = 0	
C
C  Get count
C

	CNT = RDONEW(EOFFLG)
	IF (CNT .LE. 130) GO TO 10
	CNT1 = CNT - 130		
	CNT = 130

10	IF(EOFFLG .NE. 0) GO TO 99
1	FORMAT(1H1,130A1)
2	FORMAT(1H0)
	DO 12 I = 1, CNT
		X(I) = RDONEW(EOFFLG) + 135274560
		IF (EOFFLG .NE. 0) GO TO 99
12	CONTINUE
	PRINT 1,(X(I), I = 1, CNT)
	PRINT 2
	IF (CNT1 .EQ. 0) GO TO 20
C
C  Skip comment characters beyond 130
C
	DO 15 I = 1 , CNT1
		JUNK = RDONEW(EOFFLG)
		IF (EOFFLG .NE. 0) GOTO 99
15	CONTINUE
	
20	RETURN

99	TYPE 3
3	FORMAT(' ?Premature EOF reading comment')
	STOP
	END
		
	SUBROUTINE HSTCNT(X,H)
	IMPLICIT INTEGER (A-Z)
	REAL X
	INTEGER H(55)
C
C  Routine to bump the histogram counters
C
C
C	1-10		x .ge. 0   and x .lt. 1.0
C	11-28		x .ge. 1.0 and x .lt. 10.0
c	29-38		X .ge. 10  and x .LT. 20
c	39-54		x .ge. 20  and x .lt. 100
c	55		x .ge. 100
C
	IF(X .LT. 1.0)  GO TO 10
	IF(X .LT. 10.0) GO TO 20
	IF(X .LT. 20.0) GO TO 30
	IF(X .LT.100.0) GO TO 40
	I = 55
	GO TO 50

10	I = 1 + IFIX(10*X)
	GO TO 50

20	I = 9 + IFIX(2*X)
	GO TO 50

30	I = 14 + IFIX(X)
	GO TO 50

40	I = 35 + IFIX(X/5.0)

50	H(I) = H(I) + 1
	RETURN
	END
	SUBROUTINE PRNHSL(INDEX,N,CNT)
	IMPLICIT INTEGER (A-Z)
	REAL RANGES,Z,ALOG,CUMSUM
	COMMON /R/ RANGES(55), CUMSUM
	DATA HCHAR /1H*/
C
C  Routine to print a histogram line
C
	Z = FLOAT(N) / FLOAT(CNT)
	CUMSUM = CUMSUM + Z
	IF (Z.EQ.0) GO TO 200
	REP = 48 - 48/ALOG(1/FLOAT(CNT))*ALOG(Z)
	IF (INDEX.EQ.55) GO TO 100
	PRINT 1,RANGES(INDEX), RANGES(INDEX+1), N, CUMSUM,
	1	(HCHAR, I = 1, REP)
1	FORMAT(' X>',F5.1,' and X<',F4.1,I5,F8.4,3X,100A1)
	RETURN

100	PRINT 2,RANGES(INDEX), N, CUMSUM, (HCHAR, I = 1, REP)
2	FORMAT(' X>',F5.1,'       ',5X,  I5,F8.4,3X,100A1)
	RETURN

200	IF(INDEX.EQ.55) GO TO 300
	PRINT 3, RANGES(INDEX), RANGES(INDEX+1), N, CUMSUM
3	FORMAT(' X>',F5.1,' and X<',F4.1,I5,F8.4)
	RETURN

300	PRINT 4, RANGES(INDEX), N, CUMSUM
4	FORMAT(' X>',F5.1,'       ',5X  ,I5,F8.4)
	RETURN
	END
	SUBROUTINE PRNHST(HIST,CNT)
	IMPLICIT INTEGER (A-Z)
	INTEGER HIST(55)
	REAL RANGES, CUMSUM
	COMMON /R/ RANGES(55), CUMSUM
C
C  Routine to print the histogram
C
	CUMSUM = 0.0
C
	HIGH = 0
	DO 5 I = 1, 55
		IF(HIST(I) .NE. 0) HIGH = I
5	CONTINUE
C
	DO 10 I = 1, HIGH
		CALL PRNHSL(I,HIST(I),CNT)
10	CONTINUE
	RETURN
	END
	SUBROUTINE UDT2DT(UDT,DATEV)
	IMPLICIT INTEGER (A-Z)
	INTEGER DATEV(6)
	REAL TIMSEC
C
C  Routine to convert from Universal Date/Time to an array of MON, DAY
C  YEAR, HOURS, MINUTES, SECONDS.
C

	TIMSEC = FLOAT(MOD(UDT,2 ** 18))*86400.0/2**18
	UDT = UDT / 2 ** 18 - 26707
	Y = UDT / 1461
	D = UDT - Y * 1461
	Y = 4 * Y
	IF (D.LE.1) GO TO 2
	L = 1
	D = D - 366
	Y = Y + D / 365 + 1
	D = MOD(D, 365)

2	IF(D.GE.(59+L)) GO TO 3
	IF(D.GE.31) GO TO 21
	M = 1
	D = D + 1
	GO TO 4

21	M = 2
	D = D - 30
	GO TO 4

3	D = D - 59 - L
	M = IFIX(FLOAT(D) / 30.6 + 0.019)
	D = D + 1 - IFIX(FLOAT(M) * 30.6 + 0.5)

	M = M + 3
4	DATEV(1) = M
	DATEV(2) = D
	DATEV(3) = Y + 32
	DATEV(4) = TIMSEC / 3600.0
	TMP =  TIMSEC - FLOAT(DATEV(4))*3600.0
	DATEV(5) = FLOAT(TMP) / 60.0
	DATEV(6) = TMP - FLOAT(DATEV(5)) * 60.0
	RETURN
	END