Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/stp14.stp
There is 1 other file named stp14.stp in the archive. Click here to see a list.
C **** STAT PACK ****
C ROUTINE FOR CALCULATING ONE WAY ANLYSES OF COVARIANCE.
C CALLING SEQUENCE: CALL ANOC1(NV,NC,MV,MC,DATA,VMN,NAMES,IV,SP)
C SHERE NV - NUMBER OF VARIBLES.
C NC - NUMBER OF OBSERVATIONS.
C MV - MAXIMUM NUMBER OF VARIABLES POSSIBLE.
C MC - MAXIMUM NUMBER OF OBSERVATIONS POSSIBLE.
C DATA - MATRIX CONTAINING DATA. (MV X MC)
C VMN - VECTOR CONTAINING VARIABLE MEANS.
C NAMES - VECTOR CONTAINING VARIABLE NAMES.
C IV - EXTRA VECTOR AT LEAST NC LONG.
C SP - EXTRA VECTOR.
C
C ORIGINNALY REQUESTED BY LONNIE HANNAFORD TEACHER EDUCATION.
C METHOD OF ANALYSIS DETERMINED BY STATISTICAL CONSULTANT FOR
C COMPUTER CENTER MIKE STOLINE WITH HELP FROM BRAD HEITEMA.
C
SUBROUTINE ANOC1(NV,NC,MV,MC,DATA,VMN,NAMES,IV,SP)
DIMENSION IX(20),IZIP(5),ITB(20,20),NX(20),XBAR(20,20)
DIMENSION XPROD(20,20),OPT(5),IC(20),XS(20),XBRK(20,3)
DIMENSION INPUT(20),NUMBER(10),VALUE(2),IL(16),IU(16)
DIMENSION NMCOV(20)
DIMENSION NAMES(1),VMN(1),DATA(MC,MV),IV(1),SP(1),XSUM(20)
COMMON /DEV/ ICC,IDATA,IOUT,IDLG,IDSK
COMMON /PRNT/ LINPP,ICOPS,RUNPRG
COMMON /EXTRA/ HEDR(70),NSZ
EQUIVALENCE (WORD,IWORD),(ITB,XBAR)
1 IF(ICC.NE.2) WRITE(IDLG,2)
2 FORMAT(' LIST OPTIONS SEPARATED BY COMMAS'/)
DISCR=0
BREAK=0
RANGE=0
READ(ICC,3,END=4) OPT
3 FORMAT(5(A5,1X))
IF(OPT(1).EQ.'!') RETURN
DO 20 I=1,5
IF(OPT(I).EQ.' ') GO TO 25
IF(OPT(I).NE.'HELP') GO TO 6
WRITE(IDLG,5)
5 FORMAT('0THE 1 WAY ANALYSIS OF COVARIANCE ASSUMES TREATMENTS'/
1' AND COVARIATES FOR EACH TREATMENT TO BE INDIVIDUAL VARIABLES.'/
2' THE NUMBER OF TREATMENTS PLUS THE NUMBER OF VARIABLES MAY NOT'/
3' EXCEED 20'/
4'0IT IS POSSIBLE TO BREAK A VARIABLE INTO TREATMENTS BY MEANS'/
5' OF ANOTHER VARIABLE BY USING THE BREAK OPTION. RANGES OF'/
6' VALUES FOR THE BREAKDOWN ARE ASSUMED TO BE SUPPLIED BY THE'/
7' USER, HOWEVER IF THE DISCR OPTION IS USED, INDIVIDUAL VALUES'/
8' OF THE BREAKDOWN VARIABLE WILL BE USED AS THE RANGES.'/
9' VARIABLES LISTED AS COVARIATES WILL BE BROKEN INTO GROUPS'/
1' THE SAME AS THE VARIABLE BEING ANALYSED.'/' OPTIONS ARE:'/
2' "BREAK" - FORM GROUPINGS BASED ON VALUES OF BREAKDOWN VARIABLE'/
3' "DISCR" - AUTOMATICALLY FORM GROUPINGS BASED ON DISTINCT'/
4' VALUES OF THE BREAKDOWN VARIABLE (AVAILABLE ONLY IF'/
5' BREAK IS USED'/
6' "AUTO" - SAME AS DISCR OLY SPECIFIED WHEN ASKED FOR RANGES'/
7' "RANGE" - LIST RANGES USED FOR BREAKDOWN (AVAILABLE ONLY IF'/
8' DISCR IS USED)'/)
GO TO 1
6 IF(OPT(I).NE.'BREAK') GO TO 7
BREAK=1
GO TO 20
7 IF(OPT(I).NE.'DISCR') GO TO 8
DISCR=1
GO TO 20
8 IF(OPT(I).NE.'RANGE') GO TO 9
RANGE=1
GO TO 20
9 IF(OPT(4).NE.'AUTO') GO TO 12
10 WRITE(IDLG,11)
11 FORMAT(' "AUTO" IS USED ONLY WHEN ASKED FOR RANGES')
GO TO 1
12 IF(OPT(4).EQ.'AUTO,') GO TO 10
WRITE(IDLG,13) OPT(I)
13 FORMAT(' OPTION "',A5,'" DOES NOT EXIST')
GO TO 1
20 CONTINUE
25 IF(DISCR.NE.1) GO TO 22
IF(BREAK.EQ.1) GO TO 22
WRITE(IDLG,21)
21 FORMAT(' DISCR IS USED ONLY WITH BREAK')
GO TO 1
22 IF(RANGE.NE.1) GO TO 24
IF(DISCR.EQ.1) GO TO 24
WRITE(IDLG,23)
23 FORMAT(' RANGE IS USED ONLY WITH DISCR')
GO TO 1
24 IF(BREAK.EQ.1) GO TO 100
C
C BREAK DOWN NOT USED
C
50 IF(ICC.NE.2) WRITE(IDLG,51)
51 FORMAT(' LIST VARIABLES TO BE USED AS TREATMENTS'/)
CALL ALPHA(IX,20,NT,IRET,IHELP,IERR,NAMES,NV)
IF(IRET.EQ.1) RETURN
IF(IERR.EQ.1) GO TO 50
IF(IHELP.NE.1) GO TO 55
WRITE(IDLG,52)
52 FORMAT('0LIST VARIABLES SEPARATED BY COMMAS TO BE USED AS'/
1' TREATMENTS. RANGES OF VARIABLES MAY BE SPECIFIED BY ENTERING'/
2' THE EXTREMES OF THE RANGE SEPARATED BY A MINUS. EVERY VARIABLE'/
3' LISTED ACTS AS AN INDIVIDUAL TREATMENT'/)
GO TO 50
55 IF(ICC.NE.2) WRITE(IDLG,56)
56 FORMAT(' HOW MANY COVARIATES? ',$)
READ(ICC,3,END=4) NUMB
IF(NUMB.EQ.'!') RETURN
IF(NUMB.NE.'HELP') GO TO 60
WRITE(IDLG,57)
57 FORMAT('0ENTER THE NUMBER OF COVARIATES TO BE USED. THE MAXIMUM'/
1' NUMBER OF COVARIATES IS 20 LESS THE NUMBER OF TREATMENTS'/)
GO TO 55
60 DECODE(5,61,NUMB) IZIP
61 FORMAT(5A1)
DO 62 I=1,5
IF(IZIP(I).EQ.' ') GO TO 62
IF((IZIP(I).LE.'9').AND.(IZIP(I).GE.'0')) GO TO 62
WRITE(IDLG,63)
63 FORMAT(' ONLY NUMERIC VALUES ARE ACCEPTABLE')
GO TO 55
62 CONTINUE
64 IF(IZIP(5).NE.' ') GO TO 66
DO 65 I=4,1,-1
65 IZIP(I+1)=IZIP(I)
IZIP(1)='0'
GO TO 64
66 DO 67 I=1,5
IF(IZIP(I).EQ.' ')IZIP(I)='0'
67 CONTINUE
ENCODE(5,61,NUMB) IZIP
DECODE(5,68,NUMB) NCOV
68 FORMAT(I5)
IF((NCOV+NT).LE.20) GO TO 70
WRITE(IDLG,69)
69 FORMAT(' THE NUMBER OF COVARIATES AND TREATMENTS MAY NOT'/
1' BE GREATER THAN 20'/)
GO TO 55
70 DO 26 I=1,NCOV
26 ENCODE(5,27,NMCOV(I)) I
27 FORMAT('COV',I2)
DO 71 I=1,NT
73 IF(ICC.NE.2) WRITE(IDLG,72) NAMES(IX(I))
72 FORMAT('0LIST COVARIATES FOR VAR: ',A5/)
CALL ALPHA(ITB(1,I),NCOV,NZ,IRET,IHELP,IERR,NAMES,NV)
IF(IRET.EQ.1) RETURN
IF(IERR.EQ.1) GO TO 73
IF(IHELP.NE.1) GO TO 75
WRITE(IDLG,74)
74 FORMAT('0ENTER THE LIST OF VARIABLES TO BE USED AS COVARIATES'/
1' FOR EACH OF THE TREATMENTS. VARIABLES SHOULD BE ENTERED '/
2' SEPARATED BY COMMAS. DO NOT REPEAT VARIABLES AS COVARIATES,'/
3' AND DO NOT USE A VARIABLE LISTED AS A TREATMENT.'/)
GO TO 73
75 IF(NZ.EQ.NCOV) GO TO 77
WRITE(IDLG,76) NCOV
76 FORMAT(' EACH VARIABLE MUST HAVE ',I2,' COVARIATES')
GO TO 70
77 DO 78 J=1,NZ
DO 79 K=1,NT
IF(ITB(J,I).NE.IX(K)) GO TO 79
WRITE(IDLG,80)
80 FORMAT(' A VARIABLE MAY NOT BE USED AS BOTH'/
1' A COVARIATE AND A TREATMENT')
GO TO 73
81 IF(I.EQ.1) GO TO 71
DO 82 L=1,I
DO 82 M=1,NCOV
IF(ITB(J,I).NE.ITB(M,K)) GO TO 82
WRITE(IDLG,84)
84 FORMAT(' THE SAME VARIABLE CANNOT BE USED AS'/
1' A COVARITE FOR 2 TREATMENTS')
GO TO 73
82 CONTINUE
79 CONTINUE
78 CONTINUE
71 CONTINUE
DO 83 I=1,NT+NCOV
NX(I)=0
XSUM(I)=0
DO 83 J=1,NT+NCOV
83 XPROD(I,J)=0
C
C
C FORM CROSS PRODUCT MATRIX
C
LAST=NT+NCOV
DO 90 I=1,NT
LVAR=I+NCOV
DO 91 J=1,NC
DO 92 K=1,NCOV
KVAR=ITB(K,I)
DO 93 L=1,K
93 XPROD(K,L)=XPROD(K,L)+DATA(J,KVAR)*DATA(J,ITB(L,I))
IF(I.NE.NT) XPROD(LVAR,K)=XPROD(LVAR,K)+DATA(J,KVAR)
XPROD(LAST,K)=XPROD(LAST,K)+DATA(J,KVAR)*DATA(J,IX(I))
92 CONTINUE
IF(I.NE.NT) XPROD(LAST,LVAR)=XPROD(LAST,LVAR)+DATA(J,IX(I))
XPROD(LAST,LAST)=XPROD(LAST,LAST)+DATA(J,IX(I))**2
91 CONTINUE
90 CONTINUE
DO 95 L=1,NT-1
LVAR=L+NCOV
XSUM(LVAR)=NC
95 XPROD(LVAR,LVAR)=NC
IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(I),I=1,NSZ)
IF(IOUT.EQ.21) CALL PRNTHD
WRITE(IOUT,96)
96 FORMAT('0',17X,'***** 1-WAY ANOCOV *****'/
1' TREATMENTS AND COVARIATES ARE INDIVIDUAL VARIABLES')
LINES=5
IEND=0
97 IF(IEND.GE.NCOV) GO TO 88
IBG=IEND+1
IEND=IEND+9
IF(IEND.GT.NCOV) IEND=NCOV
COV='COV'
IF(IOUT.NE.21) GO TO 300
LINES=LINES+2
IF(LINES.LE.(LINPP-3)) GO TO 300
CALL PRNTHD
LINES=4
300 WRITE(IOUT,98)(COV,I,I=IBG,IEND)
98 FORMAT('0TREAT',9(2X,A3,I3))
DO 99 I=1,NT
IF(IOUT.NE.21) GO TO 99
LINES=LINES+1
IF(LINES.LE.LINPP) GO TO 99
CALL PRNTHD
WRITE(IOUT,98)(COV,J,J=IBG,IEND)
LINES=5
99 WRITE(IOUT,87) NAMES(IX(I)),(NAMES(ITB(J,I)),J=IBG,IEND)
87 FORMAT(1X,A5,9(2X,A5,1X))
GO TO 97
88 DO 85 I=1,NT
IWORD=NAMES(IX(I))
XBRK(I,3)=WORD
NX(I)=NC
XBAR(NCOV+NT,I)=VMN(IX(I))
XSUM(NCOV+NT)=XSUM(NCOV+NT)+VMN(IX(I))*NC
DO 86 J=1,NCOV
XSUM(J)=XSUM(J)+VMN(ITB(J,I))*NC
86 XBAR(J,I)=VMN(ITB(J,I))
85 CONTINUE
CALL OUTPUT(NT,NCOV,NX,XSUM,XBAR,XPROD,XBRK(1,3),NMCOV,LINES)
RETURN
C
C RBREAKDOWN USED
C
100 IF(ICC.NE.2) WRITE(IDLG,101)
101 FORMAT(' WHICH VARIABLES ARE TO BE ANALYSED? ',$)
CALL ALPHA(IX,20,NN,IRET,IHELP,IERR,NAMES,NV)
IF(IRET.EQ.1) RETURN
IF(IERR.EQ.1) GO TO 100
IF(IHELP.NE.1) GO TO 105
WRITE(IDLG,102)
102 FORMAT(' LIST THE VARIABLES TO BE ANALYSED SEPARATED BY COMMAS'/
1' RANGES OF VARIABLES MAY BE SPECIFIED BY ENTERING THE EXTREMES'/
2' OF THE RANGE SEPARATED BY A MINUS.'/)
GOTO 100
105 IF(ICC.NE.2) WRITE(IDLG,106)
106 FORMAT(' WHICH IS THE BREAKDOWN VARIABLE? ',$)
CALL ALPHA(IB,1,NN,IRET,IHELP,IERR,NAMES,NV)
IF(IRET.EQ.1) RETURN
IF(IERR.EQ.1) GO TO 105
IF(IHELP.NE.1) GO TO 110
WRITE(IDLG,107)
107 FORMAT('0THE VARIABLE ENTERED AS THE BREAKDOWN VARIABLE WILL'/
1' BE USED TO GROUP THE OBSERVATIONS INTO TREATMENTS.'/)
GO TO 105
110 IF(DISCR.NE.1) GO TO 200
C
C BREAK AND DISCR OR AUTO WERE USED
C
112 DO 111 I=1,NC
111 IV(I)=I
M=1
II=1
J=NC
151 IF(II.GE.J) GO TO 158
152 K=II
IJ=(J+II)/2
T=DATA(IV(IJ),IB)
IF(DATA(IV(II),IB).LE.T) GO TO 153
ISAV=IV(II)
IV(II)=IV(IJ)
IV(IJ)=ISAV
T=DATA(IV(IJ),IB)
153 LL=J
IF(DATA(IV(J),IB).GE.T) GO TO 155
ISAV=IV(IJ)
IV(IJ)=IV(J)
IV(J)=ISAV
T=DATA(IV(IJ),IB)
IF(DATA(IV(II),IB).LE.T) GO TO 155
ISAV=IV(IJ)
IV(IJ)=IV(II)
IV(II)=ISAV
T=DATA(IV(IJ),IB)
GO TO 155
154 ISAV=IV(LL)
IV(LL)=IV(K)
IV(K)=ISAV
155 LL=LL-1
IF(DATA(IV(LL),IB).GT.T) GO TO 155
TT=DATA(IV(LL),IB)
156 K=K+1
IF(DATA(IV(K),IB).LT.T) GO TO 156
IF(K.LE.LL) GO TO 154
IF((LL-II).LE.(J-K)) GO TO 157
IL(M)=II
IU(M)=LL
II=K
M=M+1
GO TO 159
157 IL(M)=K
IU(M)=J
J=LL
M=M+1
GO TO 159
158 M=M-1
IF(M.EQ.0) GO TO 165
II=IL(M)
J=IU(M)
159 IF((J-II).GE.11) GO TO 152
IF(II.EQ.1) GO TO 151
II=II-1
160 II=II+1
IF(II.EQ.J) GO TO 158
T=DATA(IV(II+1),IB)
IF(DATA(IV(II),IB).LE.T) GO TO 160
ISAV=IV(II+1)
K=II
161 IV(K+1)=IV(K)
K=K-1
IF(T.LT.DATA(IV(K),IB)) GO TO 161
IV(K+1)=ISAV
GO TO 160
C
C FINI SORT
C
165 NT=1
NX(NT)=1
COMP=DATA(IV(1),IB)
XBRK(NT,1)=COMP
XBRK(NT,2)=COMP
ENCODE(5,215,XBRK(NT,3)) NT
IF(NC.LT.2) GO TO 172
DO 166 J=2,NC
IF(DATA(IV(J),IB).EQ.COMP) GO TO 169
NT=NT+1
IF(NT.LE.20) GO TO 168
WRITE(IDLG,167)
167 FORMAT(' MORE THAN 20 TREATMENTS')
GO TO 105
168 NX(NT)=1
COMP=DATA(IV(J),IB)
XBRK(NT,1)=COMP
XBRK(NT,2)=COMP
ENCODE(5,215,XBRK(NT,3)) NT
GO TO 166
169 NX(NT)=NX(NT)+1
166 CONTINUE
IF(RANGE.EQ.0) GO TO 172
WRITE(IDLG,190)
190 FORMAT('0RANGES USED:')
DO 191 I=1,NT
191 WRITE(IDLG,192) XBRK(I,1),XBRK(I,2)
192 FORMAT(1X,G10.3,',',G10.3)
GO TO 172
C
C
C
200 IF(ICC.NE.2) WRITE(IDLG,201) NAMES(IB)
201 FORMAT(' ENTER RANGES TO BE USED FOR BREAKDOWN VAR: ',A5/)
I=1
203 IF(ICC.NE.2) WRITE(IDLG,204)
204 FORMAT('+? ',$)
READ(ICC,202,END=230) INPUT
202 FORMAT(20A1)
IF(INPUT(1).EQ.' ') GO TO 230
IF(INPUT(1).EQ.'!') RETURN
IF((INPUT(1).NE.'H').OR.(INPUT(2).NE.'E').OR.
1(INPUT(3).NE.'L').OR.(INPUT(4).NE.'P')) GO TO 206
WRITE(IDLG,205)
205 FORMAT('0ENTER RANGES, SMALLER FIRST SEPARATED BY A'/
1' COMMA, WITH NO SPACES. IF A NAME IS TO BE ASSOCIATED WITH A'/
2' GROUPING, FOLLOW THE RANGE WITH A COMMA AND THE NAME. IF'/
3' RANGES ARE TO BE AUTOMATICALLY CREATED FOR EACH VALUE IN THE'/
4' BREAKDOWN VARIABLE TYPE "AUTO".'/)
GO TO 200
206 IF((INPUT(1).EQ.'A').AND.(INPUT(2).EQ.'U').AND.
1(INPUT(3).EQ.'T').AND.(INPUT(4).EQ.'O')) GO TO 112
L=1
M=1
207 J=1
DO 208 K=1,10
208 NUMBER(K)=' '
210 IF(INPUT(M).EQ.',') GO TO 212
IF(INPUT(M).EQ.' ') GO TO 212
IF(INPUT(M).EQ.'E') GO TO 222
IF((INPUT(M).GE.'0').AND.(INPUT(M).LE.'9')) GO TO 222
IF((INPUT(M).EQ.'-').AND.(J.EQ.1)) GO TO 222
WRITE(IDLG,209) INPUT(M)
209 FORMAT(' CHARACTER ',A1,' NOT LEGAL IN RANGE'/)
GO TO 203
222 IF(J.GT.10) GO TO 211
NUMBER(J)=INPUT(M)
J=J+1
211 M=M+1
GO TO 210
212 IF(NUMBER(10).NE.' ') GO TO 214
DO 213 K=9,1,-1
213 NUMBER(K+1)=NUMBER(K)
NUMBER(1)='0'
GO TO 212
214 ENCODE(10,202,VALUE) NUMBER
DECODE(10,247,VALUE) XBRK(I,L)
247 FORMAT(F10.0)
L=L+1
IF(L.GT.2) GO TO 244
IF(INPUT(M).EQ.',') GO TO 246
WRITE(IDLG,245)
245 FORMAT(' USE A COMMA TO SEPARATE THE MAX AND MIN OF THE RANGE'/)
GO TO 203
246 M=M+1
GO TO 207
244 IF(INPUT(M).EQ.',') GO TO 216
221 ENCODE(5,215,XBRK(I,3)) I
215 FORMAT(2X,I2,1X)
GO TO 225
216 DO 217 K=1,5
217 NUMBER(K)=' '
M=M+1
J=1
219 IF(INPUT(M).EQ.' ') GO TO 220
IF(J.GT.5) GO TO 218
NUMBER(J)=INPUT(M)
J=J+1
218 M=M+1
IF(M.LE.20) GO TO 219
220 IF(J.LE.1) GO TO 221
ENCODE(5,202,XBRK(I,3))(NUMBER(J),J=1,5)
225 I=I+1
IF(I.LE.20) GO TO 203
WRITE(IDLG,226)
226 FORMAT(' MAXIMUM OF 20 TREATMENTS AND COVARIATES')
GO TO 200
230 NT=I-1
IF(NT.GT.1) GO TO 232
238 WRITE(IDLG,231)
231 FORMAT(' NO TREATMENTS SPECIFIED; FOR HELP TYPE HELP')
GO TO 200
C
C GO THROUGH THE DATA SET FO_R EACH TREATMENT WHEN AN ELEMENT EXISTS
C IN ONE OF THE RANGESAPPEND IT TO THE LIST (IV) AND ADD 1 TO
C THE COUNT
C
232 L=1
M=1
241 J=1
233 NX(L)=0
236 XDAT=DATA(J,IB)
IF(XDAT.GE.XBRK(L,1)) GO TO 234
GO TO 235
234 IF(XDAT.LE.XBRK(L,2)) GO TO 242
235 J=J+1
IF(J.LE.NC) GO TO 236
IF(NX(L).GT.1) GO TO 240
WRITE(IDLG,248) XBRK(L,3)
248 FORMAT(' TREATMENT ',A5,' HAS NO OBSERVATIONS - ILLIMINATED')
IF(L.GE.NT) GO TO 239
DO 237 I=L+1,NT
DO 237 K=1,3
237 XBRK(I-1,K)=XBRK(I,K)
239 NT=NT-1
GO TO 243
240 L=L+1
243 IF(L.LE.NT) GO TO 241
GO TO 172
242 IV(M)=J
M=M+1
NX(L)=NX(L)+1
GO TO 235
172 IF(ICC.NE.2) WRITE(IDLG,170)
170 FORMAT('0LIST COVARIATES SEPARATED BY COMMAS'/)
CALL ALPHA (IC,20,NCOV,IRET,IHELP,IERR,NAMES,NV)
IF(IRET.EQ.1) RETURN
IF(IERR.EQ.1) GO TO 172
IF(IHELP.NE.1) GO TO 173
WRITE(IDLG,174)
174 FORMAT('0ENTER THE COVARIATES TO BE USED SEPARATED BY COMMAS.'/
1' THEY WILL BE GROUPED BY THE BREAKDOWN VARIABLE IN THE SAME '/
2' MANNER AS THE VARIABLE BEING ANALYSED.'/)
GO TO 172
173 IF((NT+NCOV).LE.20) GO TO 175
WRITE(IDLG,171) NT,NCOV
171 FORMAT(' MAXIMUM OF 20 COVARIATES AND TREATMENTS')
GO TO 172
175 DO 176 I=1,NCOV
176 NMCOV(I)=NAMES(IC(I))
LAST=NT+NCOV
DO 179 MM=1,NN
DO 178 I=1,LAST
XSUM(I)=0
DO 178 J=1,LAST
XBAR(I,J)=0
178 XPROD(I,J)=0
NTOT=0
DO 180 I=1,NT
LVAR=I+NCOV
DO 181 J=1,NCOV+NT
181 XS(J)=0
NZ=NX(I)
DO 182 J=1,NZ
JVAR=IV(NTOT+J)
XS(NCOV+NT)=XS(NCOV+NT)+DATA(JVAR,IX(MM))
DO 183 K=1,NCOV
XS(K)=XS(K)+DATA(JVAR,IC(K))
DO 184 L=1,K
184 XPROD(K,L)=XPROD(K,L)+DATA(JVAR,IC(K))*DATA(JVAR,IC(L))
XPROD(LAST,K)=XPROD(LAST,K)+DATA(JVAR,IC(K))*DATA(JVAR,IX(MM))
IF(I.NE.NT)XPROD(LVAR,K)=XPROD(LVAR,K)+DATA(JVAR,IC(K))
183 CONTINUE
XPROD(LAST,LAST)=XPROD(LAST,LAST)+DATA(JVAR,IX(MM))**2
IF(I.NE.NT)XPROD(LAST,LVAR)=XPROD(LAST,LVAR)+DATA(JVAR,IX(MM))
182 CONTINUE
DO 185 K=1,NCOV
XSUM(K)=XSUM(K)+XS(K)
185 XBAR(K,I)=XS(K)/NZ
XBAR(NCOV+NT,I)=XS(NCOV+NT)/NZ
XSUM(NCOV+NT)=XSUM(NCOV+NT)+XS(NCOV+NT)
NTOT=NTOT+NZ
IF(I.NE.NT) XPROD(LVAR,LVAR)=NZ
IF(I.NE.NT) XSUM(LVAR)=NZ
180 CONTINUE
IF(IOUT.NE.21) WRITE(IOUT,5566) (HEDR(I),I=1,NSZ)
5566 FORMAT('1',70A1)
IF(IOUT.EQ.21) CALL PRNTHD
WRITE(IOUT,186) NAMES(IX(MM)),NAMES(IB)
186 FORMAT('0',17X,'***** 1-WAY ANOCOV *****'/
1' ANALYSIS ON VARIABLE: ',A5,' WITH TREATMENTS DETERMINED'/
2' BY A BREAKDOWN ON VARIABLE: ',A5,'; COVARIATES USED:')
LINES=6
IEND=0
COMMA=','
187 IF(IEND.GE.NCOV) GO TO 189
IBG=IEND+1
IEND=IEND+10
IF(IEND.GT.NCOV) IEND=NCOV
IF(IOUT.NE.21) GO TO 301
LINES=LINES+1
IF(LINES.LE.LINPP) GO TO 301
CALL PRNTHD
LINES=3
301 IF((IEND-IBG).LT.1) WRITE(IOUT,188) NAMES(IC(IBG))
188 FORMAT(1X,10(A5,A1,1X))
IF((IEND-IBG).GE.1) WRITE(IOUT,188) NAMES(IC(IBG)),(COMMA,
1NAMES(IC(J)),J=IBG+1,IEND)
GO TO 187
189 CALL OUTPUT(NT,NCOV,NX,XSUM,XBAR,XPROD,XBRK(1,3),NMCOV,LINES)
179 CONTINUE
4 RETURN
END
C **** STAT PACK ****
C ROUTINE IS PART OF ONE WAY ANOC. USED FOR OUTPUT.
C CALLING SEQUENCE: CALL OUTPUT(NT,NCOV,NX,XSUM,XBAR,XPROD,XBRK,NMCOV,LINES)
C WHERE NT - NUMBER OF TREATMENTS.
C NCOV - NUMBER OF COVARIATES.
C NX - VECTOR CONTAINING SIZES FOR EACH TREATMENT.
C XSUM - VECTOR CONTAINING SUMS FOR EACH TREATMENT.
C XBAR - MATRIX CONTAINING MEANS FOR TREATMENT COVARIATE
C COMBINATIONS.
C XPROD - MATRIX CONTAINING CROSS PRODUCTS.
C XBRK - VECTOR CONTAINING TREATMENT NAMES.
C NMCOV - VECTOR CONTAINING COVARIATE NAMES.
C
C ROUTINE IS FOR OUTPUT OF CALCULATED VALUES FOR ANALYSIS OF COVARIANCE.
C
SUBROUTINE OUTPUT(NT,NCOV,NX,XSUM,XBAR,XPROD,XBRK,NMCOV,LINES)
DIMENSION NX(1),XSUM(1),XBRK(1),XBAR(20,20),XPROD(20,20)
DIMENSION EINV(20,20),E(20,20),F(20),XA(20),NMCOV(1)
DIMENSION GOOD(20),XAVG(20)
COMMON /DEV/ ICC,IDATA,IOUT,IDLG,IDSK
COMMON /PRNT/ LINPP,ICOPS,RUNPRG
COMMON /EXTRA/ HEDR(70),NSZ
LAST=NCOV+NT
NN=LAST-1
NTOT=0
DO 1 I=1,NT
1 NTOT=NTOT+NX(I)
DO 2 I=2,LAST
DO 2 J=1,I-1
2 XPROD(J,I)=XPROD(I,J)
DO 3 I=1,LAST
DO 3 J=1,LAST
3 XPROD(I,J)=XPROD(I,J)-(XSUM(I)*XSUM(J))/NTOT
DO 4 I=1,NN
DO 14 J=1,NN
E(I,J)=XPROD(I,J)
EINV(I,J)=0
14 CONTINUE
4 EINV(I,I)=1.
C
C INVERSE
CALL INVRS(E,EINV,NN,IERROR)
IF(IERROR.EQ.1) GO TO 200
DO 20 I=1,NN
20 F(I)=0
DO 21 I=1,NN
DO 21 J=1,NN
21 F(I)=F(I)+XPROD(LAST,J)*EINV(J,I)
R1=0
DO 22 I=1,NN
22 R1=R1+F(I)*XPROD(I,LAST)
E1=XPROD(LAST,LAST)-R1
EM1=E1/(NTOT-NCOV-NT)
DO 30 I=1,NCOV
DO 31 J=1,NCOV
EINV(I,J)=0
31 E(I,J)=XPROD(I,J)
30 EINV(I,I)=1.0
C
C INVERSE
C
CALL INVRS(E,EINV,NCOV,IERROR)
IF(IERROR.EQ.1) GO TO 200
DO 50 I=1,NCOV
50 GOOD(I)=0
DO 51 I=1,NCOV
DO 51 J=1,NCOV
51 GOOD(I)=GOOD(I)+XPROD(J,LAST)*EINV(I,J)
R2=0
DO 52 I=1,NCOV
52 R2=R2+GOOD(I)*XPROD(LAST,I)
R3=R1-R2
RM=R3/(NT-1)
FV=RM/EM1
T1=R3+E1
DO 55 I=1,LAST
55 XAVG(I)=XSUM(I)/NTOT
DO 56 I=1,NT
SUM=0
DO 57 J=1,NCOV
57 SUM=SUM+F(J)*(XBAR(J,I)-XAVG(J))
56 XA(I)=XBAR(LAST,I)-SUM
K1=NT-1
NNT=NTOT-NT-NCOV
NTT=NNT+K1
PROB=FISHER(K1,NNT,FV)
NPL=5
IF(IOUT.EQ.21) NPL=10
IEND=NPL-2
IF(IEND.GT.NCOV) IEND=NCOV
IF(IOUT.NE.21) GO TO 101
LINES=LINES+3
IF(LINES.LE.(LINPP-3)) GO TO 101
CALL PRNTHD
LINES=5
101 WRITE(IOUT,70)(NMCOV(I),I=1,IEND)
70 FORMAT('0',11X,'UNADJUSTED ADJUSTED',18X,'COVARIATE MEANS'/
1' TREAT SIZE MEAN',8X,'MEAN',9X,7(1X,A5,6X),1X,A5)
DO 71 I=1,NT
IF(IOUT.NE.21) GO TO 71
LINES=LINES+1
IF(LINES.LE.LINPP) GO TO 71
CALL PRNTHD
WRITE(IOUT,70)(NMCOV(J),J=1,IEND)
LINES=6
71 WRITE(IOUT,72) XBRK(I),NX(I),XBAR(LAST,I),XA(I),
1(XBAR(J,I),J=1,IEND)
72 FORMAT(1X,A5,1X,I4,1X,G11.3,1X,G11.3,2X,7(G11.3,1X),G11.3)
IF(IOUT.NE.21) GO TO 102
LINES=LINES+4
IF(LINES.LE.LINPP) GO TO 102
CALL PRNTHD
WRITE(IOUT,70)(NMCOV(J),J=1,IEND)
LINES=9
102 WRITE(IOUT,90) XSUM(LAST),(XSUM(J),J=1,IEND)
90 FORMAT('0*TOTALS',4X,G11.3,14X,7(G11.3,1X),G11.3)
WRITE(IOUT,91) XAVG(LAST),(XAVG(J),J=1,IEND)
91 FORMAT(' *AVERAGE',3X,G11.3,14X,7(G11.3,1X),G11.3)
WRITE(IOUT,73)(F(J),J=1,IEND)
73 FORMAT(' *BETA WEIGHTS',24X,7(G11.3,1X),G11.3)
75 IF(IEND.LE.NCOV) GO TO 80
IBG=IEND+1
IEND=IEND+NPL
IF(IEND.GT.NCOV) IEND=NCOV
IF(IOUT.NE.21) GO TO 103
LINES=LINES+4
IF(LINES.LE.(LINPP-3)) GO TO 103
CALL PRNTHD
LINES=6
103 WRITE(IOUT,76)(NMCOV(I),I=IBG,IEND)
76 FORMAT(//'0TREAT',9X,9(1X,A5,6X),1X,A5)
DO 77 I=1,NT
IF(IOUT.NE.21) GO TO 77
LINES=LINES+1
IF(LINES.LE.LINPP) GO TO 77
CALL PRNTHD
WRITE(IOUT,76)(NMCOV(J),J=IBG,IEND)
LINES=7
77 WRITE(IOUT,78) XBRK(I),(XBAR(J,I),J=IBG,IEND)
78 FORMAT(1X,A5,8X,9(G11.3,1X),G11.3)
IF(IOUT.NE.21) GO TO 104
LINES=LINES+4
IF(LINES.LE.LINPP) GO TO 104
CALL PRNTHD
WRITE(IOUT,76)(NMCOV(J),J=IBG,IEND)
LINES=11
104 WRITE(IOUT,92) (XSUM(J),J=IBG,IEND)
92 FORMAT('0*TOTALS',6X,9(G11.3,1X),G11.3)
WRITE(IOUT,93) (XAVG(J),J=IBG,IEND)
93 FORMAT(' *AVERAGE',5X,9(G11.3,1X),G11.3)
WRITE(IOUT,79)(F(J),J=IBG,IEND)
79 FORMAT(' *BETA WEIGHTS',9(G11.3,1X),G11.3)
GO TO 75
80 IF(IOUT.NE.21) GO TO 100
LINES=LINES+16
IF(LINES.LE.LINPP) GO TO 100
CALL PRNTHD
LINES=17
100 WRITE(IOUT,81)
81 FORMAT(////'0',24X,'1 WAY ANOCOV'/'0 SOURCE',5X,'SUM OF SQUARES',
14X,'DF',4X,'MEAN SQUARES',3X,'F',11X,'PROB')
WRITE(IOUT,82) R3,K1,RM,FV,PROB
82 FORMAT('0BETWEEN'/' ADJUSTED',4X,G15.7,2X,I4,4X,G12.4,2X,
1G10.3,2X,F5.3/' TREATMENTS')
WRITE(IOUT,83) E1,NNT,EM1
83 FORMAT('0ERROR',7X,G15.7,2X,I4,4X,G12.4)
WRITE(IOUT,84) T1,NTT
84 FORMAT('0TOTAL',7X,G15.7,2X,I4)
RETURN
200 WRITE(IDLG,201)
201 FORMAT(' ERROR CANNOT INVERT MATRIX')
RETURN
END
C **** STAT PACK ****
C ROUTINE IS PART OF ONE WAY ANOC. USED FOR INVERSE.
C CALLING SEQUENCE: CALL INVRS(E,EINV,NN,IERROR)
C WHERE E - MATRIX CONTAINING DATA TO BE INVERTED.
C EINV - RESULT OF INVERSION (MATRIX).
C NN - NUMBER OF COLUMNS AND ROWS.
C IERROR - ERROR RETURN 0-OK, 1-CANNOT BE DONE.
C
C ROUTINE IS SIMPLE LINEAR ROW TRANSFORMATION FOR MATRIX INVERSE.
C
SUBROUTINE INVRS(E,EINV,NN,IERROR)
DIMENSION E(20,20),EINV(20,20)
IERROR=0
DO 5 I=1,NN
IF(((E(I,I)+100.)-100.).NE.0) GO TO 9
IF(I.EQ.NN) GO TO 200
DO 6 J=I+1,NN
IF(((E(J,I)+100.)-100.).NE.0.0) GO TO 7
6 CONTINUE
GO TO 200
7 DO 8 K=1,NN
E(I,K)=E(I,K)+E(J,K)
8 EINV(I,K)=EINV(I,K)+EINV(J,K)
9 G=E(I,I)
DO 10 J=1,NN
E(I,J)=E(I,J)/G
10 EINV(I,J)=EINV(I,J)/G
DO 12 L=1,NN
IF(L.EQ.I) GO TO 12
G=E(L,I)
DO 11 J=1,NN
E(L,J)=E(L,J)-G*E(I,J)
11 EINV(L,J)=EINV(L,J)-G*EINV(I,J)
12 CONTINUE
5 CONTINUE
RETURN
200 IERROR=1
RETURN
END