PDP-10 Archive: 43,50466/stp3.stp from decuslib10-09

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/stp3.stp
There is 1 other file named stp3.stp in the archive. Click here to see a list.
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
      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
      DIMENSION DATA(MC,MV),IV(1),NAMES(1)
      OPEN(UNIT=IDSK,FILE='PRINT.DAT',DEVICE='DSK',ACCESS='SEQOUT')
      NPAGE=1
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    CALL RELEAS (IDSK)
      NPAGE=(NPAGE+1)*ICOPS+2
      CALL PRINTS('PRINT.DAT',2,1,ICOPS,NPAGE)
23    RETURN
      END