Directory of image this file is from
This file as a plain text file

C
C     ..................................................................
C
C        SAMPLE MAIN PROGRAM FOR ANALYSIS OF VARIANCE - ANOVA
C
C        PURPOSE
C           (1) READ THE PROBLEM PARAMETER CARD FOR ANALYSIS OF VARI-
C           ANCE, (2) CALL THE SUBROUTINES FOR THE CALCULATION OF SUMS
C           OF SQUARES, DEGREES OF FREEDOM AND MEAN SQUARE, AND
C           (3) PRINT FACTOR LEVELS, GRAND MEAN AND ANALYSIS OF VARI-
C           ANCE TABLE.
C
C        REMARKS
C           THE PROGRAM HANDLES ONLY COMPLETE FACTORIAL DESIGNS.  THERE-
C           FORE, OTHER EXPERIMENTAL DESIGN MUST BE REDUCED TO THIS FORM
C           PRIOR TO THE USE OF THE PROGRAM.
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           AVDAT
C           AVCAL
C           MEANQ
C
C        METHOD
C           THE METHOD IS BASED ON THE TECHNIQUE DISCUSSED BY H. O.
C           HARTLEY IN 'MATHEMATICAL METHODS FOR DIGITAL COMPUTERS',
C           EDITED BY A. RALSTON AND H. WILF, JOHN WILEY AND SONS,
C           1962, CHAPTER 20.
C
C     ..................................................................
C
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C     CUMULATIVE PRODUCT OF EACH FACTOR LEVEL PLUS ONE (LEVEL(I)+1)
C     FOR I=1 TO K, WHERE K IS THE NUMBER OF FACTORS..
C
         DIMENSION X(3000)
C
C     THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE
C     NUMBER OF FACTORS..
C
         DIMENSION HEAD(6),LEVEL(6),ISTEP(6),KOUNT(6),LASTS(6)
C
C     THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO 2 TO
C     THE K-TH POWER MINUS 1, ((2**K)-1)..
C
         DIMENSION SUMSQ(63),NDF(63),SMEAN(63)
C
C     THE FOLLOWING DIMENSION IS USED TO PRINT FACTOR LABELS IN ANALYSIS
C     OF VARIANCE TABLE AND IS FIXED..
C
         DIMENSION FMT(15)
C     ..................................................................
C
C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE
C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION
C        STATEMENT WHICH FOLLOWS.
C
C     DOUBLE PRECISION X,GMEAN,SUMSQ,SMEAN,SUM
C
C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS
C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS
C        ROUTINE.
C
C        ...............................................................
C
    1 FORMAT(A4,A2,I2,A4,3X,11(A1,I4)/(A1,I4,A1,I4,A1,I4,A1,I4,A1,I4))
    2 FORMAT(26H1ANALYSIS OF VARIANCE.....A4,A2//)
    3 FORMAT(18H0LEVELS OF FACTORS/(3X,A1,7X,I4))
    4 FORMAT(1H0//11H GRAND MEANF20.5////)
    5 FORMAT(10H0SOURCE OF18X,7HSUMS OF10X,10HDEGREES OF9X,4HMEAN/10H VA
     1RIATION18X,7HSQUARES11X,7HFREEDOM10X,7HSQUARES/)
    6 FORMAT(1H 15A1,F20.5,10X,I6,F20.5)
    7 FORMAT(6H TOTAL10X,F20.5,10X,I6)
    8 FORMAT(12F6.0)
C	OPEN (UNIT=5, DEVICE='CDR', ACCESS='SEQIN')
C	OPEN (UNIT=6, DEVICE='LPT', ACCESS='SEQOUT')
C
C     ..................................................................
C
C     READ PROBLEM PARAMETER CARD
C
	LOGICAL EOF
	CALL CHKEOF (EOF)
  100 READ (5,1) PR,PR1,K,BLANK,(HEAD(I),LEVEL(I),I=1,K)
	IF (EOF) GOTO 999
C       PR.....PROBLEM NUMBER (MAY BE ALPHAMERIC)
C       PR1....PROBLEM NUMBER (CONTINUED)
C       K......NUMBER OF FACTORS
C       BLANK..BLANK FIELD
C       HEAD...FACTOR LABELS
C       LEVEL..LEVELS OF FACTORS
C
C     PRINT PROBLEM NUMBER AND LEVELS OF FACTORS
C
      WRITE (6,2) PR,PR1
      WRITE (6,3) (HEAD(I),LEVEL(I),I=1,K)
C
C     CALCULATE TOTAL NUMBER OF DATA
C
      N=LEVEL(1)
      DO 102 I=2,K
  102 N=N*LEVEL(I)
C
C     READ ALL INPUT DATA
C
      READ (5,8) (X(I),I=1,N)
C
      CALL AVDAT (K,LEVEL,N,X,L,ISTEP,KOUNT)
      CALL AVCAL (K,LEVEL,X,L,ISTEP,LASTS)
      CALL MEANQ (K,LEVEL,X,GMEAN,SUMSQ,NDF,SMEAN,ISTEP,KOUNT,LASTS)
C
C     PRINT GRAND MEAN
C
      WRITE (6,4) GMEAN
C
C     PRINT ANALYSIS OF VARIANCE TABLE
C
      WRITE (6,5)
      LL=(2**K)-1
      ISTEP(1)=1
      DO 105 I=2,K
  105 ISTEP(I)=0
      DO 110 I=1,15
  110 FMT(I)=BLANK
      NN=0
      SUM=0.0
  120 NN=NN+1
      L=0
      DO 140 I=1,K
      FMT(I)=BLANK
      IF(ISTEP(I)) 130, 140, 130
  130 L=L+1
      FMT(L)=HEAD(I)
  140 CONTINUE
      WRITE (6,6) (FMT(I),I=1,15),SUMSQ(NN),NDF(NN),SMEAN(NN)
      SUM=SUM+SUMSQ(NN)
      IF(NN-LL) 145, 170, 170
  145 DO 160 I=1,K
      IF(ISTEP(I)) 147, 150, 147
  147 ISTEP(I)=0
      GO TO 160
  150 ISTEP(I)=1
      GO TO 120
  160 CONTINUE
  170 N=N-1
      WRITE (6,7) SUM,N
      GO TO 100
999	STOP
      END