Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/anova.cdk
There are 2 other files named anova.cdk in the archive. Click here to see a list.
$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