Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - 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