home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP2.ZIP / STATDSGN.ZIP / MEANQ.FOR < prev   
Text File  |  1985-11-29  |  5KB  |  149 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE MEANQ
  5. C
  6. C        PURPOSE
  7. C           COMPUTE SUM OF SQUARES, DEGREES OF FREEDOM, AND MEAN SQUARE
  8. C           USING THE MEAN SQUARE OPERATOR.  THIS SUBROUTINE NORMALLY
  9. C           FOLLOWS CALLS TO AVDAT AND AVCAL SUBROUTINES IN THE PER-
  10. C           FORMANCE OF ANALYSIS OF VARIANCE FOR A COMPLETE FACTORIAL
  11. C           DESIGN.
  12. C
  13. C        USAGE
  14. C           CALL MEANQ (K,LEVEL,X,GMEAN,SUMSQ,NDF,SMEAN,MSTEP,KOUNT,
  15. C                        LASTS)
  16. C
  17. C        DESCRIPTION OF PARAMETERS
  18. C           K     - NUMBER OF VARIABLES (FACTORS). K MUST BE .GT. ONE.
  19. C           LEVEL - INPUT VECTOR OF LENGTH K CONTAINING LEVELS (CATE-
  20. C                   GORIES) WITHIN EACH VARIABLE.
  21. C           X     - INPUT VECTOR CONTAINING THE RESULT OF THE SIGMA AND
  22. C                   DELTA OPERATORS. THE LENGTH OF X IS
  23. C                   (LEVEL(1)+1)*(LEVEL(2)+1)*...*(LEVEL(K)+1).
  24. C           GMEAN - OUTPUT VARIABLE CONTAINING GRAND MEAN.
  25. C           SUMSQ - OUTPUT VECTOR CONTAINING SUMS OF SQUARES.  THE
  26. C                   LENGTH OF SUMSQ IS 2 TO THE K-TH POWER MINUS ONE,
  27. C                   (2**K)-1.
  28. C           NDF   - OUTPUT VECTOR CONTAINING DEGREES OF FREEDOM.  THE
  29. C                   LENGTH OF NDF IS 2 TO THE K-TH POWER MINUS ONE,
  30. C                   (2**K)-1.
  31. C           SMEAN - OUTPUT VECTOR CONTAINING MEAN SQUARES.  THE
  32. C                   LENGTH OF SMEAN IS 2 TO THE K-TH POWER MINUS ONE,
  33. C                   (2**K)-1.
  34. C           MSTEP - WORKING VECTOR OF LENGTH K.
  35. C           KOUNT - WORKING VECTOR OF LENGTH K.
  36. C           LASTS - WORKING VECTOR OF LENGTH K.
  37. C
  38. C        REMARKS
  39. C           THIS SUBROUTINE MUST FOLLOW SUBROUTINE AVCAL
  40. C
  41. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  42. C           NONE
  43. C
  44. C        METHOD
  45. C           THE METHOD IS BASED ON THE TECHNIQUE DISCUSSED BY H. O.
  46. C           HARTLEY IN 'MATHEMATICAL METHODS FOR DIGITAL COMPUTERS',
  47. C           EDITED BY A. RALSTON AND H. WILF, JOHN WILEY AND SONS,
  48. C           1962, CHAPTER 20.
  49. C
  50. C     ..................................................................
  51. C
  52.       SUBROUTINE MEANQ (K,LEVEL,X,GMEAN,SUMSQ,NDF,SMEAN,MSTEP,KOUNT,
  53.      1                  LASTS)
  54.       DIMENSION LEVEL(1),X(1),SUMSQ(1),NDF(1),SMEAN(1),MSTEP(1),
  55.      1          KOUNT(1),LASTS(1)
  56. C
  57. C        ...............................................................
  58. C
  59. C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE
  60. C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION
  61. C        STATEMENT WHICH FOLLOWS.
  62. C
  63. C     DOUBLE PRECISION X,GMEAN,SUMSQ,SMEAN,FN1
  64. C
  65. C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS
  66. C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS
  67. C        ROUTINE.
  68. C
  69. C        ...............................................................
  70. C
  71. C     CALCULATE TOTAL NUMBER OF DATA
  72. C
  73.       N=LEVEL(1)
  74.       DO 150 I=2,K
  75.   150 N=N*LEVEL(I)
  76. C
  77. C     SET UP CONTROL FOR MEAN SQUARE OPERATOR
  78. C
  79.       LASTS(1)=LEVEL(1)
  80.       DO 178 I=2,K
  81.   178 LASTS(I)=LEVEL(I)+1
  82.       NN=1
  83. C
  84. C     CLEAR THE AREA TO STORE SUMS OF SQUARES
  85. C
  86.       LL=(2**K)-1
  87.       MSTEP(1)=1
  88.       DO 180 I=2,K
  89.   180 MSTEP(I)=MSTEP(I-1)*2
  90.       DO 185 I=1,LL
  91.   185 SUMSQ(I)=0.0
  92. C
  93. C     PERFORM MEAN SQUARE OPERATOR
  94. C
  95.       DO 190 I=1,K
  96.   190 KOUNT(I)=0
  97.   200 L=0
  98.       DO 260 I=1,K
  99.       IF(KOUNT(I)-LASTS(I)) 210, 250, 210
  100.   210 IF(L) 220, 220, 240
  101.   220 KOUNT(I)=KOUNT(I)+1
  102.       IF(KOUNT(I)-LEVEL(I)) 230, 230, 250
  103.   230 L=L+MSTEP(I)
  104.       GO TO 260
  105.   240 IF(KOUNT(I)-LEVEL(I)) 230, 260, 230
  106.   250 KOUNT(I)=0
  107.   260 CONTINUE
  108.       IF(L) 285, 285, 270
  109.   270 SUMSQ(L)=SUMSQ(L)+X(NN)*X(NN)
  110.       NN=NN+1
  111.       GO TO 200
  112. C
  113. C     CALCULATE THE GRAND MEAN
  114. C
  115.   285 FN=N
  116.       GMEAN=X(NN)/FN
  117. C
  118. C     CALCULATE FIRST DIVISOR REQUIRED TO FORM SUM OF SQUARES AND SECOND
  119. C     DIVISOR, WHICH IS EQUAL TO DEGREES OF FREEDOM, REQUIRED TO FORM
  120. C     MEAN SQUARES
  121. C
  122.       DO 310 I=2,K
  123.   310 MSTEP(I)=0
  124.       NN=0
  125.       MSTEP(1)=1
  126.   320 ND1=1
  127.       ND2=1
  128.       DO 340 I=1,K
  129.       IF(MSTEP(I)) 330, 340, 330
  130.   330 ND1=ND1*LEVEL(I)
  131.       ND2=ND2*(LEVEL(I)-1)
  132.   340 CONTINUE
  133.       FN1=N*ND1
  134.       FN2=ND2
  135.       NN=NN+1
  136.       SUMSQ(NN)=SUMSQ(NN)/FN1
  137.       NDF(NN)=ND2
  138.       SMEAN(NN)=SUMSQ(NN)/FN2
  139.       IF(NN-LL) 345, 370, 370
  140.   345 DO 360 I=1,K
  141.       IF(MSTEP(I)) 347, 350, 347
  142.   347 MSTEP(I)=0
  143.       GO TO 360
  144.   350 MSTEP(I)=1
  145.       GO TO 320
  146.   360 CONTINUE
  147.   370 RETURN
  148.       END
  149.