Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/triaov.f4
There are no other files named triaov.f4 in the archive.
C	WESTERN MICHIGAN UNIVERSITY
C	TRIAOV.F4 (FILENAME ON LIBRARY DECTAPE)
C	TRIAOV, 1.9.3 (CALLING NAME, SUBLST NO.)
C	THREE-WAY ANALYSIS OF VARIANCE
C	PROGRAMMED BY SAM ANEMA AT WMU, LATER MODIFIED BY R.R. BARR,
C	 M.T. O'BRYAN, CONSULTANT - DR. M. STOLINE
C	LIBRARY DECTAPE PROGS. USED:  USAGE.MAC
C	APLIB PROGS. USED:  IO, GETFOR, CHIPRB, FISHER, NORMCV
C	FORWMU PROGS. USED:  TTYPTY, MINSQV, ALLCOR, PRINTS, DEVCHG,
C	 EXISTS
C	INTERNAL SUBR. USED:  MNL, BARTLT, FIT, PRINT, WEIGH, UNWEI,
C	 PROP
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
C---------------S(1) USED IN CALL MNL, LX(3) CONTAINS NO. OF LEVELS
C--------------- ON 3 FACTORS.  LNAME(2) IS APPARENTLY NOT USED
      DIMENSION LX(3),S(1),LNAME(2)
C
C     READ IN PARAMETERS
C
99    TYPE 100
100   FORMAT('1 ---WMU 3-WAY ANALYSIS OF VARIANCE --'///)
C	CALL USAGE('TRIAOV')
C---------------TTYPTY RETURNS ZERO - TTY, MINUS ONE - BATCH JOB
	CALL TTYPTY(ICODE)
C---------------ODV, IDV ARE RETURNED.  OTHER ARGS. ARE INPUT.
C--------------- 1 MEANS OUTPUT? PRINTS.  0 MEANS INPUT? PRINTS.
	CALL IO(6,ODV,-1,-4,1,ICODE)
801	CALL IO(4,IDV,-1,-4,0,ICODE)
98    TYPE 101
101   FORMAT (' ENTER FACTOR NAMES AND NO. OF LEVELS'/)
90    ACCEPT 102,INAME,IMAX,JNAME,JMAX
102   FORMAT (A1,1X,I)
      ACCEPT 108,KNAME,KMAX,NTIMES
108   FORMAT(A1,1X,2I)
      IF(IMAX.LT.2.OR.JMAX.LT.2.OR.KMAX.LT.2)GO TO 60
      GO TO 63
60    TYPE 64
64    FORMAT(' THE PROGRAM REQUIRES AT LEAST 2 LEVELS ON EACH 
     1FACTOR.'/' REENTER FACTOR NAMES AND NO. OF LEVELS.'/)
	IF(ICODE.NE.0)CALL EXIT
      GO TO 90
61    TYPE 62
62    FORMAT(' THE PROBLEM IS TOO LARGE.'/' REENTER FACTOR NAMES AND 
     1LEVELS.'/)
	IF(ICODE.NE.0)CALL EXIT
      GO TO 90
63    LX(1)=IMAX
      LX(2)=JMAX
      LX(3)=KMAX
      DO 10 I=2,3
      DO 11 J=1,I-1
      IF(LX(I).GE.LX(J))GO TO 11
      ITM=LX(I)
      LX(I)=LX(J)
      LX(J)=ITM
11    CONTINUE
10    CONTINUE
      MX=IMAX*JMAX*KMAX
      MAX=2*(MX+IMAX*JMAX+IMAX*KMAX+JMAX*KMAX)+10*LX(3)+(LX(3)+1)*
     1	(LX(3)+1)+2*LX(3)*LX(2)+2+IMAX+JMAX+KMAX+MX
      CALL ALLCOR(MAX,IERR,I1,S)
      IF(IERR.NE.0)GO TO 61
      I2=I1+MX
      I3=I2+MX
      I4=I3+IMAX*JMAX
      I5=I4+IMAX*KMAX
      I6=I5+LX(3)+1
      I7=I6+LX(3)+1
      I8=I7+JMAX*KMAX
      I9=I8+IMAX
      I10=I9+JMAX
      I11=I10+KMAX
      I12=I11+IMAX*JMAX
      I13=I12+IMAX*KMAX
      I14=I13+JMAX*KMAX
      I15=I14+LX(3)
      I16=I15+LX(3)
      I17=I16+LX(3)
      I18=I17+(LX(3)+1)*(LX(3)+1)
      I19=I18+LX(3)
      I20=I19+LX(3)
      I21=I20+LX(3)*LX(2)
      I22=I21+LX(3)*LX(2)
      I23=I22+LX(3)
      I24=I23+LX(3)
	I25=I24+LX(3)
      CALL MNL(INAME,JNAME,KNAME,
     1        IMAX,JMAX,KMAX,NTIMES,S(I1),S(I2),S(I3),S(I4),S(I5),
     1S(I6),S(I7),S(I8),S(I9),S(I10),S(I11),S(I12),S(I13),S(I14),S(I15)
     2,S(I16),S(I17),S(I18),S(I19),S(I20),S(I21),S(I22),S(I23),S(I24),
     3	S(I25),IDV)
	TYPE 802
802	FORMAT(//)
	GO TO 801
      END
C---------------INAME, JNAME, KNAME, IMAX, JMAX, KMAX, NTIMES
C--------------- ARE INPUT.  OTHER ARGS. ARE SPACES 
C--------------- RESERVED BY DYN. ALLOC.
      SUBROUTINE MNL(INAME,JNAME,KNAME,
     1               IMAX,JMAX,KMAX,NTIMES,NIJK,XIJK,XIJ,XIK,MC,MR,XJK,
     1XI,XJ,XK,NIJ,NIK,NJK,NI,NJ,NK,D,YB,XD,DF,FF,C,B,A,XXIJK,IDV)
      DIMENSION NIJK(1),XIJK(1),XIJ(1),XIK(1),MC(1),MR(1),XJK(1),XI(1),
     1XJ(1),XK(1),ID(5,50),FMT(48),X(50),NIJ(1),NIK(1),NJK(1),NI(1),
     2NJ(1),NK(1),D(1),YB(1),XD(1),DF(1),FF(1),C(1),B(1),A(1),IAST(19)
     3,IENT(17),XXIJK(1)
      DATA IAST(18),IAST(19)/',0,0,','0,0,0'/
63    IF(NTIMES.EQ.0)NTIMES=1
      TYPE 103
103   FORMAT (' ENTER ID IF DESIRED ELSE RETURN'/)
      DO 37 J=1,NTIMES
37    ACCEPT 104, (ID(I,J),I=1,5)
104   FORMAT (16A5)
      TYPE 1010
1010  FORMAT(' MEANS? ',$)
      ACCEPT 1011,IFM
1011  FORMAT(A3)
C---------------FMT RETURNS USER FORMAT.  ISTD=1 IF STANDARD
C--------------- FORMAT IS REQUESTED, =0 IF FORMAT TO BE USED IS IN FMT.
      CALL GETFOR(-1,-4,FMT,ISTD,48,4)
96    TYPE 2191
2191   FORMAT(' WHICH METHOD OF DATA ENTRY? (1 OR 2) ',$)
      ACCEPT 2192,NWHICH
2192  FORMAT(I)
	IF(IDV.NE.'TTY')GO TO 97
      TYPE 95
95    FORMAT(' ENTER DATA'/)
	GO TO 94
97	TYPE 93
93	FORMAT(' DATA IS BEING READ'/)
C
C     INITIALIZE
C
94      NTI=0
   80 NTI=NTI+1
      N=0
      MX= IMAX*JMAX*KMAX
      DO 200 I=1,MX
      NIJK(I)=0
	XXIJK(I)=0
200   XIJK(I)=0.0
      MX= IMAX*JMAX
      DO 201 I=1,MX
      NIJ(I)=0
201   XIJ(I)=0.0
      MX=JMAX*KMAX
      DO 202 I=1,MX
      NJK(I)=0
202   XJK(I)=0.0
      MX=IMAX*KMAX
      DO 203 I=1,MX
      NIK(I)=0
203   XIK(I)=0.0
      DO 204 I=1,IMAX
      NI(I)=0
204   XI(I)=0.0
      DO 205 I=1,JMAX
      NJ(I)=0
205   XJ(I)=0.0
      DO 206 I=1,KMAX
      NK(I)=0
206   XK(I)=0.0
      SSTOT=0.0
      SUM=0.0
C
C     READ IN DATA
C
      IF(NWHICH.EQ.2)GO TO 5364
      IF(ISTD.EQ.0)GO TO 1
      FMT(1)='(3I,F'
      FMT(2)=')    '
1     READ(4,FMT,END=300)I,J,K,(X(L),L=1,NTIMES)
      IF(I.EQ.0)GO TO 300
      IF(I.GT.IMAX.OR.J.GT.JMAX.OR.K.GT.KMAX)GO TO 40
      IF(I.LT.1.OR.J.LT.1.OR.K.LT.1)GO TO 40
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
84    FORMAT(I)
      N=N+1
      NIJK(IJK)=NIJK(IJK)+1
      XIJK(IJK)=XIJK(IJK)+X(NTI)
	XXIJK(IJK)=XXIJK(IJK)+X(NTI)*X(NTI)
      SUM=SUM+X(NTI)
10    SSTOT=SSTOT+X(NTI)**2
      GO TO 1
5364  IF(ISTD.EQ.0)GO TO 3197
      FMT(1)='(10F)'
3197  READ(4,3198,END=300)(IENT(I),I=1,17)
3198  FORMAT(A1,15A5,A4)
      ENCODE(80,3198,IAST)(IENT(I),I=1,17)
      IF(IENT(1).EQ.'*')GO TO 3199
      IF(I.EQ.0)GO TO 3191
      DECODE(95,FMT,IAST)(X(L),L=1,NTIMES)
      N=N+1
      NIJK(IJK)=NIJK(IJK)+1
      XIJK(IJK)=XIJK(IJK)+X(NTI)
	XXIJK(IJK)=XXIJK(IJK)+X(NTI)*X(NTI)
      SUM=SUM+X(NTI)
      SSTOT=SSTOT+X(NTI)**2
      GO TO 3197
3199  DECODE(95,3140,IAST)I,J,K
3140   FORMAT(1X,3I)
      IF(I.EQ.0)GO TO 300
      IF(I.GT.IMAX.OR.J.GT.JMAX.OR.K.GT.KMAX)GO TO 3191
      IF(I.LT.1.OR.J.LT.1.OR.K.LT.1)GO TO 3191
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
      GO TO 3197
3191  TYPE 3192
3192  FORMAT( ' INDEX OUT OF RANGE USING METHOD 2. CANNOT CONTINUE!'/)
      CALL EXIT
40    TYPE 41
41    FORMAT(' INDEX OUT OF RANGE. OBSERVATION DELETED.'/)
      GO TO 1
300   CONTINUE
70    FORMAT('1',16A5)
      WRITE(6,70)(ID(I,NTI),I=1,5)
C
C      CALCULATE TOTAL AND WITHIN SS
C
      KIND=0
      MX=IMAX*JMAX*KMAX
      CT=SUM**2/N
C
      SSTOT=SSTOT-CT
C
      SUMM=0.0
      SSC=0.0
      NEM=0
      DO 91 I=1,MX
      IF(NIJK(I).EQ.0)GO TO 42
      SSC=SSC+XIJK(I)**2/NIJK(I)
      GO TO 91
42    NEM=NEM+1
91    CONTINUE
      SSC=SSC-CT
      SSABC=SSC
      SSW=SSTOT-SSC
      IF((N-MX).EQ.0)KIND=1
C
C          CALCULATE ACTUAL MARGINAL SUMS
C
      DO 900 I=1,IMAX
      DO 900 J=1,JMAX
      IJ=I+(J-1)*IMAX
      DO 900 K=1,KMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
C**** WMU-AM: #1.9.3, MOD=1, MTO, 19-OCT-77 ****
	IF(NIJK(IJK).GT.0)XXIJK(IJK)=XXIJK(IJK)-
	1				XIJK(IJK)*XIJK(IJK)/NIJK(IJK)
C**** END = MNL, #900-4 ****
      XIJ(IJ)=XIJ(IJ)+XIJK(IJK)
      NIJ(IJ)=NIJ(IJ)+NIJK(IJK)
      XI(I)=XI(I)+XIJK(IJK)
900   NI(I)=NI(I)+NIJK(IJK)
      DO 903 J=1,JMAX
      DO 903 K=1,KMAX
      JK=J+(K-1)*JMAX
      DO 903 I=1,IMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
	IF(NIJK(IJK).GT.1)XXIJK(IJK)=XXIJK(IJK)/(NIJK(IJK)-1)
      NJK(JK)=NJK(JK)+NIJK(IJK)
      XJK(JK)=XJK(JK)+XIJK(IJK)
      XJ(J)=XJ(J)+XIJK(IJK)
903   NJ(J)=NJ(J)+NIJK(IJK)
      DO 906 K=1,KMAX
      DO 906 I=1,IMAX
      IK=I+(K-1)*IMAX
      DO 906 J=1,JMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
      XIK(IK)=XIK(IK)+XIJK(IJK)
      NIK(IK)=NIK(IK)+NIJK(IJK)
      XK(K)=XK(K)+XIJK(IJK)
 906  NK(K)=NK(K)+NIJK(IJK)
      IF(IFM.EQ.'YES')CALL PRINT(IMAX,JMAX,KMAX,XI,XJ,XK,XIJ,XJK,XIK,
     1XIJK,NI,NJ,NK,NIJ,NJK,NIK,NIJK,SUM,N,INAME,JNAME,KNAME,XXIJK)
	CALL BARTLT(IMAX,JMAX,KMAX,NIJK,XXIJK,BART)
	IDEG=IMAX*JMAX*KMAX-1
	IF(BART.LT.0)GO TO 9127
C---------------CBART, IDEG INPUT AND YPROB RETURNED.
	CALL CHIPRB(BART,IDEG,YPROB)
	IF(IERR.NE.99)WRITE(6,9128)YPROB
9128	FORMAT(5X,'WITH CHI-SQUARE PROBABILITY=',T39,F5.3)
	IF(IERR.EQ.99)WRITE(6,9129)
9129	FORMAT(5X,'NO PROBABILITY CALC. DF OR BARTLETT OUTSIDE LIMITS')
9127      KON=NIJK(1)
      DO 1012 I=2,IMAX*JMAX*KMAX
      IF(NIJK(I).NE.KON)GO TO 1014
1012  CONTINUE
      GO TO 1020
C**** WMU-AM: #1.9.3, MOD=1, MTO, 19-SEP-77 ****
1014	DO 2000 I=1,IMAX
	DO 2000 J=1,JMAX
	DO 2000 K=1,KMAX
	IJK=I+(J-1+(K-1)*JMAX)*IMAX
	IF(NIJK(IJK).NE.NI(I)*NJ(J)*NK(K)/(N*N))GOTO 1018
2000	CONTINUE
	CALL PROP(IMAX,JMAX,KMAX,XI,XJ,XK,XIJ,XIK,XJK,XIJK,
	1	NI,NJ,NK,NIJ,NJK,NIK,NIJK,
	2	SSTOT,SSW,N,CT,SSC)
1018  CALL FIT(IMAX,JMAX,KMAX,XI,XJ,XK,NI,NJ,NK,XIJ,XJK,XIK,
     1NIJ,NJK,NIK,NIJK,D,DF,XD,FF,YB,A,B,C,MC,MR,SUM,SSW,N,SSTOT,NEM,
     2SSABC,INAME,JNAME,KNAME,SSINT,CT)
C**** END = MNL, #1016-2 ****
      DO 1016 I=1,IMAX*JMAX*KMAX
      IF(NIJK(I).EQ.0)GO TO 1017
1016  CONTINUE
      CALL WEIGH(IMAX,JMAX,KMAX,NIJK,XIJK,INAME,JNAME,KNAME,A,B,C,YB,XD,
     1DF,SSINT,SSTOT,SSW,N)
      WRITE(6,1021)
1021  FORMAT(///,20X,'UNWEIGHTED MEANS ANOVA')
      GO TO 1023
1020  WRITE(6,1022)
1022  FORMAT(///,20X,'ANALYSIS OF VARIANCE')
1023  CALL UNWEI(IMAX,JMAX,KMAX,XI,XJ,XK,XIJ,XJK,XIK,XIJK,NI,NJ,NK,NIJ,
     1NJK,NIK,NIJK,SSTOT,SSW,N,INAME,JNAME,KNAME)
1017  IF(NTI.NE.NTIMES)GO TO 81
      RETURN
81    REWIND 5
      GO TO 80
      END
C
C		BARTLETTS TEST FOR HOMOGENEITY
C
C---------------IMAX, JMAX, KMAX, NIJK, XXIJK ARE INPUT;  CS RETURNED
	SUBROUTINE BARTLT(IMAX,JMAX,KMAX,NIJK,XXIJK,CS)
	DIMENSION NIJK(1),XXIJK(1)
	V=0
	VI=0
	SPSQ=0
	CS=0
	WRITE(6,3)
3	FORMAT(///,2X,'BARTLETT''S TEST STATISTIC FOR TESTING ',
     1	'HOMOGENEITY OF CELL VARIANCES')
	DO 1 I=1,IMAX
	DO 1 J=1,JMAX
	DO 1 K=1,KMAX
	IJK=I+(J-1+(K-1)*JMAX)*IMAX
	IF(NIJK(IJK).LT.2)GO TO 99
	V=V+(NIJK(IJK)-1)
	VI=VI+1./(NIJK(IJK)-1)
	CS=CS+(NIJK(IJK)-1)*ALOG(XXIJK(IJK))
1	SPSQ=SPSQ+XXIJK(IJK)*(NIJK(IJK)-1)
	SPSQ=SPSQ/V
	IJKMAX=IMAX*JMAX*KMAX
	ID=IJKMAX-1
	CS=(V*ALOG(SPSQ)-CS)/(1.+(VI-1./V)/(3.*ID))
	WRITE(6,4)IJKMAX,CS,ID
4	FORMAT(/5X,'NUMBER OF CELL VARIANCES='I4,/,
     1	5X,'BARTLETT''S STATISTIC=',F12.3,5X,'DF=',I4)
	RETURN
99	WRITE(6,5)
5	FORMAT('  IS NOT POSSIBLE SINCE AT LEAST ONE SAMPLE SIZE',
     1	' IS EITHER 0 OR 1')
	CS=-1
	RETURN
	END
C
C		CUMULATIVE CHI SQUARE SUBROUTINE
C
C		SOURCE-CHARLES A. NAGY
C
C		CUMULATIVE CHI SQUARE SUBROUTINE
C
C		SOURCE-CHARLES A. NAGY
C
C          FITTING CONSTANTS
C
C**** WMU-AM: #1.9.3, MOD=1, MTO, 23-SEP-77 ****
C---------------IMAX, JMAX, KMAX, XI, XJ, XK, NI, NJ, NK, XIJ, XJK,
C---------------XIK, NIJ, NJK, NIK, NIJK, INAME, JNAME, KNAME, SSTOT, SSW,
C--------------- N, CT, NEM, SSABC ARE INPUT.  D, DF, XD, FF, YB,
C--------------- A, B, C, SSINT ARE RETURNED.  SPACE FOR MC, MR IS RESERVED
C--------------- BY ALLCOR AND USED BY MINVSQ BUT NOT NEEDED ELSEWHERE
      SUBROUTINE FIT(IMAX,JMAX,KMAX,XI,XJ,XK,NI,NJ,NK,XIJ,XJK,XIK,
     1NIJ,NJK,NIK,NIJK,D,DF,XD,FF,YB,A,B,C,MC,MR,SUM,SSW,N,SSTOT,NEM,
     2SSABC,INAME, JNAME,KNAME,SSINT,CT)
      DIMENSION XI(1),XJ(1),XK(1),NI(1),NJ(1),NK(1),XIJ(1),XJK(1),XIK(1)
      DIMENSION NIJ(1),NJK(1),NIK(1),NIJK(1),D(1),DF(1),FF(1),YB(1)
      DIMENSION XD(1),A(1),B(1),C(1),MC(1),MR(1)
C**** END = FIT, #1104-10 ****
      JM1=JMAX+1
      DO 1100 I=1,JM1
      DO 1100 J=1,JM1
      IJ=I+(J-1)*JM1
      IF(I.EQ.JM1.OR.J.EQ.JM1)GO TO 1103
      XNTL=0.0
      DO 1104 K=1,IMAX
      LM1=K+(I-1)*IMAX
      LM2=K+(J-1)*IMAX
      XNTL=XNTL+FLOAT(NIJ(LM1)*NIJ(LM2))/FLOAT(NI(K))
1104   CONTINUE
      IF(I.EQ.J)GO TO 1102
      D(IJ)=-XNTL
      GO TO 1100
1102   D(IJ)=NJ(J)-XNTL
      GO TO 1100
1103  D(IJ)=1.0
      IF(I.EQ.J)D(IJ)=0.0
1100  CONTINUE
      CALL MINVSQ(D,JM1,1.0,MC,MR,JM1,-1,2,DET,IEXP)
      DO 1105 J=1,JMAX
      XNTL=0.0
      DO 1106 I=1,IMAX
      IJ=I+(J-1)*IMAX
1106  XNTL=XNTL+FLOAT(NIJ(IJ))*XI(I)/FLOAT(NI(I))
1105  YB(J)=XNTL
      DO 1107 J=1,JMAX
      XNTL=0.0
      DO 1108 K=1,JMAX
      JK=J+(K-1)*JM1
1108  XNTL=XNTL+D(JK)*(XJ(K)-YB(K))
1107   XD(J)=XNTL
      DO 1109 J=1,JMAX
      DO 1110 K=1,KMAX
      XNTL=0.0
      JK=J+(K-1)*JMAX
      DO 1111I=1,IMAX
      IJ=I+(J-1)*IMAX
      IK=I+(K-1)*IMAX
1111  XNTL=XNTL+FLOAT(NIJ(IJ)*NIK(IK))/FLOAT(NI(I))
1110  DF(JK)=FLOAT(NJK(JK))-XNTL
1109  CONTINUE
      DO 1112 J=1,JMAX
      DO 1113 K=1,KMAX
      XNTL=0.0
      JK=J+(K-1)*JMAX
      DO 1114 L=1,JMAX
      JL=J+(L-1)*JM1
      LK=L+(K-1)*JMAX
1114  XNTL=XNTL+D(JL)*DF(LK)
1113  FF(JK)=XNTL
1112  CONTINUE
      DO 1115 K=1,KMAX
      XNTL=0.0
      DO 1116 I=1,IMAX
      IK=I+(K-1)*IMAX
1116  XNTL=XNTL+FLOAT(NIK(IK))*XI(I)/FLOAT(NI(I))
      YNTL=0.0
      DO 1117 J=1,JMAX
      JK=J+(K-1)*JMAX
1117  YNTL=YNTL+DF(JK)*XD(J)
1115  YB(K)=XK(K)-XNTL-YNTL
      KM1=KMAX+1
      DO 1118 K=1,KM1
      DO 1118 KK=1,KM1
      KKK=K+(KK-1)*KM1
      IF(K.EQ.KM1)GO TO 1119
      IF(KK.EQ.KM1)GO TO 1119
      XNTL=0.0
      DO 1120 I=1,IMAX
      IK=I+(K-1)*IMAX
      IKK=I+(KK-1)*IMAX
1120  XNTL=XNTL+FLOAT(NIK(IK)*NIK(IKK))/FLOAT(NI(I))
      YNTL=0.0
      DO 1122  J=1,JMAX
      JK=J+(K-1)*JMAX
      JKK=J+(KK-1)*JMAX
1122  YNTL=YNTL+DF(JK)*FF(JKK)
      IF(K.EQ.KK)GO TO 1121
      D(KKK)=-XNTL-YNTL
      GO TO 1118
1121  D(KKK)=NK(K)-XNTL-YNTL
      GO TO 1118
1119  D(KKK)=1.0
      IF(K.EQ.KK)D(KKK)=0.0
1118  CONTINUE
      CALL MINVSQ(D,KM1,1.0,MC,MR,KM1,-1,2,DET,IEXP)
      CTERM=0.0
      DO 1123 K=1,KMAX
      XNTL=0.0
      DO 1124 KK=1,KMAX
      KKK=K+(KK-1)*KM1
1124  XNTL=XNTL+D(KKK)*YB(KK)
      C(K)=XNTL
1123  CTERM=CTERM+C(K)*XK(K)
      BTERM=0.0
      DO 1125 J=1,JMAX
      XNTL=0.0
      DO 1126 K=1,KMAX
      JK=J+(K-1)*JMAX
1126  XNTL=XNTL+FF(JK)*C(K)
      B(J)=XD(J)-XNTL
1125  BTERM=BTERM+B(J)*XJ(J)
      ZNTL=0.0
      DO 1127 I=1,IMAX
      XNTL=0.0
      DO 1128 J=1,JMAX
      IJ=I+(J-1)*IMAX
1128  XNTL=XNTL+FLOAT(NIJ(IJ))*B(J)
      YNTL=0.0
      DO 1129 K=1,KMAX
      IK=I+(K-1)*IMAX
1129  YNTL=YNTL+FLOAT(NIK(IK))*C(K)
      A(I)=(XI(I)-XNTL-YNTL)/FLOAT(NI(I))
1127  ZNTL=ZNTL+A(I)
      XMU=ZNTL/FLOAT(IMAX)
      ATERM=0.0
      DO 1130 I=1,IMAX
1130   ATERM=ATERM+(A(I)-XMU)*XI(I)
      RABC=XMU*SUM+ATERM+BTERM+CTERM-CT
      SSINT=SSABC-RABC
      ZNTL=0.0
      DO 1140 I=1,IMAX
      XNTL=0.0
      DO 1141 J=1,JMAX
      IJ=I+(J-1)*IMAX
      XNTL=XNTL+FLOAT(NIJ(IJ))*XD(J)/FLOAT(NI(I))
1141  CONTINUE
      YB(I)=XI(I)/FLOAT(NI(I))-XNTL
      ZNTL=ZNTL+YB(I)
1140  CONTINUE
      ZNTL=ZNTL/FLOAT(IMAX)
      RAB=ZNTL*SUM-CT
      DO 1142 I=1,IMAX
      RAB=RAB+(YB(I)-ZNTL)*XI(I)
1142  CONTINUE
      DO 1143 J=1,JMAX
      RAB=RAB+XD(J)*XJ(J)
1143  CONTINUE
      RC=RABC-RAB
      KM1=KMAX+1
      DO 1144 K=1,KM1
      DO 1144 L=1,KM1
      KL=K+(L-1)*KM1
      IF(K.EQ.L)GO TO 1145
      IF(K.EQ.KM1)GO TO 1146
      IF(L.EQ.KM1)GO TO 1146
      XNTL=0.0
      DO 1147 I=1,IMAX
      IK=I+(K-1)*IMAX
      IL=I+(L-1)*IMAX
      XNTL=XNTL+FLOAT(NIK(IK)*NIK(IL))/FLOAT(NI(I))
1147  CONTINUE
      D(KL)=-XNTL
      GO TO 1144
1145  IF(K.EQ.KM1)GO TO 1245
      XNTL=0.0
      DO 1244 I=1,IMAX
      IK=I+(K-1)*IMAX
      XNTL=XNTL+FLOAT(NIK(IK))**2/FLOAT(NI(I))
1244  CONTINUE
      D(KL)=FLOAT(NK(K))-XNTL
      GO TO 1144
1245  D(KL)=0.0
      GO TO 1144
1146  D(KL)=1.0
1144  CONTINUE
      CALL MINVSQ(D,KM1,1.0,MC,MR,KM1,-1,2,DET,IEXP)
      DO 1148 K=1,KMAX
      XNTL=0.0
      DO 1149 I=1,IMAX
      IK=I+(K-1)*IMAX
      XNTL=XNTL+FLOAT(NIK(IK))*XI(I)/FLOAT(NI(I))
1149  CONTINUE
      YB(K)=XNTL
1148  CONTINUE
      DO 1150 K=1,KMAX
      XNTL=0.0
      DO 1151 KK=1,KMAX
      KKK=K+(KK-1)*KM1
      XNTL=XNTL+D(KKK)*(XK(KK)-YB(KK))
1151  CONTINUE
      XD(K)=XNTL
1150  CONTINUE
      ZNTL=0.0
      DO 1152 I=1,IMAX
      XNTL=0.0
      DO 1153 K=1,KMAX
      IK=I+(K-1)*IMAX
      XNTL=XNTL+FLOAT(NIK(IK))*XD(K)/FLOAT(NI(I))
1153  CONTINUE
      YB(I)=XI(I)/FLOAT(NI(I))-XNTL
      ZNTL=ZNTL+YB(I)
1152  CONTINUE
      ZNTL=ZNTL/FLOAT(IMAX)
      RAC=ZNTL*SUM-CT
      DO 1154 I=1,IMAX
      RAC=RAC+(YB(I)-ZNTL)*XI(I)
1154  CONTINUE
      DO 1155 K=1,KMAX
      RAC=RAC+XD(K)*XK(K)
1155  CONTINUE
      RB=RABC-RAC
      DO 1156 K=1,KM1
      DO 1157 L=1,KM1
      KL=K+(L-1)*KM1
      IF(K.EQ.L)GO TO 1158
      IF(K.EQ.KM1)GO TO 1159
      IF(L.EQ.KM1)GO TO 1159
      XNTL=0.0
      DO 1160 J=1,JMAX
      JK=J+(K-1)*JMAX
      JL=J+(L-1)*JMAX
      XNTL=XNTL+FLOAT(NJK(JK)*NJK(JL))/FLOAT(NJ(J))
1160  CONTINUE
      D(KL)=-XNTL
      GO TO 1157
1158   IF(K.EQ.KM1)GO TO 1161
      XNTL=0.0
      DO 1162 J=1,JMAX
      JK=J+(K-1)*JMAX
      XNTL=XNTL+FLOAT(NJK(JK))**2/FLOAT(NJ(J))
1162  CONTINUE
      D(KL)=FLOAT(NK(K))-XNTL
      GO TO 1157
1161  D(KL)=0.0
      GO TO 1157
1159  D(KL)=1.0
1157  CONTINUE
1156  CONTINUE
      CALL MINVSQ(D,KM1,1.0,MC,MR,KM1,-1,2,DET,IEXP)
      DO 1163 K=1,KMAX
      XNTL=0.0
      DO 1164 J=1,JMAX
      JK=J+(K-1)*JMAX
      XNTL=XNTL+FLOAT(NJK(JK))*XJ(J)/FLOAT(NJ(J))
1164  CONTINUE
      YB(K)=XNTL
1163  CONTINUE
      DO 1165 K=1,KMAX
      XNTL=0.0
      DO 1166 L=1,KMAX
      KL=K+(L-1)*KM1
      XNTL=XNTL+D(KL)*(XK(L)-YB(L))
1166  CONTINUE
      XD(K)=XNTL
1165  CONTINUE
      ZNTL=0.0
      DO 1167 J=1,JMAX
      XNTL=0.0
      DO 1168 K=1,KMAX
      JK=J+(K-1)*JMAX
      XNTL=XNTL+FLOAT(NJK(JK))*XD(K)/FLOAT(NJ(J))
 1168 CONTINUE
      YB(J)=XJ(J)/FLOAT(NJ(J))-XNTL
      ZNTL=ZNTL+YB(J)
1167  CONTINUE
      ZNTL=ZNTL/FLOAT(JMAX)
      RBC=ZNTL*SUM-CT
      DO 1171 J=1,JMAX
      RBC=RBC+(YB(J)-ZNTL)*XJ(J)
1171  CONTINUE
      DO 1169 K=1,KMAX
      RBC=RBC+XD(K)*XK(K)
1169  CONTINUE
      RA=RABC-RBC
      WRITE(6,100)
100   FORMAT(///,17X,'PRELIMINARY ANOVA - FITTING CONSTANTS')
      WRITE(6,101)
101   FORMAT(/5X,'SOURCE',5X,'SUM OF SQUARES',3X,'DF',4X,'MEAN SQUARE',
     14X,'F',4X,'PROB')
      IDF=IMAX*JMAX*KMAX-1
C**** WMU-AM: #1.9.3, MOD=1, MTO, 19-SEP-77 ****
	DO 201 I=1,IMAX
	DO 201 J=1,JMAX
	DO 201 K=1,KMAX
	IJK=I+(J-1+(K-1)*JMAX)*IMAX
201	IF(NIJK(IJK).EQ.0) IDF=IDF-1
C**** WMU-AM: #1.9.3, MOD=1, MTO, 7-OCT-77 ****
	XMS=SSABC/FLOAT(IDF)
	KDF=(IMAX*JMAX*KMAX-1)-IDF
C**** END = FIT, #202-6 ****
	IDW=N-IDF-1
	IF(IDF.GT.0.AND.IDW.GT.0) GOTO 202
	TYPE 2001
2001	FORMAT (' NOT ENOUGH DATA TO CARRY OUT AN ANOVA.')
	WRITE (6,2001)
	RETURN
202   SMW=SSW/FLOAT(IDW)
C**** END = FIT, #102-3 ****
      F=XMS/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,102)SSABC,IDF,XMS,F,PROB
102   FORMAT(/5X,'SUBCLASS',2X,F15.2,I5,F15.2,F7.2,F6.3)
      IDF=IMAX+JMAX+KMAX-3
      WRITE(6,103)RABC,IDF
103   FORMAT(/3X,'MAIN EFFECTS',F15.2,I5)
      IDF=IMAX*JMAX*KMAX-IMAX-JMAX-KMAX+2-NEM
C**** WMU-AM: #1.9.3, MOD=1, MTO, 10-OCT-77 ****
	IF(IDF.GT.0) GOTO 204
	WRITE(6,2002)
2002	FORMAT (' TOO MANY MISSING CELLS TO OBTAIN AN INTER-'/
	1	' ACTION TEST.'//)
	GOTO 205
204   XMS=SSINT/FLOAT(IDF)
      F=XMS/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,104)SSINT,IDF,XMS,F,PROB
104   FORMAT(/4X'INTERACTION',F15.2,I5,F15.2,F7.2,F6.3)
205   WRITE(6,105)SSW,IDW,SMW
C**** END = FIT, #105-1 ****
105   FORMAT(/6X,'WITHIN',3X,F15.2,I5,F15.2)
      IDF=N-1
      WRITE(6,106)SSTOT,IDF
106   FORMAT(/6X,'TOTAL',4X,F15.2,I5)
      WRITE(6,107)
107   FORMAT(///,20X,'FINAL ANOVA - FITTING CONSTANTS')
      WRITE(6,108)
108   FORMAT(/7X,'SOURCE',8X,'SUM OF SQUARES    DF   MEAN SQUARE     F'
     13X,'PROB')
      IDT=IMAX+JMAX+KMAX-3
      WRITE(6,109)RABC,IDT
109   FORMAT(//4X,'MAIN EFFECTS',4X,F15.2,I5)
      IDF=IDT-(IMAX-1)
      WRITE(6,110)JNAME,KNAME,INAME,RBC,IDF
110   FORMAT(//1X,A1,' & ',A1,' IGNORING ',A1,3X,F15.2,I5)
      IDF=IMAX-1
      XMS=RA/FLOAT(IDF)
      F=XMS/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,111)INAME,JNAME,KNAME,RA,IDF,XMS,F,PROB
111   FORMAT(/1X,A1,' ELIMINATING ',A1,' & ',A1,F15.2,
	1	I5,F15.2,F7.2,F6.3)
      IDF=IDT-(JMAX-1)
      WRITE(6,110)INAME,KNAME,JNAME,RAC,IDF
      IDF=JMAX-1
      XMS=RB/FLOAT(IDF)
      F=XMS/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,111)JNAME,INAME,KNAME,RB,IDF,XMS,F,PROB
      IDF=IDT-(KMAX-1)
      WRITE(6,110)INAME,JNAME,KNAME,RAB,IDF
      IDF=KMAX-1
      XMS=RC/FLOAT(IDF)
      F=XMS/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,111)KNAME,INAME,JNAME,RC,IDF,XMS,F,PROB
      WRITE(6,112)SSW,IDW,SMW
112   FORMAT(//7X,'WITHIN',7X,F15.2,I5,F15.2)
      RETURN
      END
C
C            PRINT OUT MEANS
C
C---------------ALL ARGUMENTS ARE INPUT.
      SUBROUTINE PRINT(IMAX,JMAX,KMAX,XI,XJ,XK,XIJ,XJK,XIK,XIJK,NI,
     1NJ,NK,NIJ,NJK,NIK,NIJK,SUM,N,INAME,JNAME,KNAME,XXIJK)
      DIMENSION XI(1),XJ(1),XK(1),XIJ(1),XJK(1),XIK(1),XIJK(1),NI(1)
     1,NJ(1),NK(1),NIJ(1),NJK(1),NIK(1),NIJK(1),XXIJK(1)
311   GMEAN=SUM/FLOAT(N)
      WRITE(6,601)INAME,JNAME ,KNAME
601   FORMAT(///,10X,A1,3X,A1,3X,A1,6X,'MEAN',13X,'STD DEV',5X,'N'/)
      DO 602 I=1,IMAX
      DO 602 J=1,JMAX
      DO 602 K=1,KMAX
      IND=I+(J-1+(K-1)*JMAX)*IMAX
      IF(NIJK(IND).EQ.0)GO TO 667
	STDV=SQRT(XXIJK(IND))
      XX=XIJK(IND)/FLOAT(NIJK(IND))
      WRITE(6,603)I,J,K,XX,STDV,NIJK(IND)
603   FORMAT(9X,I3,1X,I3,1X,I3,G,F15.7,I5)
      GO TO 602
667   WRITE(6,668)I,J,K,NIJK(IND)
668   FORMAT(9X,I3,1X,I3,1X,I3,30X,I5)
602   CONTINUE
      DO 604 I=1,IMAX
      DO 604 J=1,JMAX
      IND=I+(J-1)*IMAX
      XX=XIJ(IND)/FLOAT(NIJ(IND))
604   WRITE(6,605)I,J,XX,NIJ(IND)
605   FORMAT(9X,I3,1X,I3,1X,'  .',G,15X,I5)
      DO 606 I=1,IMAX
      DO 606 K=1,KMAX
      IND=I+(K-1)*IMAX
      XX=XIK(IND)/FLOAT(NIK(IND))
606   WRITE(6,607)I,K,XX,NIK(IND)
607   FORMAT(9X,I3,1X,'  .',1X,I3,G,15X,I5)
      DO 608 J=1,JMAX
      DO 608 K=1,KMAX
      IND=J+(K-1)*JMAX
      XX=XJK(IND)/FLOAT(NJK(IND))
608   WRITE(6,609)J,K,XX,NJK(IND)
609   FORMAT(9X,'  .',1X,I3,1X,I3,G,15X,I5)
      DO 610 I=1,IMAX
      XX=XI(I)/FLOAT(NI(I))
610   WRITE(6,611)I,XX,NI(I)
611   FORMAT(9X,I3,1X,'  .',1X,'  .',G,15X,I5)
      DO 612 J=1,JMAX
      XX=XJ(J)/FLOAT(NJ(J))
612   WRITE(6,613)J,XX,NJ(J)
613   FORMAT(9X,'  .',1X,I3,1X,'  .',G,15X,I5)
      DO 614 K=1,KMAX
      XX=XK(K)/FLOAT(NK(K))
614   WRITE(6,615)K,XX,NK(K)
615   FORMAT(9X,'  .',1X,'  .',1X,I3,G,15X,I5)
      WRITE(6,616)GMEAN,N
616   FORMAT(9X,'  .',1X,'  .',1X,'  .',G,15X,I5)
      RETURN
      END
C
C           WEIGHTED MEANS ANALYSIS
C
C---------------YS, XN1, XN2, XN3, YT, YR ARE RETURNED OTHER ARGS.
C--------------- ARE INPUT.
      SUBROUTINE WEIGH(IMAX,JMAX,KMAX,NIJK,XIJK,INAME,JNAME,KNAME,
     1XN1,XN2,XN3,YR,YS,YT,SSINT,SSTOT,SE,N)
      DIMENSION NIJK(1),XIJK(1),XN1(1),XN2(1),XN3(1),YR(1),YS(1),YT(1)
      XN=0.0
      XD=0.0
      DO 1 I=1,IMAX
      XNTL=0.0
      ZNTL=0.0
      DO 2 J=1,JMAX
      DO 3 K=1,KMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
      XNTL=XNTL+1.0/FLOAT(NIJK(IJK))
      ZNTL=ZNTL+XIJK(IJK)/NIJK(IJK)
3     CONTINUE
2     CONTINUE
      XN1(I)=FLOAT(JMAX*JMAX*KMAX*KMAX)/XNTL
      YR(I)=ZNTL/FLOAT(JMAX*KMAX)
      XN=XN+XN1(I)*YR(I)
      XD=XD+XN1(I)
1     CONTINUE
      CCR=XN/XD
      XN=0.0
      XD=0.0
      DO 4 J=1,JMAX
      ZNTL=0.0
      XNTL=0.0
      DO 5 I=1,IMAX
      DO 6 K=1,KMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
      XNTL=XNTL+1.0/FLOAT(NIJK(IJK))
      ZNTL=ZNTL+XIJK(IJK)/FLOAT(NIJK(IJK))
 6    CONTINUE
5     CONTINUE
      XN2(J)=FLOAT(IMAX*IMAX*KMAX*KMAX)/XNTL
      YS(J)=ZNTL/FLOAT(IMAX*KMAX)
      XN=XN+XN2(J)*YS(J)
      XD=XD+XN2(J)
4     CONTINUE
      CCS=XN/XD
      XN=0.0
      XD=0.0
      DO 7 K=1,KMAX
      ZNTL=0.0
      XNTL=0.0
      DO 8 I=1,IMAX
      DO 9 J=1,JMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
      XNTL=XNTL+1.0/FLOAT(NIJK(IJK))
      ZNTL=ZNTL+XIJK(IJK)/FLOAT(NIJK(IJK))
9     CONTINUE
8      CONTINUE
      XN3(K)=FLOAT(IMAX*IMAX*JMAX*JMAX)/XNTL
      YT(K)=ZNTL/FLOAT(IMAX*JMAX)
      XN=XN+XN3(K)*YT(K)
      XD=XD+XN3(K)
7     CONTINUE
      CCT=XN/XD
      SSR=0.0
      DO 10 I=1,IMAX
10    SSR=SSR+XN1(I)*((YR(I)-CCR)**2)
      SSS=0.0
      DO 11 J=1,JMAX
11    SSS=SSS+XN2(J)*((YS(J)-CCS)**2)
      SST=0.0
      DO 12 K=1,KMAX
12    SST=SST+XN3(K)*((YT(K)-CCT)**2)
      WRITE(6,100)
100   FORMAT(///,22X,'THREE WAY WEIGHTED MEANS ANOVA')
      WRITE(6,101)
101   FORMAT(/4X,'SOURCE',9X,'SUM OF SQUARES  DF',4X,'MEAN SQUARE',5X,
     1'F   PROB')
      IDF=IMAX-1
      XMS=SSR/FLOAT(IDF)
      IDW=N-IMAX*JMAX*KMAX
      SMW=SE/FLOAT(IDW)
      F=XMS/SMW
      PROB=FISHER (IDF,IDW,F)
      WRITE(6,102)INAME,SSR,IDF,XMS,F,PROB
102   FORMAT(/6X,A1,10X,F15.2,I5,F15.2,F7.2,F6.3)
      IDF=JMAX-1
      XMS=SSS/FLOAT(IDF)
      F=XMS/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,102)JNAME,SSS,IDF,XMS,F,PROB
      IDF=KMAX-1
      XMS=SST/FLOAT(IDF)
      F=XMS/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,102)KNAME,SST,IDF,XMS,F,PROB
      IDF=IMAX*JMAX*KMAX-IMAX-JMAX-KMAX+2
      XMS=SSINT/FLOAT(IDF)
      F=XMS/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,103)SSINT,IDF,XMS,F,PROB
103   FORMAT(/3X,'INTERACTION',3X,F15.2,I5,F15.2,F7.2,F6.3)
      WRITE(6,104)SE,IDW,SMW
104   FORMAT(/5X,'WITHIN',6X,F15.2,I5,F15.2)
      IDF=N-1
      WRITE(6,105)SSTOT,IDF
105   FORMAT(/5X,'TOTAL',7X,F15.2,I5)
      RETURN
      END
C
C     UNWEIGHTED MEANS ANALYSIS
C
C---------------XI, XJ, XK, XIJ, XJK, XIK ARE MODIFIED.  OTHER
C--------------- ARGS. ARE INPUT WITHOUT MODIFICATION.
      SUBROUTINE UNWEI(IMAX,JMAX,KMAX,XI,XJ,XK,XIJ,XJK,XIK,XIJK,
     1NI,NJ,NK,NIJ,NJK,NIK,NIJK,SSTOT,SSW,N,INAME,JNAME,KNAME)
      DIMENSION XI(1),XJ(1),XK(1),XIJ(1),XJK(1),XIK(1),XIJK(1),NI(1),
     1NJ(1),NK(1),NIJ(1),NJK(1),NIK(1),NIJK(1)
      MX=IMAX*JMAX*KMAX
      XN=0.0
      DO 100 I=1,MX
      XN=XN+1.0/FLOAT(NIJK(I))
100   XIJK(I)=XIJK(I)/FLOAT(NIJK(I))
      XN=XN/FLOAT(MX)
      KIND=0
      IF(N.EQ.MX)KIND=1
      SUM=0.0
      DO 309 I=1,MX
309   SUM=SUM+XIJK(I)
      CTT=SUM**2/MX
C
C      REINITIALIZE CERTAIN VALUES
C
      DO 909 I=1,IMAX
909   XI(I)=0.0
      DO 910 J=1,JMAX
910   XJ(J)=0.0
      DO 911 K=1,KMAX
911   XK(K)=0.0
      DO 912 I=1,IMAX*JMAX
912   XIJ(I)=0.0
      DO 913 I=1,JMAX*KMAX
913   XJK(I)=0.0
      DO 914 I=1,IMAX*KMAX
914   XIK(I)=0.0
      SSI=0.0
      SSJ=0.0
      SSK=0.0
      SSIJ=0.0
      SSIK=0.0
      SSJK=0.0
      SSIJK=0.0
C
C     CALCULATE MARGINAL SUMS
C
      DO 301 I=1,IMAX
      DO 301 J=1,JMAX
      IJ=I+(J-1)*IMAX
      DO 302 K=1,KMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
      XIJ(IJ)=XIJ(IJ)+XIJK(IJK)
302   XI(I)=XI(I)+XIJK(IJK)
301   CONTINUE
      DO 303 J=1,JMAX
      DO 304 K=1,KMAX
      JK=J+(K-1)*JMAX
      DO 305 I=1,IMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
      XJK(JK)=XJK(JK)+XIJK(IJK)
305   XJ(J)=XJ(J)+XIJK(IJK)
304   CONTINUE
303   CONTINUE
      DO 306 K=1,KMAX
      DO 307 I=1,IMAX
      IK=I+(K-1)*IMAX
      DO 308 J=1,JMAX
      IJK=I+(J-1+(K-1)*JMAX)*IMAX
      XIK(IK)=XIK(IK)+XIJK(IJK)
308   XK(K)=XK(K)+XIJK(IJK)
307   CONTINUE
306   CONTINUE
C
C     COMPUTE MAIN EFFECTS AND INTERACTIONS
C
      SSC=0.0
      DO 500 I=1,MX
500   SSC=SSC+XIJK(I)**2
      MX=IMAX*JMAX
      DO 501 I=1,MX
501   SSIJ=SSIJ+XIJ(I)**2
      MX=JMAX*KMAX
      DO 502 I=1,MX
502   SSJK=SSJK+XJK(I)**2
      MX=IMAX*KMAX
      DO 503 I=1,MX
503   SSIK=SSIK+XIK(I)**2
      DO 504 I=1,IMAX
504   SSI=SSI+XI(I)**2
      DO 505 I=1,JMAX
505   SSJ=SSJ+XJ(I)**2
      DO 506 I=1,KMAX
506   SSK=SSK+XK(I)**2
      XN=1.0/XN
      SSC=(SSC-CTT)*XN
      SSI=(SSI/FLOAT(JMAX*KMAX)-CTT)*XN
      SSJ=(SSJ/FLOAT(IMAX*KMAX)-CTT)*XN
      SSK=(SSK/FLOAT(IMAX*JMAX)-CTT)*XN
      SSIJ=(SSIJ/FLOAT(KMAX)-CTT)*XN-SSI-SSJ
      SSJK=(SSJK/FLOAT(IMAX)-CTT)*XN-SSJ-SSK
      SSIK=(SSIK/FLOAT(JMAX)-CTT)*XN-SSI-SSK
      SSIJK=SSC-SSI-SSJ-SSK-SSIJ-SSIK-SSJK
C
C      CALCULATE AND PRINT ANOVA
C
      WRITE(6,700)XN
700   FORMAT(/20X,'H.M. CELL SIZE = ',F10.5)
      IDW=N-IMAX*JMAX*KMAX
      IF(KIND.EQ.1)IDW=(IMAX-1)*(JMAX-1)*(KMAX-1)
      SS=SSW
      IF(KIND.EQ.1)SS=SSIJK
      SMW=SS/FLOAT(IDW)
      WRITE(6,702)
702   FORMAT(/7X,'SOURCE',4X,'SUM OF SQUARES',4X,'DF',3X,'MEAN SQUARE',7
     1X'F',5X,'PROB')
      IDF=IMAX*JMAX*KMAX-1
      SM=SSC/FLOAT(IDF)
      F=SM/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,703)SSC,IDF,SM,F,PROB
703   FORMAT(/4X,'SUBCLASSES',2X,F15.2,I6,F15.2,F9.3,F8.3)
      IDF=IMAX-1
      SM=SSI/FLOAT(IDF)
      F=SM/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,704)INAME,SSI,IDF,SM,F,PROB
 704  FORMAT(/8X,A1,7X,F15.2,I6,F15.2,F9.3,F8.3)
      IDF=JMAX-1
      SM=SSJ/FLOAT(IDF)
      F=SM/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,704)JNAME,SSJ,IDF,SM,F,PROB
      IDF=KMAX-1
      SM=SSK/FLOAT(IDF)
      F=SM/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,704)KNAME,SSK,IDF,SM,F,PROB
      IDF=(IMAX-1)*(JMAX-1)
      SM=SSIJ/FLOAT(IDF)
      F=SM/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,705)INAME,JNAME,SSIJ,IDF,SM,F,PROB
705   FORMAT(/8X,2A1,6X,F15.2,I6,F15.2,F9.3,F8.3)
      IDF=(IMAX-1)*(KMAX-1)
      SM=SSIK/FLOAT(IDF)
      F=SM/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,705)INAME,KNAME,SSIK,IDF,SM,F,PROB
      IDF=(JMAX-1)*(KMAX-1)
      SM=SSJK/FLOAT(IDF)
      F=SM/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,705)JNAME,KNAME,SSJK,IDF,SM,F,PROB
      IF(KIND.EQ.1)GO TO 710
      IDF=(IMAX-1)*(JMAX-1)*(KMAX-1)
      SM=SSIJK/FLOAT(IDF)
      F=SM/SMW
      PROB=FISHER(IDF,IDW,F)
      WRITE(6,706)INAME,JNAME,KNAME,SSIJK,IDF,SM,F,PROB
706    FORMAT(/8X,3A1,5X,F15.2,I6,F15.2,F9.3,F8.3)
      WRITE(6,707)SSW,IDW,SMW
707   FORMAT(/6X,'WITHIN',4X,F15.2,I6,F15.2)
      GO TO 711
710   WRITE(6,706)INAME,JNAME,KNAME,SSIJK,IDW,SMW
711   RETURN
      END
C**** WMU-AM: #1.9.3, MOD=1, MTO, 23-SEP-77 ****
C
C
C	PROPORTIONAL ANALYSIS
C	(WRITTEN BY DR. MICHAEL R. STOLINE, WMU, SEP-77)
C
C
C---------------ALL ARGS. ARE INPUT.
	SUBROUTINE PROP(IMAX,JMAX,KMAX,XI,XJ,XK,XIJ,XIK,XJK,
	1	XIJK,NI,NJ,NK,NIJ,NJK,NIK,NIJK,SSTOT,SSW,N,CT,SSC)
	DIMENSION XI(1),XJ(1),XK(1),XIJ(1),XIK(1),XJK(1),XIJK(1),
	1	NI(1),NJ(1),NK(1),NIJ(1),NJK(1),NIK(1),NIJK(1)
	SSI=0.
	SSJ=0.
	SSK=0.
	SSIJ=0.
	SSIK=0.
	SSJK=0.
	SSIJK=0.
	DO 1 I=1,IMAX
1	SSI=SSI+(XI(I)**2.)/NI(I)
	SSI=SSI-CT
	DO 2 J=1,JMAX
2	SSJ=SSJ+(XJ(J)**2.)/NJ(J)
	SSJ=SSJ-CT
	DO 3 K=1,KMAX
3	SSK=SSK+(XK(K)**2.)/NK(K)
	SSK=SSK-CT
	DO 4 I=1,IMAX
	DO 4 J=1,JMAX
	IJ=I+(J-1)*IMAX
4	SSIJ=SSIJ+(XIJ(IJ)**2.)/NIJ(IJ)
	DO 5 I=1,IMAX
	DO 5 K=1,KMAX
	IK=I+(K-1)*IMAX
5	SSIK=SSIK+(XIK(IK)**2.)/NIK(IK)
	DO 6 J=1,JMAX
	DO 6 K=1,KMAX
	JK=J+(K-1)*JMAX
6	SSJK=SSJK+(XJK(JK)**2.)/NJK(JK)
	SSIJ=SSIJ-CT
	SSIK=SSIK-CT
	SSJK=SSJK-CT
	SSIJ=SSIJ-SSI-SSJ
	SSIK=SSIK-SSI-SSK
	SSJK=SSJK-SSJ-SSK
	SSIJK=SSC-SSI-SSJ-SSK-SSIJ-SSIK-SSJK
	IDF=IMAX-1
	JDF=JMAX-1
	KDF=KMAX-1
	IJDF=IDF*JDF
	IKDF=IDF*KDF
	JKDF=JDF*KDF
	IJKDF=IJDF*KDF
	MSDF=N-IMAX*JMAX*KMAX
	NM1=N-1
	WRITE(6,101)
	WRITE(6,102)SSI,IDF,SSJ,JDF,SSK,KDF,SSIJ,IJDF,SSIK,IKDF,
	1	SSJK,JKDF,SSIJK,IJKDF,SSW,MSDF,SSTOT,NM1
101	FORMAT(/'0    THE SAMPLE SIZES ARE PROPORTIONAL.  THE SUMS'/
	1	' OF SQUARES ARE DECOMPOSABLE INTO MAIN EFFECTS SUMS'/
	1	' OF SQUARES AND INTERACTION SUMS OF SQUARES, AS IN'/
	1	' THE BALANCED CASE.  HOWEVER, THE USUAL F-TESTS ARE'/
	1	' NOT VALID IN THE PROPORTIONAL CASE, SO THESE TESTS'/
	1	' ARE NOT GIVEN IN THE PROPORTIONAL AOV TABLE.  A COM-'/
	1	' PLICATED EXACT ANALYSIS FOR PROPORTIONAL CASES IS'/
	1	' DESCRIBED IN BANCROFT, BUT IS NOT GIVEN HERE.'/
	1	'     A SUITABLE APPROXIMATE ANALYSIS FOR PROPORTIONAL'/
	1	' CASES IS THE LEAST SQUARES(FITTING CONSTANTS) METHOD'/
	1	' GIVEN HERE.'///
	1	20X,'PROPORTIONAL AOV TABLE'///
	1	' SOURCE',T15,'SUM OF SQUARES',T35,'DEGREES OF FREEDOM'/
	1	' ------',T15,'--------------',T35,'------------------')
102	FORMAT ('   A',T15,F11.3,T35,I11/
	1	'   B',T15,F11.3,T35,I11/
	1	'   C',T15,F11.3,T35,I11/
	1	'   AB',T15,F11.3,T35,I11/
	1	'   AC',T15,F11.3,T35,I11/
	1	'   BC',T15,F11.3,T35,I11/
	1	'   ABC',T15,F11.3,T35,I11/
	1	'   WITHIN',T15,F11.3,T35,I11/
	1	1X,51('-')/
	1	'   TOTAL',T15,F11.3,T35,I11//)

C**** END = PROP, NEW-ROUTINE ****

	END