Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/rmaov/rmaov.for
There is 1 other file named rmaov.for in the archive. Click here to see a list.
C WESTERN MICHIGAN UNIVERSITY
C RMAOV.F4 (FILENAME ON LIBRARY DECTAPE)
C RMAOV, 1.9.4 (CALLING NAME, SUBLST #)
C ANALYSIS OF VARIANCE WITH REPEATED MEASURES (1 AND 2 WAY)
C PROGRAMMED BY SAM ANEMA AT WMU
C STATISTICAL CONSULTANT - DR. M. STOLINE, ALSO SEE WINER
C PAGE 306.
C FORWMU PROGRAMS USED: TTYPTY, DEVCHG, EXISTS, PRINTS
C APLIB PROGRAMS USED: GETFOR, IO, FISHER
C LIBRARY DECTAPE PROGS. USED: USAGE.MAC
C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
C---------------BD--UPPER BOUNDS ON BREAKDOWN VAR., N- # OF
C--------------- SUBJ. IN EACH GROUP. AB(30,30)-FIRST 30 IS # OF LEVELS ON
C--------------- NON-REPEATED FACTOR, SECOND 30 IS # OF REP. MEASURES INCLUDING
C--------------- BREAKDOWN VAR.
C---------------X(30) - 30 IS # OF REP. MEASURES INCLUDING BREAKDOWN VAR.
C---------------FMT(32) 160 CHARS. ALLOWED FOR OBJ; TIME FMT.
C---------------A(30) - 30 IS # OF LEVELS ON NON-REPEATED FACTOR.
C---------------B(30) - 30 IS # OF LEVELS ON REPEATED FACTOR
C--------------- INCLUDING BREAKDOWN VAR.
C---------------ID(10) LIMITS USER SPECIFIED HEADING FOR OUTPUT TO
C---------------50 CH.
C---------------INAME NOT FOUND IN PROG.
DIMENSION X(30),A(30),B(30),AB(30,30),ID(10),FMT(32),BD(30)
DIMENSION N(30),INAME(2)
TYPE 571
571 FORMAT('1---WMU REPEATED MEASURE ANOVA'///)
C CALL USAGE('RM')
C---------------TTYPTY RETURNS ZERO--TTY JOB, MINUS ONE--BATCH JOB
CALL TTYPTY(ICODE)
C---------------IDCE, IDV ARE RETURNED. OTHER ARGS. ARE INPUT,
C--------------- 1 MEANS OUTPUT? PRINTS. 0 - INPUT? PRINTS.
CALL IO(2,IDCE,-1,-4,1,ICODE)
572 CALL IO(3,IDV,-1,-4,0,ICODE)
C---------------IFMT, ISTD ARE RETURNED. OTHER ARGS ARE INPUT 32=NO.
C--------------- OF OBJ.TIME FORMAT WORDS (2 LINES).
C--------------- 2 MEANS F-TYPE FORMAT ONLY.
CALL GETFOR(-1,-4,FMT,ISTD,32,2)
TYPE 573
573 FORMAT(' ENTER IDENTIFICATION'/)
1 ACCEPT 10,ID
10 FORMAT(16A5)
TYPE 991
991 FORMAT(' ENTER NO OF LEVELS IN THE REPEATED FACTOR'/)
ACCEPT 11,IQ
11 FORMAT(12I)
IF(ISTD.EQ.1)FMT(1)='(10F)'
TYPE 574
574 FORMAT(' WOULD YOU LIKE TO USE A BREAKDOWN VARIABLE?'/)
ACCEPT 575 ,IY
575 FORMAT(A3)
IF(IY.EQ.'YES')GO TO 579
IT=2
TYPE 516
516 FORMAT(' ENTER THE NUMBER OF SUBJECTS IN EACH GROUP'/)
ACCEPT 577,N
577 FORMAT(30I)
GO TO 580
579 TYPE 13
13 FORMAT(' ENTER BREAKDOWN VARIABLE NUMBER'/)
ACCEPT 12,M
TYPE 581
581 FORMAT(' ENTER UPPER BOUNDS ON THE BREAKDOWN VARIABLE'/)
ACCEPT 582,BD
582 FORMAT(30F)
12 FORMAT(I)
IT=1
C
C INITIALIZE
C
DO 928 I=1,30
928 N(I)=0
580 F1=0.0
F2=0.0
F3=0.0
F4=0.0
F5=0.0
F6=0.0
G=0.0
NN=0
DO 20 I=1,30
A(I)=0.0
DO 21 J=1,IQ
21 AB(I,J)=0.0
20 CONTINUE
IP=0
XN=-1.0E36
IMAX=-10
DO 23 I=1,IQ
23 B(I)=0.0
P=0.0
C
C READ AND SUM
C
IF(IDV.EQ.'TTY')TYPE 918
918 FORMAT(' ENTER DATA.'/)
IF(IDV.NE.'TTY')TYPE 919
919 FORMAT(' YOUR DATA IS BEING READ'/)
GO TO (250,762),IT
C---------------READ DATA WHERE # OF SUBJ. IN EACH GROUP SPEC.
C--------------- BY BOUNDS.
250 READ(3,FMT,END=270)(X(I),I=1,IQ+1)
DO 763 I=1,30
IF(X(M).LE.BD(I))GO TO 764
763 CONTINUE
764 IP=I
IF(IP.GT.IMAX)IMAX=IP
T=0.0
J=0
DO 14 I=1,IQ+1
C---------------M IS BREAKDOWN VAR #.
IF(I.EQ.M)GO TO 14
J=J+1
XX=X(I)
B(J)=B(J)+XX
A(IP)=A(IP)+XX
AB(IP,J)=AB(IP,J)+XX
T=T+XX
G=G+XX
F2=F2+XX*XX
14 CONTINUE
P=P+T**2
N(IP)=N(IP)+1
NN=NN+1
GO TO 250
270 IP=IMAX
GO TO 770
762 DO 765 I=30,1,-1
IF(N(I).NE.0)GO TO 766
765 CONTINUE
766 IP=I
C---------------READ DATA WHERE # OF SUBJECTS IN EACH GROUP PREV.
C--------------- SPEC.
DO 767 I=1,IP
DO 768 J=1,N(I)
READ(3,FMT)(X(K),K=1,IQ)
T=0.0
DO 769 K=1,IQ
XX=X(K)
B(K)=B(K)+XX
A(I)=A(I)+XX
AB(I,K)=AB(I,K)+XX
T=T+XX
G=G+XX
F2=F2+XX*XX
769 CONTINUE
P=P+T**2
NN=NN+1
768 CONTINUE
767 CONTINUE
770 F1=G**2/FLOAT(NN*IQ)
DO 31 I=1,IP
F3=F3+(A(I)**2/FLOAT(N(I)*IQ))
DO 32 J=1,IQ
F5=F5+(AB(I,J)**2/FLOAT(N(I)))
AB(I,J)=AB(I,J)/FLOAT(N(I))
32 CONTINUE
31 CONTINUE
F6=P/FLOAT(IQ)
DO 34 I=1,IQ
34 F4=F4+(B(I)**2/FLOAT(NN))
C
C SET UP ANOVA
C
NW=2
IF(IP.EQ.1)NW=1
WRITE(2,100)ID
100 FORMAT('1',16A5)
WRITE(2,872)(I,I=1,IQ)
872 FORMAT(///35X,'MEANS'/1X,'FACTOR',25X,'FACTOR B'/3X,'A',2X,'SIZE',
1I8,5I10/(8X,6I10))
DO 873 I=1,IP
873 WRITE(2,874)I,N(I),(AB(I,J),J=1,IQ)
874 FORMAT(I4,I6,1X,6F10.3/(11X,6F10.3))
WRITE(2,101)NW
101 FORMAT(///17X,I1,' - WAY REPEATED MEASURE ANOVA'//10X,
1'SOURCE',21X,'SS',6X,'DF',5X,'MS',8X,'F',5X,'PROB')
SS=F6-F1
NDF=NN-1
SMS=SS/FLOAT(NDF)
NDF1=NN-IP
SME1=(F6-F3)/FLOAT(NDF1)
NDF2=(NN-IP)*(IQ-1)
SME2=(F2-F5-F6+F3)/FLOAT(NDF2)
WRITE(2,102)SS,NDF,SMS
102 FORMAT(/6X,'BETWEEN SUBJECTS - - -',F13.4,I5,F11.4)
IF(IP.EQ.1)GO TO 262
SS=F3-F1
NDF=IP-1
SMS=SS/FLOAT(NDF)
F=SMS/SME1
PROB=FISHER(NDF,NDF1,F)
WRITE(2,103)SS,NDF,SMS,F,PROB
103 FORMAT(12X,'A',8(' -'),F13.4,I5,F11.4,F8.3,F6.3)
262 SS=F6-F3
IF(IP.EQ.1)GO TO 146
WRITE(2,104)SS,NDF1,SME1
104 FORMAT(3X,'SUBJECTS WITHIN GROUPS - -',F13.4,I5,F11.4)
146 SS=F2-F6
NDF=NN*(IQ-1)
SMS=SS/FLOAT(NDF)
WRITE(2,105)SS,NDF,SMS
105 FORMAT(7X,'WITHIN SUBJECTS - - -',F13.4,I5,F11.4)
SS=F4-F1
NDF=IQ-1
SMS=SS/FLOAT(NDF)
F=SMS/SME2
PROB=FISHER(NDF,NDF2,F)
WRITE(2,106)SS,NDF,SMS,F,PROB
106 FORMAT(12X,'B',8(' -'),F13.4,I5,F11.4,F8.3,F6.3)
IF(IP.EQ.1)GO TO 263
SS=F5-F3-F4+F1
NDF=(IP-1)*(IQ-1)
SMS=SS/FLOAT(NDF)
F=SMS/SME2
PROB=FISHER(NDF,NDF2,F)
WRITE(2,107)SS,NDF,SMS,F,PROB
107 FORMAT(11X,'AB',8(' -'),F13.4,I5,F11.4,F8.3,F6.3)
263 SS=F2-F5-F6+F3
IF(IP.EQ.1)GO TO 148
WRITE(2,108)SS,NDF2,SME2
108 FORMAT(1X,'B X SUBJECTS WITHIN GROUPS -',F13.4,I5,F11.4)
GO TO 152
148 WRITE(2,154)SS,NDF2,SME2
154 FORMAT(8X,'RESIDUAL - - - - - -',F13.4,I5,F11.4)
152 SS=F2-F1
NDF=NN*IQ-1
WRITE(2,109)SS,NDF
109 FORMAT(10X,'TOTAL',7(' -'),F13.4,I5)
GO TO 572
CALL EXIT
END