Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
CID BMD08V
C ANALYSIS OF VARIANCE MARCH 1, 1966
C THIS IS A SIFTED VERSION OF BMD08V ORIGINALLY WRITTEN IN
C FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
C
C *** NOTE - APRIL 1976 ***
C THIS CHANGE CONTAINS SERVERAL UPDATES OBTAINED FROM UCLA
C UPDATE-MAILING .
C JULY 1969 ADDITION OF 28 LINES BETWEEN 2170 AND 2180
C NEW LINE NO. 2171-2188 OLD LINE 2180 IS NOW
C 2188.
C
C JAN 1970 ADDITION OF LINE 8195.
C
C MAY 4 1970 MODIFICATION OF SUBROUTINE TAIL
C ADDITION OF 2 PARAMETERS IN CALLING SEQUENCE
C PARAMETERS ARE "A , G".
C ADDITION OF 15 LINES (7936-7942, 7944-7952)
C
C FEB 19 1970 TO CORRECT AN NON-INTEGER SUBSCRIPT COMPILE
C ERROR.
C TO SOLVE PROBLEM - ADD MORE CODES (WHAT ELSE)
C
C REASON FOR ABOUT UPDATES -- NOT AVAILABLE.
C
C *** END OF NOTE -- BOB HUNG. ***
C
C
COMMON/ANARG/FF(180),NI,NCM,KM,MT,NV,ILL
COMMON /MNTOER/P1,P2,A,B,ID,G,S
DIMENSION LD(100),LQ(100)
DIMENSION FIN(11),FOP(11),IN(11),ROF(11),AA(11),P(100),PL(11),A(99
1),B(98),C(100),D(100),E(100),G(100),P1(100),P2(100),MN(100),IL(100
2),ID(100),S(15000),J1(10),Z2(10)
DIMENSION Z3(10)
DATA Z3,ZZ/'0','1','2','3','4','5','6','7','8','9','0'/
REAL*8 P1,P2
REAL*8 P3,P4
REAL*8 PROB,FINI,PF,PC,Q003HL, Q004HL,Q005HL,Q006HL,
X Q007HL,Q009HL,Q010HL,AP,PA ,Q008HL
INTEGER AA,A,B,C,D,E,U,UNION,H,Q012CT,Q013CT,Q014CT
LOGICAL INCL
DATA ON/4HNO /
DIMENSION EE(10)
DATA PROB,FINI/6HPROBLM,6HFINISH/
DATA Q003HL/6HINDEX /
DATA Q004HL/6HINF /
DATA Q005HL/6HDESIGN/
DATA Q006HL/6H, /
DATA Q007HL/6H /
DATA Q008HL/6H( /
DATA Q009HL/6H) /
DATA Q010HL/6HMEAN /
C
134 FORMAT('1BMD08V - ANALYSIS OF VARIANCE - ',
1'REVISED FEBRUARY 19, 1970'/
241H HEALTH SCIENCES COMPUTING FACILITY, UCLA//14H0PROBLEM CODE A6)
CALL USAGEB('BMD08V')
MTP=5
101 READ (5,100)PF,PC,NV,NI,KM,NF,MT,PCOV
L=10
I=1
DO 500 J=1,10
AA(L)=I
I=2*I
500 L=L-1
Q012CT=I
Q013CT=2*I
Q014CT=4*I
KLV=-1
IIIII=1
100 FORMAT(2A6,5I2,A2)
7777 IF(PF.EQ.PROB)GO TO 111
110 IF(PF.EQ.FINI)GO TO 113
20 IF(KLV)2111,7766,7766
2111 KLV=1
GO TO (2101,2102,2103,2104),IIIII
7766 STOP
C
C
113 IF(MTP.EQ.5)GO TO 117
116 REWIND MTP
117 CALL EXIT
2000 WRITE (6,2001)
2001 FORMAT(54H0THE NUMBER OF ANALYSIS OF VARIANCE INDICES IS TOO BIG)
888 KLV=1
GO TO 7766
111 IF(KM.LE.100) GO TO 99
WRITE(6,699)
699 FORMAT(99H0ERROR ON ASSIGNMENT OF NUMGER OF PIECES OF DATA SPECIFI
1ED BY THE FORMAT CARD.IT CAN NOT EXCEED 100)
GO TO 888
99 IF(NF.LE.9) GO TO 999
WRITE(6,6999)
6999 FORMAT(41H0ERROR ON NUMBER OF VARIABLE FORMAT CARDS)
GO TO 888
999 NF=18*MAX0(1,NF)
C
IF((MT-1)*(MT-2)*(MT-6))112,66,112
66 WRITE(6,666)
666 FORMAT(25H0ERROR ON TAPE ASSIGNMENT)
GO TO 888
3000 WRITE(6,3001)
3001 FORMAT(62H0NUMBER OF COMPONENTS IN ANALYSIS OF VARIANCE TABLE IS T
1OO BIG)
GO TO 888
4000 WRITE(6,4001)
4001 FORMAT(74H0VIOLATING THE LIMITATION FOR THE PROBLM,CHECK FOOTNOTE
1ON PAGE 586 OF BMD )
GO TO 888
2101 WRITE(6,2121)
2121 FORMAT(32H0PROBLEM CARD IS OUT OF SEQUENCE)
GO TO 7766
2102 WRITE(6,2122)
2122 FORMAT(30H0INDEX CARD IS OUT OF SEQUENCE)
GO TO 7766
2103 WRITE(6,2123)
2123 FORMAT(31H0DESIGN CARD IS OUT OF SEQUENCE)
GO TO 7766
2104 WRITE(6,2124)
2124 FORMAT(' WRONG SPECIFICATION ON DESIGN CARD')
GO TO 7766
112 KLV=-1
IF(MT)102,102,103
102 MT=5
103 IF(MT-MTP)104,107,104
104 IF(MTP.EQ.5)GO TO 107
106 REWIND MTP
107 MTP=MT
IF(PCOV.EQ.ON)GO TO 5114
5013 IF(MT.EQ.5)GO TO 5114
5116 REWIND MT
5114 WRITE (6,134)PC
READ (5,191)AP,(FIN(I),I=1,10),(FOP(I),I=1,10)
IIIII=2
191 FORMAT(A6,20F3.0)
IF(AP-(+Q003HL))20,193,20
193 N=NI
IF(NI*(11-NI))2000,2000,2011
989 FORMAT(36X,10A3)
2011 DO 135 I=1,NI
J1(I)=FIN(I)
991 IN(N)=FIN(I)
IF(FOP(I))136,136,137
136 ROF(N)=0.0
990 Z2(I)=(+Q004HL)
C
GO TO 135
137 ROF(N)=FIN(I)/FOP(I)
Z3(1)=Q007HL
Z2(I)=Q007HL
FIP=100.
DO 710 J=1,3
NN=AMOD(FOP(I)/FIP,10.)
CALL PUTCHR(Z2(I),J,Z3(NN+1))
IF(NN.NE.0) Z3(1)=ZZ
710 FIP=FIP/10.
135 N=N-1
READ (5,179)PA,(P(I),I=1,66)
179 FORMAT(A6,66A1)
IIIII=3
IF(PA-(+Q005HL))20,152,20
152 L=NI
IIIII=4
M=0
DO 31 I=1,10
FIN(I)=IN(I)
K=LWH(P(I))
GO TO (31,33,20,20,20,20,20,20),K
33 PL(L)=P(I)
M=M+1
EE(M)=P(I)
L=L-1
31 CONTINUE
IF(L)20,32,20
32 WRITE (6,722) (EE(I),I=1,NI)
WRITE (6,723)(J1(I),I=1,NI)
WRITE (6,724)(Z2(I),I=1,NI)
722 FORMAT(17H0INDEX 10(4X,A1))
724 FORMAT(17H POPULATION SIZE 10(2X,A3))
723 FORMAT(17H NUMBER OF LEVELS10I5)
WRITE (6,93)(P(I),I=1,66)
93 FORMAT(12H0DESIGN CARD 5X,72A1)
P(10)= ','
CO=1.0
LB=-1
RB=-1.0
N=0
MO=10
MI=66
178 DO 4 I=MO,MI
K=LWH(P(I))
GO TO (4,36,37,8,9,10,11,20),K
37 IF(CO)20,20,12
12 DO=1.0
CO=-1.0
PE=-1.0
LL=1
NL=0
N=N+1
A(N)=0
B(N)=0
GO TO 4
11 IF(DO)20,20,13
13 A(N)=Q012CT
DO=-1.0
GO TO 4
9 IF(RB)20,20,14
14 NL=1
CO=1.0
PE=1.0
RB=-1.0
GO TO 4
8 IF(LB)20,20,15
15 NL=-1
RB=1.0
LB=-1
CO=-1.0
PE=-1.0
GO TO 4
36 IF(LL)20,20,16
16 DO 17 M=1,NI
IF(P(I).EQ.PL(M)) GO TO 19
17 CONTINUE
GO TO 20
19 IF(NL)21,22,23
22 A(N)=A(N)+Q013CT+AA(M)
C
NL=1
DO=-1.0
LB=1
CO=1.0
PE=1.0
GO TO 4
23 IF(B(N)/Q013CT.EQ.0) B(N)=B(N)+Q013CT
21 B(N)=B(N)+AA(M)
4 CONTINUE
READ (5,130)(P(I),I=1,72)
MO=1
MI=72
WRITE (6,471)(P(I),I=1,72)
471 FORMAT(18X,72A1)
GO TO 178
10 IF(PE)20,20,24
24 C(1)=Q013CT
D(1)=0
MN(1)=1
C FOLLOWING IS UPDATE JULY 17 1969.
C
J0 = N 00002171
DO 9004 K=1,N 00002172
C
C UPDATE DEC 1975
C REPLACE LINE 2173 AND LINE 2185
C
9000 IF (K.GT.J0) GOTO 9005 00002173
C IF (K.GT. J0) GO TO 9005 00002173
IF (.NOT. INCL (Q012CT,A(K))) GO TO 9004 00002174
K1 = K-1 00002175
KKC = A(K) - Q012CT 00002176
DO 9001 I=1,K1 00002177
IF (KKC.EQ.A(1).AND.B(K).EQ.B(I)) GOTO 9002 00002178
9001 CONTINUE 00002179
GO TO 9004 00002180
9002 J0 = J0-1 00002181
DO 9003 I=K,J0 00002182
A(I) = A(I+1) 00002183
9003 B(I) = B(I+1) 00002184
GO TO 9000 00002185
C K= K-1 00002185
9004 CONTINUE 00002186
9005 N=J0 00002187
J=1 00002188
C END OF UPDATE JULY 1969
DO 51 K=1,N
J0=J
DO 51 I=1,J0
IF(.NOT.INCL(B(K),Q014CT-1-C(I))
X.OR. .NOT.INCL(A(K),Q014CT-1-D(I))) GO TO 51
52 J=J+1
IF(J-100)2221,3000,3000
2221 MN(J)=0
D(J)=UNION(B(K),D(I))
C(J)=UNION(A(K),C(I))
E(J)=MOD(C(J)+D(J),Q012CT)
51 CONTINUE
NCM=J
DO 25 I=1,N
IF(MOD(A(I)/Q012CT,2).EQ.0) GO TO 25
C
26 H=MOD(A(I)+B(I),Q012CT)
DO 27 J=1,NCM
IF(E(J).EQ.H) GO TO 28
27 CONTINUE
GO TO 20
28 MN(J)=1
25 CONTINUE
DO 53 I=1,NCM
E(1)=0
C
C(I)=MOD(C(I),Q012CT)
D(I)=MOD(D(I),Q012CT)
53 G(I)=1024*(10*NBITS(E(I))+NBITS(C(I)))+C(I)
DO 86 I=1,NCM
X=1.E30
DO 89 K=I,NCM
IF(X-G(K))89,89,88
88 J=K
X=G(K)
89 CONTINUE
G(J)=G(I)
U=C(J)
C(J)=C(I)
C(I)=U
U=D(J)
D(J)=D(I)
D(I)=U
NUU=MN(I)
MN(I)=MN(J)
MN(J)=NUU
86 E(I)=UNION(C(I),D(I))
DO 122 I=2,NCM
P1(I)=Q007HL
P2(I)=Q007HL
N=0
L=NI
DO 123 J=1,NI
IF(MOD(C(I)/AA(L),2).EQ.0) GO TO 123
124 N=N+1
IF(N.LE.6) CALL PUTCHR(P1(I),N,PL(L))
IF(N.GT.6) CALL PUTCHR(P2(I),N-6,PL(L))
123 L=L-1
C
IF(D(I)) 125,122,125
125 N=N+1
IF(N.LE.6) CALL PUTCHR(P1(I),N,Q008HL)
IF(N.GT.6) CALL PUTCHR(P2(I),N-6,Q008HL)
L=NI
DO 126 J=1,NI
IF(MOD(D(I)/AA(L),2).EQ.0) GO TO 126
127 N=N+1
IF(N.LE.6) CALL PUTCHR(P1(I),N,PL(L))
IF(N.GT.6) CALL PUTCHR(P2(I),N-6,PL(L))
126 L=L-1
N=N+1
IF(N.LE.6) CALL PUTCHR(P1(I),N,Q009HL)
IF(N.GT.6) CALL PUTCHR(P2(I),N-6,Q009HL)
130 FORMAT(72A1)
122 CONTINUE
P1(1)=(+Q010HL)
P2(1)=(+Q007HL)
121 FORMAT(12A6)
DO 602 I=2,NCM
IF(MN(I))602,602,603
C
C
603 DO 601 J=1,I
IF(INCL(E(J) ,E(I))) MN(J)=1
601 CONTINUE
602 CONTINUE
M1=0
921 FORMAT(20A4)
READ(5,921)(FF (I),I=1,NF)
WRITE (6,5432)(FF(I),I=1,NF)
5432 FORMAT(21H0VARIABLE FORMAT 20A4/(21X,20A4))
M2P2=M1
M1P1=M1+1
CALL SS(NCM,NI,S(M1P1),E,LQ,PL,AA)
M1P1=M1P1+LQ(NCM+1)+1
DO 90 I=M1P1,15000
90 S(I)=0.0
ILL=15000-M1P1
CALL ANOVA(AA,MN,E,IN,IL,S(M1P1),ID)
IF(ILL)4000,4000,2888
2888 NVV=NV
NN=NVV*NCM
874 DO 731 I=1,NV
C
C
K=M1P1+I-1
529 WRITE(6,141)I
141 FORMAT(44H1ANALYSIS OF VARIANCE FOR DEPENDENT VARIABLEI3/11H0 S
*OURCE,5X,'ERROR TERM',6X,'F SUM OF SQUARES DEG. OF MEAN SQUARE
* EXPECTED MEAN SQUARE'/52X,'FREEDOM'/)
REWIND 1
REWIND 2
A(1)=15001-ILL
DO 144 J=1,NCM
SM=S(K)/FLOAT(ID(J))
L=1
DO 3 N=1,NCM
IF(.NOT.INCL(E(J),E(N))) GO TO 3
FF(L)=1.
DO 40 M=1,NI
IF(MOD(UNION(D(N),E(J))/AA(M),2).EQ.1) GO TO 40
NN=MOD(C(N)/AA(M),2)
IF(NN.EQ.1) FF(L)=FF(L)*(1.-ROF(M))
IF(NN.EQ.0) FF(L)=FF(L)*FIN(M)
40 CONTINUE
LD(L)=N
IF(FF(L).NE.0.) L=L+1
3 CONTINUE
LL=L-1
A(J+1)=A(J)+2*LL
IF(A(J+1)-15001)8000,8000,8002
8000 DO 8001 N=1,LL
M=A(J)+2*N-1
S(M-1)=FF(N)
8001 S(M)=LD(N)
B(J)=LD(2)
8002 WRITE(1 )S(K),SM,( FF(L),LD(L),L=1,LL)
8003 FORMAT(20A4)
G(J)=SM
8004 FORMAT(2A6,2A4)
144 K=K+NVV
END FILE 1
REWIND 1
C
C
IF(A(NCM+1)-15001)8005,8005,8006
8005 CALL ERRTRM(I,NI,NV,NCM,M1P1)
GO TO 8065
8006 DO 8055 J=1,NCM
8055 WRITE(2,8004)(Q007HL,LL=1,4)
8065 END FILE 2
REWIND 2
DO 8007 J=1,NCM
LL=(A(J+1)-A(J))/2
C
READ(1 )SK,SM,(FF(L),LD(L),L=1,LL)
READ(2,8004)P3,P4,F1,F2
8007 WRITE(6,8008)J,P1(J),P2(J),P3,P4,F1,F2,SK,ID(J),SM,(FF(L),LD(L),L=
*1,LL)
8008 FORMAT(I3,1X,4A6, 2A4,3X,G12.7,I6,3X,G12.7,5(F8.3,'(',I2,')')/
*( 72X,5(F8.3,'(',I2,')')/))
C
C FOLLOWING IS PART OF MAY 1970 UPDATE (DELETE LINE 4027-4030)
C
C L=IL(1)+ M1P1+I-1
C WRITE(6,400)S(L)
C 400 FORMAT(5H-MEANF14.5/11H0CELL MEANS)
C
C SUBROUTINE TAIL WILL NOW HAVE 2 MORE ARGUMENTS
C
CALL TAIL (A,G,MN,IL,I,M1P1,E,AA,PL,IN,S,LQ,ID,M2P2) 00007920
C
C CALL TAIL(MN,IL,I,M1P1,E,AA,PL,IN,S,LQ,ID,M2P2)
731 CONTINUE
GO TO 101
END
C SUBROUTINE ANOVA FOR BMD08V MARCH 1, 1966
SUBROUTINE ANOVA(AJ,MN,CW,IN,IL,S,ID)
COMMON/ANARG/FF(180),NI,NCW,MK,MT,NV,ILL
DIMENSION AJ(2),MN(2),CW(2),IN(2),IL(2),S(2),ID(2),ST(100),
1IC(11,100),II(11),IJ(11,100),X(255),FP(100),SF(100),SG(100)
DIMENSION IW(100)
LOGICAL INCL
INTEGER CW,AJ ,QCT
QCT=2**10
IF(MT)500,500,501
500 DO 50 I=1,NCW
50 IW(I)=CW(I)
DO 403 I=2,NCW
AJ(NI1)=QCT
IW(I)=IW(I)+QCT
J1=I-1
DO 404 J=1,I
FP(J)=-1.
404 IF(INCL(IW(J),IW(I)))FP(J)=1.
410 DO 600 J=1,J1
IF(FP(J).NE.1.) GO TO 600
M=IL(I)-MT
L=IL(J)-MT
S(M)=S(M)-S(L)
600 CONTINUE
II(NI1)=-2
DO 408 K=1,NI1
KK=K
IF(MOD(IW(I)/AJ(K),2).EQ.0)GO TO 408
C
402 II(K)=II(K)+1
IF(II(K))401,400,400
400 II(K)=-IN(K)
408 CONTINUE
401 DO 407 J=1,I
407 IF(FP(J).EQ.1.0)IL(J)=IL(J)+IJ(KK,J)
IF(NI1-KK)410,403,410
403 CONTINUE
RETURN
501 KM=MK
DO 228 I=1,100
228 ST(I)=0.0
NVV=NV
NN=1
DO 51 I=1,NI
51 NN=NN*IN(I)
NI1=NI+1
DO 10 J=1,NCW
ID(J)=1
IL(J)=1
IO=1
DO 12 I=1,NI
IF(MOD(CW(J)/AJ(I),2).EQ.0) GO TO 13
C
52 IC(I,J)=1
ID(J)=ID(J)*IN(I)
GO TO 12
13 IO=I
IC(I,J)=0
12 CONTINUE
IF(MN(J))11,11,107
11 DO 14 K=IO,NI
14 IC(K,J)=-IC(K,J)
107 FP(J)=NN/ID(J)
10 IC(NI1,J)=-1
IN(NI1)=2
DO 7 I=1,NI1
DO 15 J=1,NCW
IF(IC(I,J)-1)16,17,16
17 IJ(I,J)=NV
IL(J)=IL(J)*IN(I)
GO TO 15
16 IJ(I,J)=(1-IL(J))*NV
15 CONTINUE
7 II(I)=-IN(I)
N=(NVV*NCW)/NV+1
DO 118 J=1,NCW
IF(MN(J))118,118,110
110 N=N+IL(J)
IL(J)=(N-IL(J))*NV
118 CONTINUE
MK=N+1
DO 119 J=1,NCW
IF(MN(J))111,111,119
111 N=N+IL(J)
IL(J)=(N-IL(J))*NV
119 CONTINUE
KU=KM
FQ=0.0
NTNV=N*NV
IF(N*NV-ILL)19,2000,2000
2000 ILL=0
RETURN
19 DO 23 M=1,NV
KU=KU+1
IF(KU-KM)22,22,21
21 READ (MT,FF)(X(K),K=1,KM)
KU=1
22 XK=X(KU)
ST(M)=ST(M)+XK
DO 23 J=1,NCW
N=IL(J)+M
23 S(N)=S(N)+XK
FQ=FQ+1.0
DO 20 I=1,NI1
II(I)=II(I)+1
IF(II(I))24,20,20
20 II(I)=-IN(I)
24 DO 25 J=2,NCW
IL(J)=IL(J)+IJ(I,J)
IF(IC(I,J))26,25,25
26 N=IL(J)
DO 222 K=1,NV
222 SG(K)=0.0
LL=-IJ(I,J)/NV+1
K0=(J-1)*NVV
GR=FP(J)/FQ
DO 27 L=1,LL
M=K0
DO 27 K=1,NV
N=N+1
SF(K)=S(N)-GR*ST(K)
SG(K)=SG(K)+SF(K)
M=M+1
S(M)=S(M)+SF(K)*SF(K)
IF(I-NI1)60,27,60
60 S(N)=0.0
27 CONTINUE
GR=FQ/FP(J)-FLOAT(LL)
IF(GR)25,25,372
372 M=K0
DO 327 K=1,NV
M=M+1
327 S(M)=S(M)+SG(K)*SG(K)/GR
25 CONTINUE
IF(I-NI1)19,30,19
30 K1=0
K=0
L0=IL(1)+1
L1=IL(1)+NV
DO 373 L=L0,L1
K=K+1
373 S(K)=S(L)*S(L)
DO 31 J=1,NCW
NM=NV-IJ(NI1,J)
MN(J)=MN(J)*NM
F=(NN*NV)/NM
K2=IL(J)+1
K3=IL(J)+NM
DO 70 K=K2,K3
70 S(K)=S(K)/F
F=NN/ID(J)
K0=K1+1
K1=K1+NVV
DO 31 K=K0,K1
31 S(K)=S(K)/F
L1=NVV
DO 32 J=2,NCW
J1=J-1
L0=L1+1
L1=L1+NVV
DO 32 K=1,J1
IF(.NOT.INCL(CW(K),CW(J))) GO TO 32
C
33 IF(K-1)62,62,61
61 M=(K-1)*NVV
DO 34 L=L0,L1
M=M+1
34 S(L)=S(L)-S(M)
62 ID(J)=ID(J)-ID(K)
32 CONTINUE
ILL=ILL-NTNV
RETURN
END
C FUNCTION LWH FOR BMD08V MAY 14, 1968
FUNCTION LWH(P)
DIMENSION A(17)
DATA A/' ',' ',',','(',')','.','$','=','+','-','*','/',1H',
*'=','+','(',')'/
DO 1 I=1,17
IF(P.EQ.A(I)) GO TO 2
1 CONTINUE
LWH=2
RETURN
2 IF(I.GE.16)I=I-12
LWH=MIN0(8,I)
RETURN
END
C SUBROUTINE PMEANS FOR BMD08V MARCH 1, 1966
SUBROUTINE PMEANS(E,A,PL,IN,S,NI,NV)
DIMENSION A(2),PL(2),S(2),LL(11),P(11),JO(11),IN(2)
INTEGER A,E
40 M=NI+1
DO 1 I=1,NI
IF(MOD(E/A(I),2).EQ.0) GO TO 1
C
2 M=M-1
P(M)=PL(I)
JO(M)=IN(I)
1 CONTINUE
NJ=NI-2
N=NI-M+1
JO1=JO(NI)
JO2=JO(NI-1)
L1=1-NV
IF(N-2)3,88,5
88 WRITE (6,127)P(NI),(I,I=1,JO1)
GO TO 89
5 DO 6 I=M,NI
6 LL(I)=1
11 WRITE (6,7)(P(K),LL(K),K=M,NJ)
7 FORMAT(1H08(4X,A1,2H =I3))
GO TO 8
9 I=NJ
DO 10 J=3,N
LL(I)=LL(I)+1
IF(LL(I)-JO(I))11,11,12
12 LL(I)=1
10 I=I-1
RETURN
8 WRITE (6,27)P(NI),(I,I=1,JO1)
27 FORMAT( 5X,A1,2H =I7,9I12, /(3X,10I12))
89 I=1
L0=L1+NV
L1=L1+JO1*NV
WRITE (6,24)P(NI-1),I,(S(L),L=L0,L1,NV)
24 FORMAT(1X,A1,2H =I3,10F12.5, /(7X,10F12.5))
DO 29 I=2,JO2
L0=L1+NV
L1=L1+JO1*NV
29 WRITE (6,25)I,(S(L),L=L0,L1,NV)
25 FORMAT(4X,I3,10F12.5, /(7X,10F12.5))
IF(N-2)37,37,9
3 L0=L1+NV
L1=L1+NV*JO1
WRITE (6,127)P(NI),(I,I=1,JO1)
127 FORMAT(1H04X,A1,2H =I7,9I12, /(3X,10I12))
WRITE (6,35)(S(L),L=L0,L1,NV)
35 FORMAT(7X,10F12.5)
37 RETURN
END
C SUBROUTINE SS FOR BMD08V MARCH 1, 1966
SUBROUTINE SS(NCM,NI,S,E,LQ,P,AA)
DATA XP,XM,XB,BL,Q001HL/'+ X(','- X(',' X(',' ','.'/
DATA RP/')'/
DIMENSION S(2),E(2),LQ(2),P(2),AA(2)
LOGICAL INCL
INTEGER AA,E
L=0
DO 1 I=1,NCM
DO 2 J=1,I
L=L+1
2 S(L)=0.0
1 S(L)=1.0
LL=L
L0=1
I1=1
DO 3 I=2,NCM
DO 4 J=1,I1
IF(.NOT.INCL(E(J),E(I))) GO TO 4
C
6 K0=(J*(J-1))/2+1
L=L0
K1=K0+J-1
DO 7 K=K0,K1
L=L+1
7 S(L)=S(L)-S(K)
4 CONTINUE
L0=L0+I
3 I1=I
L=LL
LLL=LL+NCM*NI+1
MM=LLL
DO 18 I=1,NCM
N=NI
LQ(I)=LLL-MM
DO 8 J=1,NI
L=L+1
S(L)=(+Q001HL)
IF(MOD(E(I)/AA(N),2).EQ.1) S(L)=P(N)
C
8 N=N-1
XPB=XB
K0=L+1
K=(I*(I+1))/2
DO 10 J=1,I
C
K0=K0-NI
IF(S(K))11,10,13
13 S(LLL+1)=XPB
XPB=XP
GO TO 14
11 S(LLL+1)=XM
14 S(LLL+2)=BL
S(LLL+3)=BL
S(LLL+4)=BL
NK=K0
DO 12 N=1,NI
CALL PUTCHR(S(LLL+2),N,S(NK))
12 NK=NK+1
CALL PUTCHR(S(LLL+2),NI+1,RP)
LLL=LLL+4
10 K=K-1
18 CONTINUE
L=0
K0=MM+1
DO 19 K=K0,LLL
L=L+1
19 S(L)=S(K)
LQ(NCM+1)=LLL-MM
RETURN
END
FUNCTION NBITS(II)
K=II
NBITS=0
DO 1 I=1,10
IF(MOD(K,2).EQ.1) NBITS=NBITS+1
1 K=K/2
RETURN
END
INTEGER FUNCTION UNION(II,JJ)
UNION=0
L=1
DO 1 I=1,12
IF(MOD(II/L,2).NE.0 .OR. MOD(JJ/L,2).NE.0) UNION=UNION+L
1 L=L*2
RETURN
END
LOGICAL FUNCTION INCL(II,JJ)
INCL=.FALSE.
L=1
DO 1 I=1,12
IF(MOD(II/L,2).EQ.0) GO TO 1
IF(MOD(JJ/L,2).EQ.0) RETURN
1 L=L*2
INCL=.TRUE.
RETURN
END
C
C MODIFICATION MAY 1970
C
SUBROUTINE TAIL(A,C,MN,IL,I,M1P1,E,AA,PL,IN,S,LQ,ID,M2P2) 00007920
DIMENSION A(1), C(1) 00007921
INTEGER A, E, AA 00007922
C SUBROUTINE TAIL(MN,IL,I,M1P1,E,AA,PL,IN,S,LQ,ID,M2P2)
DIMENSION MN(1),IL(1),E(1),AA(1),PL(1),IN(1),S(1),LQ(1),ID(1)
COMMON /ANARG/FF(180),NI,NCM,KM,MT,NV,ILL
C INTEGER E,AA
DO 320 JJ=1,NCN 00007936
J=NCM+1-JJ 00007937
K1=A(J)+2 00007938
K2=A(J+1)-2 00007939
IF (K1.GT.K2) GO TO 320 00007940
DO 330 K=K1,K2,2 00007941
C
C UPDATE FEB 19 1971
C
ISK1=S(K+1) 00007942
330 C(J)=C(J)-S(K)*C(ISK1) 00007943
C330 C(J)=C(J)-S(K)*C(S(K+1)) 00007942
320 C(J)=C(J)/S(K1-2) 00007944
WRITE(6,360) (J,C(J),J=1,NCM) 00007945
360 FORMAT('0ESTIMATES OF VARIANCE COMPONENTS'//(' (',I2,')',
1G15.7)) 00007946
L=IL(1)+M1P1+I-1 00007947
WRITE(6,400) S(L) 00007948
400 FORMAT('-MEAN',F14.5/'0CELL MEANS') 00007949
DO 401 J=2,NCM 00007950
IF (MN(J)) 402,401,402 00007952
C DO 401 J=2,NCM
C IF(MN(J))402,401,402
C
C END OF UPDATE MAY 1970
C
402 L1=IL(J)+I+M1P1-1
CALL PMEANS(E(J),AA,PL,IN,S(L1),NI,NV)
401 CONTINUE
JYP=1
DO 731 J=2,NCM
IF(MN(J))732,731,732
732 L1=IL(J)+I+M1P1-1
L8=LQ(J)+1+M2P2
L9=LQ(J+1)+M2P2
IF(JYP)421,421,420
420 JYP=0
MT=-I
CALL ANOVA(AA,MN,E,IN,IL,S(M1P1),ID)
WRITE(6,422)
422 FORMAT(' CELL DEVIATIONS')
421 WRITE(6,733)(S(L),L=L8,L9)
733 FORMAT(1H0 3X,24A4/ (4X,24A4))
CALL PMEANS(E(J),AA,PL,IN,S(L1),NI,NV)
731 CONTINUE
RETURN
END
SUBROUTINE ERRTRM(II,NI,NV,NCM,M1P1)
DIMENSION ID(100), G(100),S(15000)
REAL*8 P1(100),P2(100)
COMMON /MNTOER/P1,P2,A,B,ID,G,S
INTEGER A(99),B(98)
DATA BLNK4/' '/
DO 50 I=1,NCM
IF(A(I+1)-A(I)-2)40,40,10
10 JST=A(I)+2
JND=A(I+1)-1
C
C UPDATE LINE 8125,8130,8155,8160 HAS ALREADY BEEN TAKEN CARE
C OF BY DECLARING INTEGER B.
C
JB=A(B(I))-JST
DO 30 J=JST,JND
IF(S(J)-S(J+JB))40,30,40
30 CONTINUE
IB=B(I)
LNG=M1P1+NV*( IB -1)+II-1
FF=G(I)/S(LNG)*FLOAT(ID(IB))
C
C UPDATE JAN 1970
C
IF (FF.LT.0.0) FF=0.0 00008195
WRITE(2,35)P1(IB),P2(IB),FF
35 FORMAT(2A6,F8.3)
GO TO 50
40 WRITE(2,45)(BLNK4,LL=1,4)
45 FORMAT(2A6,2A4)
50 CONTINUE
RETURN
END