$JOB ANOVA[30,30]
$FORTRAN ANOVA
C ANOV 10
C ..................................................................ANOV 20
C ANOV 30
C SAMPLE MAIN PROGRAM FOR ANALYSIS OF VARIANCE - ANOVA ANOV 40
C ANOV 50
C PURPOSE ANOV 60
C (1) READ THE PROBLEM PARAMETER CARD FOR ANALYSIS OF VARI- ANOV 70
C ANCE, (2) CALL THE SUBROUTINES FOR THE CALCULATION OF SUMS ANOV 80
C OF SQUARES, DEGREES OF FREEDOM AND MEAN SQUARE, AND ANOV 90
C (3) PRINT FACTOR LEVELS, GRAND MEAN AND ANALYSIS OF VARI- ANOV 100
C ANCE TABLE. ANOV 110
C ANOV 120
C REMARKS ANOV 130
C THE PROGRAM HANDLES ONLY COMPLETE FACTORIAL DESIGNS. THERE-ANOV 140
C FORE, OTHER EXPERIMENTAL DESIGN MUST BE REDUCED TO THIS FORMANOV 150
C PRIOR TO THE USE OF THE PROGRAM. ANOV 160
C ANOV 170
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED ANOV 180
C AVDAT ANOV 190
C AVCAL ANOV 200
C MEANQ ANOV 210
C ANOV 220
C METHOD ANOV 230
C THE METHOD IS BASED ON THE TECHNIQUE DISCUSSED BY H. O. ANOV 240
C HARTLEY IN 'MATHEMATICAL METHODS FOR DIGITAL COMPUTERS', ANOV 250
C EDITED BY A. RALSTON AND H. WILF, JOHN WILEY AND SONS, ANOV 260
C 1962, CHAPTER 20. ANOV 270
C ANOV 280
C ..................................................................ANOV 290
C ANOV 300
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE ANOV 310
C CUMULATIVE PRODUCT OF EACH FACTOR LEVEL PLUS ONE (LEVEL(I)+1) ANOV 320
C FOR I=1 TO K, WHERE K IS THE NUMBER OF FACTORS.. ANOV 330
C ANOV 340
DIMENSION X(3000) ANOV 350
C ANOV 360
C THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE ANOV 370
C NUMBER OF FACTORS.. ANOV 380
C ANOV 390
DIMENSION HEAD(6),LEVEL(6),ISTEP(6),KOUNT(6),LASTS(6) ANOV 400
C ANOV 410
C THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO 2 TO ANOV 420
C THE K-TH POWER MINUS 1, ((2**K)-1).. ANOV 430
C ANOV 440
DIMENSION SUMSQ(63),NDF(63),SMEAN(63) ANOV 450
C ANOV 460
C THE FOLLOWING DIMENSION IS USED TO PRINT FACTOR LABELS IN ANALYSISANOV 470
C OF VARIANCE TABLE AND IS FIXED.. ANOV 480
C ANOV 490
DIMENSION FMT(15) ANOV 500
C ..................................................................ANOV 510
C ANOV 520
C IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE ANOV 530
C C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION ANOV 540
C STATEMENT WHICH FOLLOWS. ANOV 550
C ANOV 560
C DOUBLE PRECISION X,GMEAN,SUMSQ,SMEAN,SUM ANOV 570
C ANOV 580
C THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS ANOV 590
C APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS ANOV 600
C ROUTINE. ANOV 610
C ANOV 620
C ...............................................................ANOV 630
C ANOV 640
1 FORMAT(A4,A2,I2,A4,3X,11(A1,I4)/(A1,I4,A1,I4,A1,I4,A1,I4,A1,I4)) ANOV 650
2 FORMAT(26H1ANALYSIS OF VARIANCE.....A4,A2//) ANOV 660
3 FORMAT(18H0LEVELS OF FACTORS/(3X,A1,7X,I4)) ANOV 670
4 FORMAT(1H0//11H GRAND MEANF20.5////) ANOV 680
5 FORMAT(10H0SOURCE OF18X,7HSUMS OF10X,10HDEGREES OF9X,4HMEAN/10H VAANOV 690
1RIATION18X,7HSQUARES11X,7HFREEDOM10X,7HSQUARES/) ANOV 700
6 FORMAT(1H 15A1,F20.5,10X,I6,F20.5) ANOV 710
7 FORMAT(6H TOTAL10X,F20.5,10X,I6) ANOV 720
8 FORMAT(12F6.0) ANOV 730
C ANOV 740
C ..................................................................ANOV 750
C ANOV 760
C READ PROBLEM PARAMETER CARD ANOV 770
C ANOV 780
100 READ (5,1,END=999) PR,PR1,K,BLANK,(HEAD(I),LEVEL(I),I=1,K) ANOV 790
C PR.....PROBLEM NUMBER (MAY BE ALPHAMERIC) ANOV 800
C PR1....PROBLEM NUMBER (CONTINUED) ANOV 810
C K......NUMBER OF FACTORS ANOV 820
C BLANK..BLANK FIELD ANOV 830
C HEAD...FACTOR LABELS ANOV 840
C LEVEL..LEVELS OF FACTORS ANOV 850
C ANOV 860
C PRINT PROBLEM NUMBER AND LEVELS OF FACTORS ANOV 870
C ANOV 880
WRITE (6,2) PR,PR1 ANOV 890
WRITE (6,3) (HEAD(I),LEVEL(I),I=1,K) ANOV 900
C ANOV 910
C CALCULATE TOTAL NUMBER OF DATA ANOV 920
C ANOV 930
N=LEVEL(1) ANOV 940
DO 102 I=2,K ANOV 950
102 N=N*LEVEL(I) ANOV 960
C ANOV 970
C READ ALL INPUT DATA ANOV 980
C ANOV 990
READ (5,8) (X(I),I=1,N) ANOV1000
C ANOV1010
CALL AVDAT (K,LEVEL,N,X,L,ISTEP,KOUNT) ANOV1020
CALL AVCAL (K,LEVEL,X,L,ISTEP,LASTS) ANOV1030
CALL MEANQ (K,LEVEL,X,GMEAN,SUMSQ,NDF,SMEAN,ISTEP,KOUNT,LASTS) ANOV1040
C ANOV1050
C PRINT GRAND MEAN ANOV1060
C ANOV1070
WRITE (6,4) GMEAN ANOV1080
C ANOV1090
C PRINT ANALYSIS OF VARIANCE TABLE ANOV1100
C ANOV1110
WRITE (6,5) ANOV1120
LL=(2**K)-1 ANOV1130
ISTEP(1)=1 ANOV1140
DO 105 I=2,K ANOV1150
105 ISTEP(I)=0 ANOV1160
DO 110 I=1,15 ANOV1170
110 FMT(I)=BLANK ANOV1180
NN=0 ANOV1190
SUM=0.0 ANOV1200
120 NN=NN+1 ANOV1210
L=0 ANOV1220
DO 140 I=1,K ANOV1230
FMT(I)=BLANK ANOV1240
IF(ISTEP(I)) 130, 140, 130 ANOV1250
130 L=L+1 ANOV1260
FMT(L)=HEAD(I) ANOV1270
140 CONTINUE ANOV1280
WRITE (6,6) (FMT(I),I=1,15),SUMSQ(NN),NDF(NN),SMEAN(NN) ANOV1290
SUM=SUM+SUMSQ(NN) ANOV1300
IF(NN-LL) 145, 170, 170 ANOV1310
145 DO 160 I=1,K ANOV1320
IF(ISTEP(I)) 147, 150, 147 ANOV1330
147 ISTEP(I)=0 ANOV1340
GO TO 160 ANOV1350
150 ISTEP(I)=1 ANOV1360
GO TO 120 ANOV1370
160 CONTINUE ANOV1380
170 N=N-1 ANOV1390
WRITE (6,7) SUM,N ANOV1400
GO TO 100 ANOV1410
999 STOP
END ANOV1420
$DECK ANO.CDR
SAMPLE04 A0004B0003C0003R0002 20
3 10 9 8 24 8 9 3 2 8 9 8 30
4 12 3 9 22 7 16 2 2 2 7 2 40
5 10 5 8 23 9 17 3 2 8 6 3 50
2 14 9 13 29 16 11 3 2 7 5 3 60
7 11 5 8 28 18 10 6 6 6 5 9 70
9 10 27 8 28 16 11 7 8 9 8 15 80
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.SET CDR ANO
.EXECUTE/REL ANOVA,WES:SSP/LIB
%FIN::
.DELETE ANO.CDR