Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/banova/banova.for
There is 1 other file named banova.for in the archive. Click here to see a list.
C	WESTERN MICHIGAN UNIVERSITY
C	BANOVA.F4 (FILENAME ON LIBRARY DECTAPE)
C	BANOVA, 1.9.1 (CALLING NAME, SUBLST #)
C	BALANCED ANALYSIS OF VARIANCE
C	ADAPTED FROM DECUS(NO. 10-101, IBM-SSP)
C	MODIFIED BY SAM ANEMA AND R.R. BARR III
C	LIBRARY DECTAPE PROGRAMS USED:  USAGE.MAC
C	FORWMU PROGS USED:  TTYPTY, PRINTS, DEVCHG, EXISTS
C	APLIB PROGS. USED:  FISHER, GETFOR, IO
C	INTERNAL SUBR. USED:  AVCAL, AVDAT, MEANQ, SETUP
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
      DIMENSION F(63)
      DIMENSION ID(16),LFMT(96)
C---------------SEE COMMENTS FOR SUBR. AVCAL RELATING TO X(3000).
       DIMENSION X(3000)
      DIMENSION HEAD(6),LEVEL(6),ISTEP(6),KOUNT(6),LASTS(6)
      DIMENSION SUMSQ(63),NDF(63),SMEAN(63)
      DIMENSION FMT(15)
1     FORMAT(A4,A2,I2,A4,3X,11(A1,I4)/(A1,I4,A1,I4,A1,
     1I4,A1,I4,A1,I4))
2     FORMAT(' ','ANALYSIS OF VARIANCE............',A4,A2//)
3     FORMAT(' ','LEVELS OF FACTORS'/(3X,A1,7X,I4))
4     FORMAT(//' ','GRAND MEAN',F20.5////)
5     FORMAT(' ','SOURCE OF',18X,'SUMS OF',10X,'DEGREES OF',9X,
     1'MEAN'/' VARIATION',18X,'SQUARES',11X,'FREEDOM',10X,'SQUARES'/)
6     FORMAT(' ',12A1,F20.5,10X,I6,F20.5)
7     FORMAT(' ','TOTAL',7X,F20.5,10X,I6)
8     FORMAT(12F6.0)
      IOUT=3
      INP=2
      NOUTD=-1
      IND=-4
      WRITE(NOUTD,203)
203   FORMAT(//20X,'WMU'/5X,'BALANCED ANALYSIS OF VARIANCE'/)
C	CALL USAGE('BANOVA')
C---------------TTYPTY RETURNS ZERO - TTY JOB, MINUS ONE - BATCH JOB
      CALL TTYPTY(ICODE)
C---------------NDV1, NDV2 ARE RETURNED.  OTHER ARGS ARE INPUT.  1 CAUSES
C--------------- OUTPUT? TO PRINT, 0 CAUSES INPUT? TO PRINT.  ICODE
C--------------- COMES FROM CALL TTYPTY.
      CALL IO(IOUT,NDV1,NOUTD,IND,1,ICODE)
201   CALL IO(INP,NDV2,NOUTD,IND,0,ICODE)
C---------------LFMT, ISTD ARE RETURNED.  OTHER ARGS ARE INPUT.  96=NO.
C--------------- OF FMT. WORDS FOR OBJ. TIME FORMAT (6 LINES)
C--------------- 2 MEANS F - TYPE ONLY FOR FORMAT
      CALL GETFOR(NOUTD,IND,LFMT,ISTD,96,2)
C---------------USER CHOSE STANDARD FORMAT IF ISTD=1
      IF(ISTD.EQ.1)LFMT(1)='(10F)'
      BLANK='    '
      PR='    '
      PR1='  '
      WRITE(NOUTD,220)
220   FORMAT(' ','ENTER NUMBER OF FACTORS.'/)
      READ(IND,230)K
230   FORMAT(I)
      WRITE(NOUTD,240)
240   FORMAT(' ','ENTER NAMES OF FACTORS. '
     1,'(SINGLE ALPHAMERIC CHARACTERS)'/)
      READ(IND,250)(HEAD(I),I=1,K)
250   FORMAT(10(A1,1X))
      WRITE(NOUTD,260)
260   FORMAT(' ','ENTER NUMBER OF LEVELS FOR EACH FACTOR.'/)
      READ(IND,270)(LEVEL(I),I=1,K)
270   FORMAT(10I)
      N=LEVEL(1)
      DO 280 I=2,K
280   N=N*LEVEL(I)
      LINES=IFIX(FLOAT(N)/10.0+.999)
1002  WRITE(NOUTD,1003)
1003  FORMAT(' ','ENTER IDENTIFICATION'/)
      READ(IND,1004)(ID(I),I=1,16)
1004  FORMAT(16A5)
      IDC=INP
      IF(NDV2.NE.'TTY')GO TO 739
      IF(ISTD.EQ.1)WRITE(NOUTD,740)
740   FORMAT(' ENTER DATA (AT MOST 10 PER LINE)'/)
      IF(ISTD.NE.1)WRITE(NOUTD,330)
      CALL SETUP(LINES,NOUTD,IND)
      IDC=1
      CALL IFILE(1,'JOB')
      GO TO 337
739   WRITE(NOUTD,741)
741   FORMAT(' YOUR DATA IS BEING READ.'/)
330   FORMAT(' ','ENTER DATA.'/)
337   READ(IDC,LFMT)(X(I),I=1,N)
210   WRITE(IOUT,2)PR,PR1
      WRITE(IOUT,1008)(ID(I),I=1,16)
1008  FORMAT(' ',16A5)
      WRITE(IOUT,3)(HEAD(I),LEVEL(I),I=1,K)
      WRITE(IOUT,401)
401   FORMAT(///' MEANS ON LEVELS'//' FACTOR',5X,'LEVEL',9X,'MEAN'/)
      KA=1
      KF=N
      DO 490 I=1,K
      IF(I.EQ.1)GO TO 491
      KA=KA*LEVEL(I-1)
491   KF=KF/LEVEL(I)
      XNUM=FLOAT(N/LEVEL(I))
      DO 480 J=1,LEVEL(I)
      SUM=0.0
      DO 481 KK=1,KF
      KSTART=(KK-1)*LEVEL(I)*KA+(J-1)*KA+1
      KLAST=KSTART+KA-1
      DO 482 KL=KSTART,KLAST
482   SUM=SUM+X(KL)
481   CONTINUE
      SUM=SUM/XNUM
      WRITE(IOUT,483)HEAD(I),J,SUM
483   FORMAT(4X,A1,6X,I4,F17.4)
480   CONTINUE
490   CONTINUE
      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)
      WRITE(IOUT,4)GMEAN
      WRITE(IOUT,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.
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(IOUT,6)(FMT(I),I=1,12),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(IOUT,7)SUM,N
      WRITE(NOUTD,1009)
1009   FORMAT(///' WOULD YOU LIKE TO POOL OVER THE LAST FACTOR?'/)
      READ(IND,1010)IP
      IF(IP.NE.'YES')GO TO 201
1010   FORMAT(A3)
19    NST=2**(K-1)
      ISTEP(1)=1
      DO 40 I=2,K
40    ISTEP(I)=0
      ERROR=0.
      NDFT=0
      NN=0
      DO 20 I=NST,LL
      ERROR=ERROR+SUMSQ(I)
20    NDFT=NDFT+NDF(I)
      SMEAN(NST)=ERROR/FLOAT(NDFT)
      SUMSQ(NST)=ERROR
      DO 27 I=1,NST-1
27    F(I)=SMEAN(I)/SMEAN(NST)
      NDF(NST)=NDFT
      WRITE(IOUT,51)
28    NN=NN+1
      L=0
      DO 23 I=1,K
      FMT(I)=BLANK
      IF(ISTEP(I))22,23,22
22    L=L+1
      FMT(L)=HEAD(I)
23    CONTINUE
	FPRB=FISHER(NDF(NN),NDF(NST),F(NN))
      WRITE(IOUT,29)(FMT(I),I=1,8),SUMSQ(NN),NDF(NN),SMEAN(NN),
     1F(NN),FPRB
      IF(NN-(NST-1))31,32,32
31    DO 33 I=1,K
      IF(ISTEP(I))34,35,34
34    ISTEP(I)=0
      GO TO 33
35    ISTEP(I)=1
      GO TO 28
33    CONTINUE
32    WRITE(IOUT,38)SUMSQ(NST),NDF(NST),SMEAN(NST)
      WRITE(IOUT,39)SUM,N
      WRITE(NOUTD,204)
204   FORMAT(///)
      GO TO 201
51    FORMAT(////' ANALYSIS OF VARIANCE WITH LAST FACTOR',
     1' POOLED AND CALLED ERROR'//' SOURCE OF',7X,'SUMS OF',
     13X,'DEGREES OF',6X,'MEAN',9X,'F',9X,'F'/' VARIATION',7X,'SQUARES',
     15X,'FREEDOM',6X,'SQUARES',4X,'VALUES',5X,'PROB'/)
29    FORMAT(' ',8A1,F17.5,I9,F15.5,F10.3,F10.5)
38    FORMAT(' ERROR   ',F17.5,I9,F15.5)
39    FORMAT(' TOTAL   ',F17.5,I9)

      END
C
C     ..................................................................
C
C        SUBROUTINE AVCAL
C
C        PURPOSE
C           PERFORM THE CALCULUS OF A FACTORIAL EXPERIMENT USING
C           OPERATOR SIGMA AND OPERATOR DELTA.  THIS SUBROUTINE IS
C           PRECEDED BY SUBROUTINE ADVAT AND FOLLOWED BY SUBROUTINE
C           MEANQ IN THE PERFORMANCE OF ANALYSIS OF VARIANCE FOR A
C           COMPLETE FACTORIAL DESIGN.
C
C        USAGE
C           CALL AVCAL (K,LEVEL,X,L,ISTEP,LASTS)
C
C        DESCRIPTION OF PARAMETERS
C           K     - NUMBER OF VARIABLES (FACTORS). K MUST BE .GT. ONE.
C           LEVEL - INPUT VECTOR OF LENGTH K CONTAINING LEVELS (CATE-
C                   GORIES) WITHIN EACH VARIABLE.
C           X     - INPUT VECTOR CONTAINING DATA.  DATA HAVE BEEN PLACED
C                   IN VECTOR X BY SUBROUTINE AVDAT.  THE LENGTH OF X
C                   IS (LEVEL(1)+1)*(LEVEL(2)+1)*...*(LEVEL(K)+1).
C           L     - THE POSITION IN VECTOR X WHERE THE LAST INPUT DATA
C                   IS LOCATED.  L HAS BEEN CALCULATED BY SUBROUTINE
C                   AVDAT.
C           ISTEP - INPUT VECTOR OF LENGTH K CONTAINING STORAGE CONTROL
C                   STEPS WHICH HAVE BEEN CALCULATED BY SUBROUTINE
C                   AVDAT.
C           LASTS - WORKING VECTOR OF LENGTH K.
C
C        REMARKS
C           THIS SUBROUTINE MUST FOLLOW SUBROUTINE AVDAT.
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           NONE
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---------------K, LEVEL, X, L, ISTEP ARE INPUT.  LASTS IS
C--------------- OUTPUT.  X IS MODIFIED.
      SUBROUTINE AVCAL (K,LEVEL,X,L,ISTEP,LASTS)
      DIMENSION LEVEL(1),X(1),ISTEP(1),LASTS(1)
C
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,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
C     CALCULATE THE LAST DATA POSITION OF EACH FACTOR
C
      LASTS(1)=L+1
      DO 145 I=2,K
  145 LASTS(I)=LASTS(I-1)+ISTEP(I)
C
C     PERFORM CALCULUS OF OPERATION
C
  150 DO 175 I=1,K
      L=1
      LL=1
      SUM=0.0
      NN=LEVEL(I)
      FN=NN
      INCRE=ISTEP(I)
      LAST=LASTS(I)
C
C     SIGMA OPERATION
C
  155 DO 160 J=1,NN
      SUM=SUM+X(L)
  160 L=L+INCRE
      X(L)=SUM
C
C     DELTA OPERATION
C
      DO 165 J=1,NN
      X(LL)=FN*X(LL)-SUM
  165 LL=LL+INCRE
      SUM=0.0
      IF(L-LAST) 167, 175, 175
  167 IF(L-LAST+INCRE) 168, 168, 170
  168 L=L+INCRE
      LL=LL+INCRE
      GO TO 155
  170 L=L+INCRE+1-LAST
      LL=LL+INCRE+1-LAST
      GO TO 155
  175 CONTINUE
      RETURN
      END
C
C     ..................................................................
C
C        SUBROUTINE AVDAT
C
C        PURPOSE
C           PLACE DATA FOR ANALYSIS OF VARIANCE IN PROPERLY DISTRIBUTED
C           POSITIONS OF STORAGE.  THIS SUBROUTINE IS NORMALLY FOLLOWED
C           BY CALLS TO AVCAL AND MEANQ SUBROUTINES IN THE PERFORMANCE
C           OF ANALYSIS OF VARIANCE FOR A COMPLETE FACTORIAL DESIGN.
C
C        USAGE
C           CALL AVDAT (K,LEVEL,N,X,L,ISTEP,KOUNT)
C
C        DESCRIPTION OF PARAMETERS
C           K     - NUMBER OF VARIABLES (FACTORS). K MUST BE .GT. ONE.
C           LEVEL - INPUT VECTOR OF LENGTH K CONTAINING LEVELS (CATE-
C                   GORIES) WITHIN EACH VARIABLE.
C           N     - TOTAL NUMBER OF DATA POINTS READ IN.
C           X     - WHEN THE SUBROUTINE IS CALLED, THIS VECTOR CONTAINS
C                   DATA IN LOCATIONS X(1) THROUGH X(N).  UPON RETURNING
C                   TO THE CALLING ROUTINE, THE VECTOR CONTAINS THE DATA
C                   IN PROPERLY REDISTRIBUTED LOCATIONS OF VECTOR X.
C                   THE LENGTH OF VECTOR X IS CALCULATED BY (1) ADDING
C                   ONE TO EACH LEVEL OF VARIABLE AND (2) OBTAINING THE
C                   CUMULATIVE PRODUCT OF ALL LEVELS.  (THE LENGTH OF
C                   X = (LEVEL(1)+1)*(LEVEL(2)+1)*...*(LEVEL(K)+1).)
C           L     - OUTPUT VARIABLE CONTAINING THE POSITION IN VECTOR X
C                   WHERE THE LAST INPUT DATA IS STORED.
C           ISTEP - OUTPUT VECTOR OF LENGTH K CONTAINING CONTROL STEPS
C                   WHICH ARE USED TO LOCATE DATA IN PROPER POSITIONS
C                   OF VECTOR X.
C           KOUNT - WORKING VECTOR OF LENGTH K.
C        REMARKS
C           INPUT DATA MUST BE ARRANGED IN THE FOLLOWING MANNER.
C           CONSIDER THE 3-VARIABLE ANALYSIS OF VARIANCE DESIGN, WHERE
C           ONE VARIABLE HAS 3 LEVELS AND THE OTHER TWO VARIABLES HAVE
C           2 LEVELS.  THE DATA MAY BE REPRESENTED IN THE FORM X(I,J,K),
C           I=1,2,3  J=1,2  K=1,2.  IN ARRANGING DATA, THE INNER
C           SUBSCRIPT, NAMELY I, CHANGES FIRST.  WHEN I=3, THE NEXT
C           INNER SUBSCRIPT, J, CHANGES AND SO ON UNTIL I=3, J=2, AND
C           K=2.
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           NONE
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---------------K, N, X, ISTEP ARE INPUT.  L, KOUNT ARE OUTPUT.
C--------------- X, ISTEP ARE MODIFIED.
      SUBROUTINE AVDAT (K,LEVEL,N,X,L,ISTEP,KOUNT)
      DIMENSION LEVEL(1),X(1),ISTEP(1),KOUNT(1)
C
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
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
C     CALCULATE TOTAL DATA AREA REQUIRED
C
      M=LEVEL(1)+1
      DO 105 I=2,K
  105 M=M*(LEVEL(I)+1)
C
C     MOVE DATA TO THE UPPER PART OF THE ARRAY X
C     FOR THE PURPOSE OF REARRANGEMENT
C
      N1=M+1
      N2=N+1
      DO 107 I=1,N
      N1=N1-1
      N2=N2-1
  107 X(N1)=X(N2)
C
C     CALCULATE MULTIPLIERS TO BE USED IN FINDING STORAGE LOCATIONS FOR
C     INPUT DATA
C
      ISTEP(1)=1
      DO 110 I=2,K
  110 ISTEP(I)=ISTEP(I-1)*(LEVEL(I-1)+1)
      DO 115 I=1,K
  115 KOUNT(I)=1
C
C     PLACE DATA IN PROPER LOCATIONS
C
      N1=N1-1
      DO 135 I=1,N
      L=KOUNT(1)
      DO 120 J=2,K
  120 L=L+ISTEP(J)*(KOUNT(J)-1)
      N1=N1+1
      X(L)=X(N1)
      DO 130 J=1,K
      IF(KOUNT(J)-LEVEL(J)) 124, 125, 124
  124 KOUNT(J)=KOUNT(J)+1
      GO TO 135
  125 KOUNT(J)=1
  130 CONTINUE
  135 CONTINUE
      RETURN
      END
C
C     ..................................................................
C
C        SUBROUTINE MEANQ
C
C        PURPOSE
C           COMPUTE SUM OF SQUARES, DEGREES OF FREEDOM, AND MEAN SQUARE
C           USING THE MEAN SQUARE OPERATOR.  THIS SUBROUTINE NORMALLY
C           FOLLOWS CALLS TO AVDAT AND AVCAL SUBROUTINES IN THE PER-
C           FORMANCE OF ANALYSIS OF VARIANCE FOR A COMPLETE FACTORIAL
C           DESIGN.
C
C        USAGE
C           CALL MEANQ (K,LEVEL,X,GMEAN,SUMSQ,NDF,SMEAN,MSTEP,KOUNT,
C                        LASTS)
C
C        DESCRIPTION OF PARAMETERS
C           K     - NUMBER OF VARIABLES (FACTORS). K MUST BE .GT. ONE.
C           LEVEL - INPUT VECTOR OF LENGTH K CONTAINING LEVELS (CATE-
C                   GORIES) WITHIN EACH VARIABLE.
C           X     - INPUT VECTOR CONTAINING THE RESULT OF THE SIGMA AND
C                   DELTA OPERATORS. THE LENGTH OF X IS
C                   (LEVEL(1)+1)*(LEVEL(2)+1)*...*(LEVEL(K)+1).
C           GMEAN - OUTPUT VARIABLE CONTAINING GRAND MEAN.
C           SUMSQ - OUTPUT VECTOR CONTAINING SUMS OF SQUARES.  THE
C                   LENGTH OF SUMSQ IS 2 TO THE K-TH POWER MINUS ONE,
C                   (2**K)-1.
C           NDF   - OUTPUT VECTOR CONTAINING DEGREES OF FREEDOM.  THE
C                   LENGTH OF NDF IS 2 TO THE K-TH POWER MINUS ONE,
C                   (2**K)-1.
C           SMEAN - OUTPUT VECTOR CONTAINING MEAN SQUARES.  THE
C                   LENGTH OF SMEAN IS 2 TO THE K-TH POWER MINUS ONE,
C                   (2**K)-1.
C           MSTEP - WORKING VECTOR OF LENGTH K.
C           KOUNT - WORKING VECTOR OF LENGTH K.
C           LASTS - WORKING VECTOR OF LENGTH K.
C
C        REMARKS
C           THIS SUBROUTINE MUST FOLLOW SUBROUTINE AVCAL
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           NONE
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---------------K, LEVEL, X ARE INPUT.  GMEAN, SUMSQ, NDF, SMEAN,
C--------------- KOUNT, LASTS, MSTEP ARE OUTPUT.
      SUBROUTINE MEANQ (K,LEVEL,X,GMEAN,SUMSQ,NDF,SMEAN,MSTEP,KOUNT,
     1                  LASTS)
      DIMENSION LEVEL(1),X(1),SUMSQ(1),NDF(1),SMEAN(1),MSTEP(1),
     1          KOUNT(1),LASTS(1)
C
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,FN1
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
C     CALCULATE TOTAL NUMBER OF DATA
C
      N=LEVEL(1)
      DO 150 I=2,K
  150 N=N*LEVEL(I)
C
C     SET UP CONTROL FOR MEAN SQUARE OPERATOR
C
      LASTS(1)=LEVEL(1)
      DO 178 I=2,K
  178 LASTS(I)=LEVEL(I)+1
      NN=1
C
C     CLEAR THE AREA TO STORE SUMS OF SQUARES
C
      LL=(2**K)-1
      MSTEP(1)=1
      DO 180 I=2,K
  180 MSTEP(I)=MSTEP(I-1)*2
      DO 185 I=1,LL
  185 SUMSQ(I)=0.0
C
C     PERFORM MEAN SQUARE OPERATOR
C
      DO 190 I=1,K
  190 KOUNT(I)=0
  200 L=0
      DO 260 I=1,K
      IF(KOUNT(I)-LASTS(I)) 210, 250, 210
  210 IF(L) 220, 220, 240
  220 KOUNT(I)=KOUNT(I)+1
      IF(KOUNT(I)-LEVEL(I)) 230, 230, 250
  230 L=L+MSTEP(I)
      GO TO 260
  240 IF(KOUNT(I)-LEVEL(I)) 230, 260, 230
  250 KOUNT(I)=0
  260 CONTINUE
      IF(L) 285, 285, 270
  270 SUMSQ(L)=SUMSQ(L)+X(NN)*X(NN)
      NN=NN+1
      GO TO 200
C
C     CALCULATE THE GRAND MEAN
C
  285 FN=N
      GMEAN=X(NN)/FN
C
C     CALCULATE FIRST DIVISOR REQUIRED TO FORM SUM OF SQUARES AND SECOND
C     DIVISOR, WHICH IS EQUAL TO DEGREES OF FREEDOM, REQUIRED TO FORM
C     MEAN SQUARES
C
      DO 310 I=2,K
  310 MSTEP(I)=0
      NN=0
      MSTEP(1)=1
  320 ND1=1
      ND2=1
      DO 340 I=1,K
      IF(MSTEP(I)) 330, 340, 330
  330 ND1=ND1*LEVEL(I)
      ND2=ND2*(LEVEL(I)-1)
  340 CONTINUE
      FN1=N*ND1
      FN2=ND2
      NN=NN+1
      SUMSQ(NN)=SUMSQ(NN)/FN1
      NDF(NN)=ND2
      SMEAN(NN)=SUMSQ(NN)/FN2
      IF(NN-LL) 345, 370, 370
  345 DO 360 I=1,K
      IF(MSTEP(I)) 347, 350, 347
  347 MSTEP(I)=0
      GO TO 360
  350 MSTEP(I)=1
      GO TO 320
  360 CONTINUE
  370 RETURN
      END
C---------------SETUP ALLOWS CORRECTION OF INPUT DATA FROM TERMINAL.
C--------------- SEE WRITE UP BOTTOM PAGE 6.  ALL ARGS. ARE INPUT.
      SUBROUTINE SETUP(LINES,NOUTD,IND)
      DIMENSION X(16)
       DOUBLE PRECISION FIL
      DATA FIL/'JOB.DAT'/
      CALL OFILE (1,'JOB')
      DO 3 J=1,LINES
1     READ(IND,10,END=20)(X(I),I=1,16)
10    FORMAT(16A5)
3     WRITE(1,10)(X(I),I=1,16)
20    ENDFILE 1
C---------------TTYPTY RETURNS ZERO - TTY JOB, MINUS ONE - BATCH JOB
      CALL TTYPTY(IWHER)
      IF(IWHER.EQ.-1)GO TO 26
200   WRITE(NOUTD,21)
21    FORMAT(' OK? '/)
      READ(IND,22)HUH
22    FORMAT(A3)
      IF(HUH.EQ.'NO')GO TO 25
      IF(HUH.EQ.'YES')GO TO 26
      IF(HUH.NE.'OK')GO TO 200
      GO TO 26
25    CALL IFILE(1,'JOB')
      K=1
40    READ(1,10,END=41)(X(I),I=1,16)
      DO 27 I=1,16
      IF(X(I).NE.' ')GO TO 28
27    CONTINUE
28    DO 29 J=I,16
      IF(X(J).EQ.' ')GO TO 30
29    CONTINUE
      J=17
30    WRITE(NOUTD,31)K,(X(I),I=1,J-1)
31    FORMAT(' ',I3,2X,16A5)
      K=K+1
      GO TO 40
41    WRITE(NOUTD,45)
45    FORMAT(//)
      REWIND 1
      CALL DEFINE FILE(1,80,NEVER,FIL,0,0)
101   WRITE(NOUTD,42)
42    FORMAT('+CORRECTIONS? ',$)
      READ(IND,43)K,(X(I),I=1,16)
43    FORMAT(I,16A5)
      IF(K.EQ.0)GO TO 100
      WRITE(1#K,10)(X(I),I=1,16)
      REWIND 1
      GO TO 101
100   CALL RELEAS(1)
26    RETURN
      END