Google
 

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