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