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