File: STAT.FT of Tape: Various/ETH/eth11-2

(Source file text) 

---

C                                            
C	STAT.FOR - SAMPLE PROGRAM (STATISTICS - DATA SAMPLING) USING:
C  ABSNT	- DETECTION OF MISSING DATA
C  BOUND	- SELECTION OF OBSERVATIONS WITHIN BOUNDS
C  SUBMX	- BUILDING OF A SUBSET MATRIX
C  TAB2 	- TABULATION OF DATA (2 VARIABLES)
C  TALLY	- TOTALS, MEANS, S. D., MIN, MAX
C  TTSTT	- TEST ON POPULATION MEANS
C  ALSO ... USE GAUSS (FOR DATA GENERATION)
C
	DIMENSION A(20,10),S(20),TOTAL(10),AVE(10),STDEV(10),VMIN(10)
	DIMENSION VMAX(10),BLO(10),BHI(10),UNDER(10),BETW(10),OVER(10)
	DIMENSION NOV(2),UBO(3,2),FREQ(10,10),PERCNT(10,10),B(20,10)
	DIMENSION A1(200),STAT1(3,10),STAT2(3,10),B1(200)
	EQUIVALENCE (STDEV,UNDER,FREQ(1,3)),(VMIN,BETW,FREQ(1,4))
	EQUIVALENCE (TOTAL,FREQ,B,B1),(AVE,FREQ(1,2))
	EQUIVALENCE (VMAX,OVER,FREQ(1,5)),(B(1,6)),(A,A1)
C
	DATA NOV/1,8/,UBO/2.,10.,10.,2.,10.,10./,ISEED/13107/
	DATA BLO/10*0./,BHI/10*12./
C
C  OUTPUT CHANNEL = IOUT
	IOUT=2
C
C  GENERATE ORIGINAL DATA MATRIX
	DO 1 I=1,200
	CALL GAUSS(ISEED,3.,6.,RV)
1	A1(I)=FLOAT(IABS(IFIX(RV)))
C
C  LOOK FOR MISSING DATA
	NO=20
	NV=10
	CALL ABSNT(A,S,NO,NV)
	WRITE(IOUT,100) ((A(I,J),J=1,10),S(I),I=1,20)
100	FORMAT(//' DETECTION OF MISSING DATA BY ABSNT:'/17X'ORIGINAL
	1 MATRIX',29X,'S-VECTOR'//(10F5.0,10X,F5.0))
C
C  ELIMINATE OBSERVATIONS WITH VARIABLES MISSING
	CALL SUBMX(A,B,S,NO,NV,N)
	WRITE(IOUT,101)
101	FORMAT(//' ELIMINATION OF "BAD" OBSERVATIONS BY SUBMX:')
	DO 20 I=1,N
	NI=I-N
20	WRITE(IOUT,1011) (B1(J*N+NI),J=1,10)
1011	FORMAT(10F5.0)
C
C  CHECK RANGE WITHIN 2*SIGMA OF 6
	CALL BOUND(A,S,BLO,BHI,UNDER,BETW,OVER,NO,NV,IER)
	WRITE(IOUT,102) (I,I=1,10),UNDER,BETW,OVER
102	FORMAT(//' CHECK RANGE WITH BOUND;'/' VARIABLE NO.'/
	1 10I5/' LESS THAN 0'/10F5.0/' IN RANGE'/10F5.0/
	2 ' GREATER THAN 12'/10F5.0)
	IF(IER.NE.0) WRITE(IOUT,103) IER
C
C  COMPILE FULL-BLOWN STATISTICS
	CALL TALLY(A,S,TOTAL,AVE,STDEV,VMIN,VMAX,NO,NV,IER)
103	FORMAT(/' AND IER ='I2)
	WRITE(IOUT,104) (I,I=1,10),TOTAL,AVE,STDEV,VMIN,VMAX
104	FORMAT(//' FULL STATISTICS ON ARRAY:'/' VARIABLE NO.'/
	1 10I8/' TOTALS'/10F8.0/' AVERAGES'/10F8.2/' STAND. DEV.'/
	2 10F8.3/' MINIMUM OBSERVATION'/10F8.0
	3/'  MAXIMUM OBSERVATION'/10F8.0)
	IF (IER.NE.0) WRITE(IOUT,103) IER
C
C  TABULATION OF STATISTICS ON VARIABLES 1 AND 2
	CALL TAB2(A,S,NOV,UBO,FREQ,PERCNT,STAT1,STAT2,NO,NV)
	WRITE(IOUT,105) ((FREQ(I,J),J=1,10),I=1,10)
105	FORMAT(//' STATISTICS ON VARIABLES 1 AND 8:'/
	1 '   FREQUENCY MATRIX:  (<2),2(1.00)10,(>10)'/(10F5.0))
	WRITE(IOUT,106)  ((PERCNT(I,J),J=1,10),I=1,10)
106	FORMAT(/'   PER CENT DISTRIBUTION:  (SAME PARTITION)'/(10F5.0))
	I=1
	WRITE(IOUT,107) I,((STAT1(J,K),K=1,10),J=1,3)
107	FORMAT(/' FOR VARIABLE',I2,' OVER SAME RANGE:'/'   TOTALS'/
	1 10F8.0,/'   MEANS'/,10F8.1,/'   STD. DEV.'/,10F8.5)
	I=8
	WRITE(IOUT,107) I,((STAT2(J,K),K=1,10),J=1,3)
C
C  STATISTICS (T-TEST) ON VARIABLES 1 AND 8
	DO 2 I=1,10
	VMIN(I)=A(1,I)
2	VMAX(I)=A(8,I)
	DO 3 IOP=2,4
	CALL TTSTT(VMIN,10,VMAX,10,IOP,NDF,ANS)
	GO TO (3,4,5,6),IOP
4	WRITE(IOUT,108)
108	FORMAT(//' T-STATISTICS ON VARIABLES 1 AND 8'//
	1 '   HYPOTHESES:  MEANS EQUAL, GIVEN VARIANCES EQUAL')
	GO TO 3
5	WRITE(IOUT,109)
109	FORMAT(/'   HYPOTHESIS:  MEANS EQUAL, GIVEN VARIANCES UNEQUAL')
	GO TO 3
6	WRITE(IOUT,110)
110	FORMAT(/'   HYPOTHESIS:  MEANS EQUAL, VARIANCES UNKNOWN')
3	WRITE(IOUT,111) NDF,ANS
111	FORMAT(10X'DEG. OF FREEDOM ='I4,10X,'T-STATISTIC ='F12.5)
	STOP
	END

---