C *** STAT PACK *** C SUBROUTINE FOR REGRESSIONS FROM SIMPLE TO MULTIPLE. C CALLING SEQUENCE: CALL STREGR(NV,NC,MV,MC,VMN,STD,COR,CO,DATA,NAMES) C WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES) C NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (OBSERVATIONS, C CASES) C MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN MAIN. C MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN MAIN. C VMN - IS A VECTOR CONTAINING THE VARIABLE MEANS. C STD - IS THE VARIABLE STANDARD DEVIATIONS. C COR - IS THE CORRELATION MATRIX. C CO - IS A VECTOR DIMENSIONED AT LEAST FOR NV. C DATA - IS STORAGE FOR DATA, DIMENSIONED FOR MAXIMUM MATRIX. C NAMES - IS A VECTOR CONTAINING VARIABLE NAMES C C THIS IS ONE OF THE FEW ORIGINAL SUBROUTINES WHICH ESCAPED C EXTENSIVE MODIFICATION. ALL THAT HAS BEEN CHANGED IS THE C INPUT AND INVERSE ROUTINES. IT USES THE CORRELATION MATRIX TO C CALCULATE THE REGRESSION. IT ALSO ALLOWS THE RESIDUALS TO BE C STORED AS A VARIABLE FOR FURTHER ANALYSIS. C SUBROUTINE STREGR(NV,NC,MV,MC,VMN,STD,COR,CO,DATA,NAMES) COMMON/DEV/ICC,IDATA,IOUT,IDLG,IDSK COMMON /PRNT/ LINPP,ICOPS,RUNPRG COMMON /EXTRA/HEDR(70),NSZ DIMENSION IV(20),NAMES(1),IVA(20),OPT(3) DIMENSION COR(MV,MV),DATA(MC,MV),VMN(1),STD(1) DIMENSION VAR(20),F1(19),F2(19),RC(19),SERC(19) DIMENSION CO(1),DCOR(20,20),SDA(20),XVER(20,20) DATA YES/3HYES/ 53 RESID=0 IF(ICC.NE.2) WRITE(IDLG,51) 51 FORMAT(' ENTER OPTIONS SEPARATED BY COMMAS'/) READ(ICC,52) OPT 52 FORMAT(5(A5,1X)) IF(OPT(1).EQ.'!') RETURN DO 58 I=1,3 IF(OPT(I).EQ.' ') GOTO 59 IF(OPT(I).NE.'HELP') GO TO 55 WRITE(IDLG,54) 54 FORMAT(' ONLY OPTION AVAILABLE IS:'/ 1' "RESID" - SAVE RESIDUALS') GO TO 53 55 IF(OPT(I).NE.'RESID') GO TO 56 RESID=1 GO TO 58 56 WRITE(IDLG,57) OPT(I) 57 FORMAT(' OPTION "',A5,'" DOES NOT EXIST') GO TO 53 58 CONTINUE 59 IF(RESID.NE.1) GO TO 996 IF(ICC.NE.2) WRITE(IDLG,62) 62 FORMAT(' WHICH VARIABLE ARE THE RESIDUALS TO BE STORED UNDER? ',$) CALL ALPHA(IX,1,NI,IRET,IHELP,IERR,NAMES,MV) IF(IRET.EQ.1) RETURN IF(IERR.EQ.1) GOTO 59 IF(IHELP.NE.1) GO TO 65 WRITE(IDLG,64) 64 FORMAT(' ENTER THE VARIABLE NAME OR NUMBER OF THE VARIABLE'/ 1' TO BE USED FOR STOREING THE RESIDUALS. THE NAME GIVEN'/ 2' THE VARIABLE WILL BE "RESID"') GO TO 59 65 IF(IX.GT.0) GO TO 63 WRITE(IDLG,66) 66 FORMAT(' *, ?, OR ALL MAY NOT BE USED HERE') GO TO 59 63 IF(IX.LE.NV) GO TO 996 IX=NV+1 NV=IX IF(NV.GT.MV) PAUSE 996 IF(ICC.NE.2) WRITE(IDLG,101) 101 FORMAT('0LIST THE INDEPENDENT VARIABLES?'/) CALL ALPHA(IVA,19,NI,IRET,IHELP,IERR,NAMES,NV) IF(IRET.EQ.1) RETURN IF(IERR.EQ.1) GO TO 996 IF(IHELP.NE.1) GO TO 9 GO TO 996 9 K=1 DO 1 I=1,NI IV(I)=IVA(I) IF(IVA(I).GT.0) GO TO 1 IV(I)=K K=K+1 1 CONTINUE DO 2 I=1,NI-1 IF(IVA(I).LT.0) GO TO 2 DO 5 J=I+1,NI IF(IVA(J).LT.0) GO TO 5 IF(IVA(I).NE.IVA(J)) GO TO 5 WRITE(IDLG,3) 3 FORMAT(' THE SAME INDEP. VAR. HAS BEEN LISTED TWICE') GO TO 996 5 CONTINUE 2 CONTINUE IF((NI+1).LE.NV) GO TO 19 WRITE(IDLG,4) 4 FORMAT(' YOU HAVE LISTED MORE VARIABLES THAN IS POSSIBLE'/ 1' WITH THE DATA SET AVAILABLE') GO TO 996 19 IF(ICC.NE.2) WRITE(IDLG,102) 102 FORMAT(' WHICH IS THE DEPENDENT VARIABLE? ',$) NN=NI+1 CALL ALPHA(IY,1,J,IRET,IHELP,IERR,NAMES,NV) IF(IRET.EQ.1) RETURN IF(IERR.EQ.1) GO TO 19 IF(IHELP.EQ.1) GO TO 19 IVA(NN)=IY IV(NN)=IVA(NN) IF(IVA(NN).LT.0) IV(NN)=1 J=NI IF(IVA(NN).LT.0) GOTO 18 DO 6 J=1,NI IF(IVA(J).LT.0) GO TO 6 IF(IVA(J).NE.IVA(NN)) GO TO 6 WRITE(IDLG,7) 7 FORMAT(' THE DEPENDENT VARIABLE ALSO EXISTS AS AN INDEP. VAR.') GO TO 996 6 CONTINUE GO TO 18 C C ******************************************************** C C HERE THE DATA IS SET UP REPLACEING *,?, AND ALL WITH VALID VAR. C 10 J=NI 14 IF(IVA(J).GT.0) GO TO 15 IV(J)=IV(J)+1 IF(IV(J).LE.NV) GO TO 16 15 J=J-1 IF(J.GE.1) GO TO 14 IF(IVA(NN).GT.0) RETURN IV(NN)=IV(NN)+1 IF(IV(NN).GT.NV) RETURN K=1 DO 12 I=1,NI IF(IVA(I).GT.0) GO TO 12 IV(I)=K K=K+1 12 CONTINUE J=NI GO TO 18 16 K=IV(J) IF(J.EQ.NI) GO TO 18 DO 17 I=J+1,NI IF(IVA(I).GT.0) GO TO 17 K=K+1 IF(K.GT.NV) GO TO 15 IV(I)=K 17 CONTINUE 18 DO 13 I=1,NI DO 13 K=I+1,NN IF(IV(I).EQ.IV(K)) GO TO 14 13 CONTINUE C C C *********************************************************** C IY=IV(NN) DO 20 I=1,NN K=IV(I) SDA(I)=STD(K) VAR(I)=STD(K)*STD(K) DO 20 J=I,NN L=IV(J) DCOR(I,J)=COR(K,L) 20 DCOR(J,I)=DCOR(I,J) DO 30 J=1,NI CC=DCOR(J,NN)*DCOR(J,NN) IF(CC.EQ.1.0) GO TO 170 30 F2(J)=CC*(NC-2.)/(1.-CC) C C ********************************************************* C INVERSE BY LINEAR ROW (NOT PARTICULARLY SOPHISTICATED) C DO 202 I=1,NN DO 201 J=1,NN 201 XVER(I,J)=0.0 202 XVER(I,I)=1.0 DO 210 I=1,NN IF(((DCOR(I,I)+100.)-100.).NE.0.0) GO TO 220 IF(I.EQ.NN) GO TO 190 DO 211 J=I+1,NN IF(((DCOR(J,I)+100.)-100.).NE.0.0) GO TO 212 211 CONTINUE GO TO 190 212 DO 213 K=1,NN DCOR(I,K)=DCOR(I,K)+DCOR(J,K) 213 XVER(I,K)=XVER(I,K)+XVER(J,K) 220 G=DCOR(I,I) DO 221 J=1,NN DCOR(I,J)=DCOR(I,J)/G 221 XVER(I,J)=XVER(I,J)/G DO 230 L=1,NN IF(L.EQ.I) GO TO 230 G=DCOR(L,I) DO 231 J=1,NN DCOR(L,J)=DCOR(L,J)-G*DCOR(I,J) 231 XVER(L,J)=XVER(L,J)-G*XVER(I,J) 230 CONTINUE 210 CONTINUE DO 250 I=1,NN DO 250 J=1,NN 250 DCOR(I,J)=XVER(I,J) C C *********************************************************** C CD=(DCOR(NN,NN)-1.)/DCOR(NN,NN) CC=DSQRT(DBLE(CD)) SST=VAR(NN)*(NC-1.) SSRG=CD*SST SSRS=(1.-CD)*SST RMS=SSRG/NI EMS=SSRS/(NC-NN) SEEST=DSQRT(DBLE(EMS)) FVAL=RMS/EMS DO 50 J=1,NI RC(J)=-1.0*DCOR(NN,J)/DCOR(NN,NN) SERC(J)=SEEST*DSQRT(DBLE(DCOR(J,J)+RC(J)*DCOR(NN,J))/ 1((NC-1.)*VAR(J))) RC(J)=RC(J)*SDA(NN)/SDA(J) 50 F1(J)=RC(J)*RC(J)/(SERC(J)*SERC(J)) SEE=DSQRT(DBLE(VAR(NN)/(NC-NN))) YINT=VMN(IV(NN)) DO 60 J=1,NI 60 YINT=YINT-RC(J)*VMN(IV(J)) IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(J),J=1,NSZ) 5566 FORMAT('1',70A1) IF(IOUT.EQ.21) CALL PRNTHD WRITE(IOUT,99) 99 FORMAT('0',10X,'***** MULTIPLE LINEAR REGRESSION *****') WRITE(IOUT,90)NC,NAMES(IY),(NAMES(IV(J)),J=1,NI) 90 FORMAT('0SAMPLE SIZE ',I3/' DEPENDENT VARIABLE: ',A5/ 1' INDEPENDENT VARIABLES:',6(2X,A5)/(23X,6(2X,A5))) WRITE(IOUT,91)CD,CC 91 FORMAT('0COEFFICIENT OF DETERMINATION ',F8.5/' MULTIPLE', 1' CORR COEFF. ',F8.5) WRITE(IOUT,98)YINT,SEEST 98 FORMAT('0ESTIMATED CONSTANT TERM',G16.8/' STANDARD ERROR OF ESTIMA 1TE ',G16.8) WRITE(IOUT,92) 92 FORMAT(/' ANALYSIS OF VARIANCE'/' FOR THE REGRESSION'/' SOURCE OF 1 VARIATION',3X,'DF',5X,'S. SQ.',6X,'M.S.',11X,'F',8X,'PROB') NDGN=NN-1 NDGD=NC-NN PROB=FISHER(NDGN,NDGD,FVAL) IDF=NN-1 WRITE(IOUT,93)IDF,SSRG,RMS,FVAL,PROB 93 FORMAT(6X,'REGRESSION',I9,G15.6,G12.6,G10.4,1X,F7.4) IDF=NC-NN WRITE(IOUT,94)IDF,SSRS,EMS 94 FORMAT(6X,'RESIDUALS',I10,G15.6,G12.6) IDF=NC-1 WRITE(IOUT,95)IDF,SST 95 FORMAT(6X,'TOTAL',I14,G15.6/) WRITE(IOUT,96) 96 FORMAT(7X,'REGRESSION',7X,'S. E. OF',3X,'F-VALUE',18X, 1'CORR.COEF.') IDF=NC-NN WRITE(IOUT,97)IDF,NAMES(IV(NN)) 97 FORMAT(' VAR.',2X,'COEFFICIENT',5X,'REG. COEF.',2X,'DF (1,', 1I4,')',2X,'PROB',8X,'WITH ',A5) LINES=23 DO 110 I=1,NI NDGN=1 NDGD=IDF PROB=FISHER(NDGN,NDGD,F1(I)) IF(IOUT.NE.21) GO TO 110 LINES=LINES+1 IF(LINES.LE.LINPP) GO TO 110 CALL PRNTHD WRITE(IOUT,96) WRITE(IOUT,97) IDF,NAMES(IV(NN)) LINES=5 110 WRITE(IOUT,111)NAMES(IV(I)),RC(I),SERC(I),F1(I),PROB,COR(IV(I), 1IV(NN)) 111 FORMAT(1X,A5,1X,G15.7,2X,G10.4,1X,G10.4,1X,F7.4,7X,F7.4) IF(RESID.EQ.0) GO TO 10 IF(IX.LE.NV) GO TO 300 IX=NV+1 NV=IX 300 NAMES(IX)='RESID' 120 DO 121 L=1,NV 121 CO(L)=0.0 DO 116 J=1,NC RES=DATA(J,IY)-YINT DO 115 K=1,NI 115 RES=RES-RC(K)*DATA(J,IV(K)) DATA(J,IX)=RES DO 116 L=1,NV 116 CO(L)=DATA(J,L)*RES+CO(L) VMN(IX)=0.0 STD(IX)=SQRT(SSRS/(NC-1.0)) DO 119 L=1,NV IF(L.EQ.IX) GO TO 118 IF(STD(L)*STD(IX).EQ.0.0) GO TO 117 COR(L,IX)=(CO(L)/((NC-1.)*STD(L)*STD(IX))) GO TO 119 117 COR(L,IX)=0.0 GO TO 119 118 COR(L,IX)=1.0 119 COR(IX,L)=COR(L,IX) GO TO 10 170 WRITE(IDLG,171)NAMES(IV(J)) 171 FORMAT('0DEPENDENT VAR LINEAR FUNCTION OF VAR ',A5/' REGRESSION IG 1NORED') GO TO 10 190 WRITE(IDLG,191) 191 FORMAT('0DEP VAR LINEAR FUNCTION OF INDEP VARS, ALL RESIDUALS EQUA 1L ZERO') GO TO 10 END C *** STAT PACK *** C SUBROUTINE TO CALCULATE PERCENTILES. C CALLING SEQUENCE: CALL STPCNT(NV,NC,MV,MC,DATA,AV,NAMES) C WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES) C NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (OBSERVATIONS, C CASES) C MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN MAIN. C MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN MAIN. C DATA - IS STORAGE FOR DATA, DIMENSIONED FOR MAXIMUM MATRIX. C AV - IS AN ADDITIONAL VECTOR DIMENSIONED AT LEAST NC. C NAMES - VECTOR CONTAINING VARIABLE NAMES C C BINARY INSERTION SORT, THEN CALCULATE PERCENTILES. COMMANDS C "DEC" FOR DECILES, AND "QTR" FOR QUARTILES MAY ALSO BE GIVEN. C SUBROUTINE STPCNT(NV,NC,MV,MC,DATA,AV,NAMES) COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK COMMON /PRNT/ LINPP,ICOPS,RUNPRG COMMON/EXTRA/HEDR(70),NSZ DIMENSION DATA(MC,MV),AV(1),STRG(20),CENT(20,10),IVARB(20) DIMENSION IVOUT(20),NAMES(1) C C THE FOLLOWING DIMENSIONS ARE FOR THE SORT IL(16), IU(16) C DIMENSION IL(16),IU(16) INTEGER BASE NIND=5 IF(IOUT.EQ.21) NIND=10 ALL=0 1 IF(ICC.NE.2) WRITE(IDLG,2) 2 FORMAT('OWHICH VARIABLES? ',$) CALL ALPHA(IVARB,20,NN,IRET,IHELP,IERR,NAMES,NV) IF(IRET.EQ.1) RETURN IF(IERR.EQ.1) GO TO 1 IF(IHELP.EQ.1) GO TO 1 DO 3 I=1,NN IF(IVARB(I).GT.0) GO TO 3 ALL=1 NN=NV GO TO 19 3 CONTINUE 19 IF(NN.LE.0) GO TO 1 IF(ICC.NE.2) WRITE(IDLG,6) 6 FORMAT('0TYPE IN PERCENTILES YOU WISH TO HAVE, SEPARATED', 1' BY COMMAS'/) 9 READ(ICC,7)ANS 7 FORMAT(A4) IF(ANS.EQ.'!') RETURN IF(ANS.EQ.'HELP') WRITE (IDLG,8) 8 FORMAT('0PERCENTILES CAN BE ENTERED INDIVIDUALLY OR THEY'/ 1' CAN BE FOUND IN DECILES BY TYPING "DEC", OR QUARTILES'/ 2' BY TYPING "QTR"') IF(ANS.EQ.'HELP') GO TO 19 IF(ANS.NE.'DEC') GO TO 10 ND=9 STRG(1)=10 STRG(2)=20 STRG(3)=30 STRG(4)=40 STRG(5)=50 STRG(6)=60 STRG(7)=70 STRG(8)=80 STRG(9)=90 GO TO 16 10 IF(ANS.NE.'QTR') GO TO 11 ND=3 STRG(1)=25 STRG(2)=50 STRG(3)=75 GO TO 16 11 REREAD 12,(STRG(I),I=1,20) 12 FORMAT(20F) DO 13 I=1,20 IF(STRG(I).EQ.0) GO TO 15 IF((STRG(I).LT.100).AND.(STRG(I).GT.0)) GO TO 13 WRITE(IDLG,14) STRG(I) 14 FORMAT('0PERCENTILE',G9.3,' NOT POSSIBLE') GO TO 19 13 CONTINUE 15 ND=I-1 16 IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(I),I=1,NSZ) 5566 FORMAT('1',70A1) IF(IOUT.EQ.21) CALL PRNTHD LINES=2 C ********************************************************** C ACM SORT C DO 20 I=1,NN,NIND MAX=I+NIND-1 IF(MAX.GT.NN) MAX=NN NMAX=MAX-I+1 DO 21 N=I,MAX IVAR=N IF(ALL.EQ.0) IVAR=IVARB(N) INDEX=(N-I)+1 IVOUT(INDEX)=IVAR DO 70 J=1,NC 70 AV(J)=DATA(J,IVAR) M=1 II=1 J=NC 71 IF(II.GE.J) GO TO 78 72 K=II IJ=(J+II)/2 T=AV(IJ) IF(AV(II).LE.T) GO TO 73 AV(IJ)=AV(II) AV(II)=T T=AV(IJ) 73 LL=J IF(AV(J).GE.T) GO TO 75 AV(IJ)=AV(J) AV(J)=T T=AV(IJ) IF(AV(II).LE.T) GOTO 75 AV(IJ)=AV(II) AV(II)=T T=AV(IJ) GO TO 75 74 AV(LL)=AV(K) AV(K)=TT 75 LL=LL-1 IF(AV(LL).GT.T) GO TO 75 TT=AV(LL) 76 K=K+1 IF(AV(K).LT.T) GOTO 76 IF(K.LE.LL) GOTO 74 IF((LL-II).LE.(J-K)) GO TO 77 IL(M)=II IU(M)=LL II=K M=M+1 GO TO 79 77 IL(M)=K IU(M)=J J=LL M=M+1 GO TO 79 78 M=M-1 IF(M.EQ.0) GO TO 90 II=IL(M) J=IU(M) 79 IF((J-II).GE.11) GO TO 72 IF(II.EQ.1) GO TO 71 II=II-1 80 II=II+1 IF(II.EQ.J) GO TO 78 T=AV(II+1) IF(AV(II).LE.T) GO TO 80 K=II 81 AV(K+1)=AV(K) K=K-1 IF(T.LT.AV(K)) GO TO 81 AV(K+1)=T GO TO 80 90 C=NC DO 40 J=1,ND Y=STRG(J) X=(Y*C*.01)+.5 K=X IF((K.LE.0).OR.(K.GE.NC)) GO TO 40 Y=K YY=X-Y CENT(J,INDEX)=((AV(K+1)-AV(K))*YY)+AV(K) 40 CONTINUE 21 CONTINUE AVAR='VAR' IF(IOUT.NE.21) GO TO 47 LINES=LINES+4 IF(LINES.LE.(LINPP-5)) GO TO 47 CALL PRNTHD LINES=6 47 WRITE(IOUT,41)(NAMES(IVOUT(J)),J=1,NMAX) 41 FORMAT('0',20X,'***** PERCENTILES *****'/'0',26X,'VARIABLES'/ 1' PERCENTILE',4X,10(1X,A5,5X)) MINUS='-----' WRITE(IOUT,42)((MINUS,J=1,3),K=1,NMAX) 42 FORMAT(1X,10('-'),4X,10(A5,A5,A1)) DO 43 J=1,ND Y=STRG(I) X=(Y*C*.01)+.5 K=X IF(IOUT.NE.21) GO TO 48 LINES=LINES+1 IF(LINES.LE.LINPP) GO TO 48 CALL PRNTHD WRITE(IOUT,41)(NAMES(IVOUT(KJ)),KJ=1,NMAX) WRITE(IOUT,42)((MINUS,JK=1,3),KJ=1,NMAX) LINES=6 48 IF((K.LE.0).OR.(K.GE.NC)) GO TO 44 WRITE(IOUT,45) STRG(J),(CENT(J,K),K=1,NMAX) 45 FORMAT(1X,F6.2,8X,10(G10.4,1X)) GO TO 43 44 WRITE(IOUT,46) STRG(J) 46 FORMAT(1X,F6.2,8X,'CANNOT BE FOUND') 43 CONTINUE LINES=LINES+1 IF((LINES.GT.LINPP).AND.(IOUT.EQ.21)) GO TO 20 WRITE(IOUT,49) 49 FORMAT(1X) 20 CONTINUE RETURN END C *** STAT PACK *** C SUBROUTINE TO OUTPUT SPECIFIED VARIABLES ON TERMINAL. C CALLING SEQUENCE: CALL STTYPE(NV,NC,MV,MC,DATA,IV,NAMES) C WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES) C NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (OBSERVATIONS, C CASES) C MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN MAIN. C MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN MAIN. C DATA - IS STORAGE FOR DATA, DIMENSIONED FOR MAXIMUM MATRIX. C IV - IS A VECTOR DIMENSIONED AT LEAST NV. C NAMES - IS A VECTOR CONTAINING VARIABLE NAMES C C USER SPECIFIES HOW MANY VARIABLES ARE TO BE OUTPUT, AND WHICH C ONES, AND THE PROGRAM OUTPUTS THESE TO THE TERMINAL. C SUBROUTINE STTYPE(NV,NC,MV,MC,DATA,IV,NAMES) COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK COMMON/EXTRA/HEDR(70),NSZ DIMENSION DATA(MC,MV),IV(1),NAMES(1) 2 IF(ICC.NE.2) WRITE(IDLG,1) 1 FORMAT(' WHICH VARIABLES? ',$) CALL ALPHA(IV,NV,N,IRET,IHELP,IERR,NAMES,NV) IF(IRET.EQ.1) RETURN IF(IERR.EQ.1) GO TO 2 IF(IHELP.EQ.1) GO TO 2 3 DO 5 I=1,N IF(IV(I).LT.0) GO TO 20 5 CONTINUE DO 6 I=1,N IF((IV(I).GT.0).AND.(IV(I).LE.NV)) GO TO 6 WRITE(IDLG,4) IV(I) 4 FORMAT('0VARIABLE',I4,' NOT POSSIBLE'/' TRY AGAIN') GO TO 5 6 CONTINUE GO TO 22 20 N=NV DO 21 I=1,NV 21 IV(I)=I 22 WRITE(IDLG,5566)(HEDR(I),I=1,NSZ) 5566 FORMAT('1',70A1) WRITE (IDLG,7) (NAMES(IV(I)),I=1,N) 7 FORMAT(1H0,9X,'VAR'/' OBS',6(3X,A5,3X)/(4X,6(3X,A5,3X))) DO 8 I=1,NC 8 WRITE(IDLG,9) I,(DATA(I,IV(J)),J=1,N) 9 FORMAT(1H0,I3,1X,6(1X,G10.4)/(5X,6(1X,G10.4))) RETURN END C *** STAT PACK *** C SUBROUTINE TO CALCULATE Z-SCORES. C CALLING SEQUENCE: CALL STZSC(NV,NC,MV,MC,DATA,VMN,STD,AV,NAMES) C WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES) C NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (OBSERVATIONS, C CASES) C MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN MAIN. C MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN MAIN. C DATA - IS STORAGE FOR DATA, DIMENSIONED FOR MAXIMUM MATRIX. C VMN - IS A VECTOR CONTAINING THE VARIABLE MEANS C STD - IS A VECTOR CONTAINING THE VARIABLE STANDARD DEVIATIONS. C AV - IS A VECTOR DIMENSIONED AT LEAST NV. C NAMES - IS A VECTOR CONTAINING VARIABLE NAMES C C SUBROUTINE OUTPUTS VALUES IN ORDER FOLLOWED BY FREQUENCIES, C AND FINALLY THE Z SCORE. BINARY INSERTION SORT USED FOR C SORTING VALUES IN ORDER IN VECTOR AV, ALLOWING DATA TO REMAIN C UNCHANGED. C SUBROUTINE STZSC(NV,NC,MV,MC,DATA,VMN,STD,AV,NAMES) DIMENSION DATA(MC,MV),VMN(1),STD(1),AV(1),IVAR(40),NAMES(1) C C THIS DIMENSION FOR SORTING ONLY C DIMENSION IU(16),IL(16) COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK COMMON /PRNT/ LINPP,ICOPS,RUNPRG COMMON/EXTRA/HEDR(70),NSZ INTEGER BASE ALL=0 21 IF(ICC.NE.2) WRITE(IDLG,1) 1 FORMAT('0WHICH VARIABLES? ',$) CALL ALPHA(IVAR,40,NN,IRET,IHELP,IERR,NAMES,NV) IF(IRET.EQ.1) RETURN IF(IERR.EQ.1) GO TO 21 IF(IHELP.EQ.1) GO TO 21 DO 3 I=1,NN IF(IVAR(I).GT.0) GO TO 3 ALL=1 NN=NV GO TO 25 3 CONTINUE 50 I=0 51 I=I+1 52 IF(I.GT.NN) GO TO 25 22 IF(STD(IVAR(I)).NE.0) GO TO 51 WRITE(IDLG,24) NAMES(IVAR(I)) 24 FORMAT('0Z-SCORES UNDEFINED VARIABLE ',A5,' -- ST. DEV. OF ZERO') IF(I.EQ.NN) GOTO 43 DO 42 J=I,NN-1 42 IVAR(J)=IVAR(J+1) 43 IVAR(NN)=0 NN=NN-1 GO TO 52 40 CONTINUE C C ************************************************************** C ACM SORT (PARTITIONING) 25 DO 45 I=1,NN IF(ALL.EQ.1) GO TO 46 N=IVAR(I) GO TO 47 46 IF(STD(I).EQ.0) GO TO 45 N=I 47 DO 70 J=1,NC 70 AV(J)=DATA(J,N) M=1 II=1 J=NC 71 IF(II.GE.J) GO TO 78 72 K=II IJ=(J+II)/2 T=AV(IJ) IF(AV(II).LE.T) GO TO 73 AV(IJ)=AV(II) AV(II)=T T=AV(IJ) 73 LL=J IF(AV(J).GE.T) GO TO 75 AV(IJ)=AV(J) AV(J)=T T=AV(IJ) IF(AV(II).LE.T) GO TO 75 AV(IJ)=AV(II) AV(II)=T T=AV(IJ) GO TO 75 74 AV(LL)=AV(K) AV(K)=TT 75 LL=LL-1 IF(AV(LL).GT.T) GO TO 75 TT=AV(LL) 76 K=K+1 IF(AV(K).LT.T) GO TO 76 IF(K.LE.LL) GO TO 74 IF((LL-II).LE.(J-K)) GO TO 77 IL(M)=II IU(M)=LL II=K M=M+1 GO TO 79 77 IL(M)=K IU(M)=J J=LL M=M+1 GO TO 79 78 M=M-1 IF(M.EQ.0) GO TO 90 II=IL(M) J=IU(M) 79 IF((J-II).GE.11) GO TO 72 IF(II.EQ.1) GO TO 71 II=II-1 80 II=II+1 IF(II.EQ.J) GO TO 78 T=AV(II+1) IF(AV(II).LE.T) GO TO 80 K=II 81 AV(K+1)=AV(K) K=K-1 IF(T.LT.AV(K)) GO TO 81 AV(K+1)=T GO TO 80 C C ************************************:::::::::*************** C FREQUENCY AND Z-SCORE 90 IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(J),J=1,NSZ) 5566 FORMAT('1',70A1) IF(IOUT.EQ.21) CALL PRNTHD WRITE(IOUT,34) NAMES(N) 34 FORMAT('0',10X,'***** Z SCORES FOR VARIABLE: ',A5,' *****') WRITE(IOUT,30) 30 FORMAT('0',5X,'VALUE',7X,'FREQUENCY',6X,'Z-SCORE') LINES=6 XNUM=AV(1) NUM=1 DO 31 J=2,NC IF(XNUM.EQ.AV(J)) GO TO 33 Z=(XNUM-VMN(N))/STD(N) IF(IOUT.NE.21) GO TO 35 LINES=LINES+1 IF(LINES.LE.LINPP) GO TO 35 CALL PRNTHD WRITE(IOUT,30) LINES=5 35 WRITE(IOUT,32)XNUM,NUM,Z 32 FORMAT(1X,G15.7,4X,I4,5X,G15.7) XNUM=AV(J) NUM=1 GO TO 31 33 NUM=NUM+1 31 CONTINUE Z=(XNUM-VMN(N))/STD(N) IF(IOUT.NE.21) GO TO 36 LINES=LINES+1 IF(LINES.LE.LINPP) GO TO 36 CALL PRNTHD WRITE(IOUT,30) LINES=5 36 WRITE(IOUT,32)XNUM,NUM,Z 45 CONTINUE RETURN END C *** STAT PACK *** C SUBROUTINE TO OUTPUT INFORMATION ABOUT STAT PACK ON REQUEST. C CALLING SEQUENCE: CALL STINFO C SUBROUTINE STINFO COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK WRITE (IDLG,1) WRITE (IDLG,2) WRITE (IDLG,3) 1 FORMAT('0STAT PACK IS AN INTEGRATED STATISTICAL PACKAGE,', 1' WRITTEN FOR'/' TERMINAL USE. IT ALLOWS THE USER TO ', 2'ISSUE SIMPLE COMMANDS'/' FOR DATA ANALYSIS. THE', 3' PROGRAM IS IN CONVERSATIONAL MODE AND'/' WILL', 4' PROMPT THE USER FOR DESIRED INFORMATION. IN MOST', 5' INSTANCES'/' WHEN QUESTIONS OF PROCEDURE ARISE THE ', 6' USER MAY REQUEST FURTHER'/' INFORMATION, BY SIMPLY', 7' TYPING "HELP". STANDARD FORM OF OUTPUT'/' IS TERMINAL,', 8' BUT OUTPUT MAY EASILY BE CHANNELED TO THE PRINTER'/ 9' INPUT IS READILY ACCEPTED FROM TERMINAL OR DISK.') 2 FORMAT('0INPUT CONSISTS OF OBSERVATIONS, EACH CONTAINING', 1' A VALUE FOR'/' ALL OF THE VARIABLES. EACH OBSERVATION', 2' MUST BEGIN A NEW LINE.'/' THE DATA MAY BE INPUT EITHER', 3' OF TWO WAYS: 1) ONE OBSERVATION'/' PER LINE WITH VALUES', 4' SEPARATED BY COMMAS; OR 2) ACCORDING'/' TO YOUR OWN', 5' INPUT FORMAT WHICH IS ENTERED USING THE COMMAND'/' "FORM"', 6'. AFTER THE LAST OBSERVATION ENTER A ^Z (CNTRL Z).') 3 FORMAT('0TO SEE THE COMMAND LIST TYPE "HELP" AFTER "WHICH', 1' COMMAND?"'/' AND "AL" FOR THE 2 CHARACTER CODE. A ', 2'RESTRICTION ON'/' DATA INPUT IS: 20 NUMBERS', 3' MAXIMUM PER LINE UNDER'/' STANDARD FORMAT. IF A LINE', 4' REQUIRES MORE THAN 72'/' COLUMNS USE YOUR OWN INPUT', 5' FORMAT.') END C *** STAT PACK *** C OUTPUT FOR HELP WHEN UNDER "WHICH COMMAND?". C CALLING SEQUENCE: CALL STHELP(KK) C WHERE KK - IS AN INDICATOR TELLING THE PROGRAM TO TYPE OUT C ONLY 1 PORTION OF THE OUTPUT. C C WHENEVER THE STUDENT REQUIRES HELP, HE MAY TYPE IN "HELP". C IN THE CASE THAT HE IS UNDER "WHICH COMMAND?" THIS PORTION IS C BROUGHT IN. IN ADDITION ONLY CERTAIN PARTS NEED BE TYPED C OUT, IF "DC", "ES", "GR", ETC. ARE TYPED FOR "WHICH COMMAND?". C KK REGULATES WHICH OF THESE IS TYPED. C SUBROUTINE STHELP(KK) DIMENSION ICODE(6) COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK IF(KK.NE.1) GO TO 1 IF(ICC.NE.2) WRITE(IDLG,2) 2 FORMAT(' COMMANDS ARE BROKEN INTO 5 GROUPS:'// 1' "DC" - DATA CONTROL'/ 1' "ST" - STATISTICS'/ 1' "GR" - GRAPHS'/ 1' "IA" - ITEM ANALYSIS'/ 1' "PC" - PROGRAM CONTROL'// 1' "AL" - COMPLETE COMMAND CODE LIST'// 1' WHICH SET (TYPE IN THE 2 CHARACTER CODE)? ',$) READ (ICC,3) ICODE IF(ICODE(1).EQ.'!') RETURN 3 FORMAT(6(A2,1X)) 1 WRITE(IDLG,4) 4 FORMAT(//'0COMMANDS AVAILABLE') C C ********************************************************** C DATA CONTROL IF(KK.EQ.2) GO TO 105 IF(KK.NE.1) GO TO 6 DO 31 I=1,6 IF(ICODE(I).EQ.'AL') GO TO 105 IF(ICODE(I).EQ.'DC') GO TO 105 31 CONTINUE GO TO 6 105 WRITE (IDLG,5) 5 FORMAT(/' "DATA" - DATA INPUT BY TTY'/ 1' "FETCH" - READ DATA FROM DISK'/ 1' "FORM" - ENTER SPECIAL INPUT FORMAT'/ 1' "MANIP" - MANIPULATE DATA IN CORE (INCLUDES APPENDING)'/ 1' "TRANS" - DATA TRANSFORMATIONS'/ 1' "STORE" - STORE DATA ON DISK'/ 1' "PRINT" - PRINT SELECTED VARIABLES ON LINE PRINTER'/ 1' "TYPE" - TYPE OUT SELECTED VARIABLES ON TTY'/ 1' "ACBNK" - ACCESS A STORED DATA BANK'/ 1' "MABNK" - CREATE A BANK FROM DATA IN STP'/ 1' "SORT" - SORT DATA INTO ASCENDING ORDER'/ 1' "MTA/I" - READ DATA FROM MAG TAPE') C C *********************************************************** C ELEMENTRY STATISTICS 6 IF(KK.EQ.3) GO TO 107 IF(KK.NE.1) GO TO 8 DO 32 I=1,6 IF(ICODE(I).EQ.'AL') GO TO 107 IF(ICODE(I).EQ.'ST') GO TO 107 32 CONTINUE GO TO 8 107 WRITE(IDLG,7) 7 FORMAT(/' "DESC" - DESCRIPTION OF DATA - MEANS, ST. DEV., VAR.'/ 1' "BASIC" - MEDIANS, MODES, AND RANGES'/ 1' "ERANA" - STD. ERROR OF MEAN, COEFF. OF SKEWNESS,', 2' COEFF. OF VARIATION'/ 1' "ESTAT" - "DESC", "BASIC", AND "ERANA"'/ 1' "ZSCOR" - Z SCORES'/ 1' "KOLM" - 1 OR 2 SAMPLE KOLMOGOROV-SMIRNOV TESTS'/ 1' "CORR" - CORRELATION MATRIX') WRITE(IDLG,13) 13 FORMAT( 1' "PCORR" - PARTIAL CORRELATIONS'/ 1' "KENDL" - KENDALL TAU CORRELATIONS'/ 1' "SRANK" - SPEARMAN RANK CORRELATION'/ 1' "PTBIS" - POINT BISERIAL CORRELATION'/ 1' "TTEST" - T TEST (SIGNIFICANCE BETWEEN MEANS)'/ 1' "CORRT" - CORRELATED T TESTS'/ 1' "MANN" - MANN WHITNEY U TEST'/ 1' "WILCX" - WILCOXEN RANK'/ 1' "ANOV1" - SINGLE FACTOR ANALYSIS OF VARIANCE'/ 1' "ANOV2" - 2-WAY ANALYSIS OF VARIANCE'/ 1' "1WAYR" - 1-WAY ANALYSIS OF VARIANCE W/ REPEATED MEASURES'/ 1' "ANOC1" - 1-WAY ANALYSIS OF COVARIANCE'/ 1' "REGR" - REGRESSION'/ 1' "STEPR" - STEPWISE REGRESSION'/ 1' "FACTO" - FACTOR ANALYSIS'/ 1' "PROB" - PROBABILITY ASSOC. WITH T, F, OR CHI SQUARE'/ 1' "CHISQ" - CHI SQUARE'/ 1' "CVSMT" - EXPONENTIAL CURVE SMOOTHING MODEL') C C *************************************************************** C GRAPHS 8 IF(KK.EQ.4) GO TO 109 IF(KK.NE.1) GO TO 10 DO 33 I=1,6 IF(ICODE(I).EQ.'AL') GO TO 109 IF(ICODE(I).EQ.'GR') GO TO 109 33 CONTINUE GO TO 10 109 WRITE(IDLG,9) 9 FORMAT(/' "PLOT" - SCATTER PLOT'/ 1' "HIST" - HISTOGRAM'/ 1' "BARGR" - BAR GRAPH') C C ************************************************************ C ITEM ANALYSIS 10 IF(KK.EQ.5) GO TO 111 IF(KK.NE.1) GO TO 12 DO 34 I=1,6 IF(ICODE(I).EQ.'AL') GO TO 111 IF(ICODE(I).EQ.'IA') GO TO 111 34 CONTINUE GO TO 12 111 WRITE(IDLG,11) 11 FORMAT(/' "FREQ" - FREQUENCY'/ 1' "XTAB" - CROSS TAB'/ 1' "XTAB*" - CROSS TAB (TABLE FORM - ONLY IF "ASSIG" IS USED)'/ 1' "PCENT" - PERCENTILES') C C *************************************************************** C PROGRAM CONTROL 12 IF(KK.EQ.6) GO TO 115 IF(KK.NE.1) GO TO 16 DO 35 I=1,6 IF(ICODE(I).EQ.'AL') GO TO 115 IF(ICODE(I).EQ.'PC') GO TO 115 35 CONTINUE GO TO 16 115 WRITE (IDLG,15) 15 FORMAT(/' "STOP" - RESTART'/ 1' "HELP" - FOR COMMANDS'/ 1' "FINI" - END RUN'/ 1' "INFO" - GENERAL INFORMATION'/ 1' "ASSIG" - ASSIGN OUTPUT TO LINE PRINTER'/ 1' "DEASS" - REINITIALIZE OUTPUT TO TERMINAL'/ 1' "COPYS" - INDICATE MORE THAN 1 PRINTER COPY("ASSIG" AND ' 2,'"PRINT")'/ 1' "TITLE" - LABEL OUTPUT WITH IDENTIFICATION'/ 1' "NAME" - GIVE NAMES TO VARIABLES'/ 1' "MAKE" - MAKE A TEXT TO BE INSERTED INTO LINE PRINTER OUTPUT') 16 RETURN END C *** STAT PACK *** C SUBROUTINE TO OUTPUT SELECTED VARIABLES TO THE LPT. C CALLING SEQUENCE: CALL STPRNT(NV,NC,MV,MC,DATA,IV,NAMES) C WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES) C NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (OBSERVATIONS, C CASES) C MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN MAIN. C MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN MAIN. C DATA - IS STORAGE FOR DATA, DIMENSIONED FOR MAXIMUM MATRIX. C IV - IS A VECTOR DIMENSIONED FOR AT LEAST NV. C NAMES - IS A VECTOR CONTAINING VARIABLE NAMES C C USER INDICATES HOW MANY VARIABLES TO BE OUTPUT AND WHICH C ONES. A TEMPARARY FILE IS CREATED AND OUTPUT ON THE LINE C PRINTER BY USE OF THE CALL PRINTS. C C C C AAR =============================================================== C AAR C AAR C AAR *** AAR UPDATES MADE TO RUN ON DEC-20 *** C AAR CHANGES: INSTEAD OF WRITING OUTPUT GENERATED BY THE C AAR 'PRINT' COMMAND TO THE FILE "PRINT.DAT" AND C AAR THEN USING ROUTINE "PRINTS" TO QUEUE IT, C AAR WRITE DATA GENERATED BY THE PRINT COMMAND TO C AAR THE OUTPUT FILE "S%%%%.DAT" WHICH WAS OPENED C AAR IN THE MAIN PROGRAM (ORIGINALLY,TO HANDLE OUTPUT C AAR IF AN "ASSIGN" COMMAND WAS ISSUED). CHANGES C AAR IN THE MAIN PGM. HAVE BEEN MADE TO PRINT THIS C AAR FILE ON NORMAL TERMINATION BY USING THE C AAR 'LIST' OPTION OF THE CLOSE COMMAND. C AAR REDIRECTION OF THE 'PRINT' CMMND. OUTPUT C AAR IS ACCOMPLISHED BY CHANGING THE DEVICE # C AAR FOR OUTPUT TO 21, WHICH REPRESENTS THE C AAR "S%%%%.DAT" FILE. IT WAS NECESSARY TO C AAR INCLUDE THE COMMON AREA "/HDR/" FROM THE C AAR MAIN PROGRAM TO KEEP TRACK OF THE # OF PAGES C AAR IN THE "S%%%%.DAT" FILE. C AAR C AAR C AAR NOTE: AAR CHANGES ARE SURROUNDED BY COMMENTS WITH "AAR" C AAR IN THE LEFT MARGIN. ORIGINAL LINES WHICH HAVE BEEN C AAR COMMENTED OUT HAVE "WMU" IN THE LEFT MARGIN. C AAR C AAR C AAR =============================================================== C C C SUBROUTINE STPRNT(NV,NC,MV,MC,DATA,IV,NAMES) COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK COMMON /PRNT/ LINPP,ICOPS,RUNPRG COMMON/EXTRA/HEDR(70),NSZ C AAR C AAR ---- C AAR ! COMMON/HDR/DATRN(2),NPAGE,PROG C AAR ! C AAR ---- C AAR DIMENSION DATA(MC,MV),IV(1),NAMES(1) C WMU C WMU C WMU OPEN(UNIT=IDSK,FILE='PRINT.DAT',DEVICE='DSK',ACCESS='SEQOUT') C WMU NPAGE=1 C WMU C WMU C C AAR C AAR *** AAR CHANGES *** C AAR USE PAGE COUNTER FROM MAIN PGM, AND ALSO CHANGE C AAR OUTPUT UNIT TO THE S%%%%.DAT FILE (UNIT 21). C AAR C AAR ---- C AAR ! NPAGE=NPAGE+1 IDSK=21 C AAR ! C AAR ---- C AAR 1 IF(ICC.NE.2) WRITE(IDLG,2) 2 FORMAT(' WHICH VARIABLES? ',$) CALL ALPHA(IV,NV,N,IRET,IHELP,IERR,NAMES,NV) IF(IRET.EQ.1) RETURN IF(IERR.EQ.1) GOTO 1 IF(IHELP.EQ.1) GO TO 1 DO 3 I=1,N IF(IV(I).LT.0) GO TO 20 3 CONTINUE GO TO 22 20 N=NV DO 21 I=1,NV 21 IV(I)=I 22 LINPO=(N+7)/8+1 WRITE(IDSK,30) HEDR,NPAGE 30 FORMAT('1STP-V5 WMU',20X,70A1,20X,'PAGE ',I5/) LINES=4+LINPO WRITE(IDSK,7)(NAMES(IV(I)),I=1,N) 7 FORMAT('0',21X,'VAR'/' OBS',4X,8(4X,A5,6X)/(11X,8(4X,A5,6X))) DO 8 I=1,NC LINES=LINES+LINPO IF(LINES.LE.LINPP) GO TO 12 NPAGE=NPAGE+1 WRITE(IDSK,30) HEDR,NPAGE WRITE(IDSK,7)(NAMES(IV(J)),J=1,N) LINES=4+LINPO*2 12 DO 8 J=1,N,8 NEND=J+7 IF(NEND.GT.N) NEND=N IF(J.EQ.1) WRITE(IDSK,18) I,(DATA(I,IV(K)),K=J,NEND) 18 FORMAT('0',I6,2X,8G15.7) IF(J.NE.1) WRITE(IDSK,19) (DATA(I,IV(K)),K=J,NEND) 19 FORMAT(9X,8G15.7) 8 CONTINUE 9 FORMAT('0',I6,2X,8G15.7/(9X,8G15.7)) 11 CONTINUE C WMU C WMU CALL RELEAS (IDSK) C WMU NPAGE=(NPAGE+1)*ICOPS+2 C WMU CALL PRINTS('PRINT.DAT',2,1,ICOPS,NPAGE) C WMU C WMU 23 RETURN C WMU C WMU C C AAR C AAR *** AAR CHANGE *** C AAR RETURN IDSK TO ITS ORIGINAL VALUE, 1 AND RETURN. C AAR C AAR ---- C AAR ! 23 IDSK=1 RETURN C AAR ! C AAR ---- C AAR END