File: MEANQ.FT of Tape: Various/ETH/eth11-1
(Source file text)
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
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