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

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/stp10.stp
There is 1 other file named stp10.stp in the archive. Click here to see a list.
C                                   *** STAT PACK ***
C     SUBROUTINE FOR SCATTER DIAGRAM.
C     CALLING SEQUENCE: CALL SPPLOT(NV,NC,MV,MC,DATA,IV,IH,NAMES)
C     WHERE NV - IS NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES)
C           NC - IS NUMBER OF ROWS ACTUALLY FILLED (OBSERVATIONS, CASES)
C           MV - IS MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN MAIN
C           MC - IS MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN MAIN
C           DATA - STORAGE FOR DATA DIMENSIONED FOR MAXIMUM MATRIX
C           IV - A VECTOR AT LEAST NV LONG
C           IH - A VECTOR AT LEAST NV LONG
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C
C     CREATES AN XY SCATTER DIAGRAM WHICH IS 50 UNITS WIDE AND 25
C     UNITS HIGH, OR WHEN OUTPUT IS ASSIGNED 110 UNITS WIDE AND 53
C      UNITS HIGH.  IN BOTH CASES POINTS ARE DETERMINED BY DIVIDING
C     THE RESPECTIVE RANGES BY THE NUMBER OF UNITS LESS ONE, AND
C     THEN INCREMENTING BY THAT VALUE.  AUTOMATIC SCALEING IS ALSO
C     INCORPORATED HAVING INCREMENTS AT POWERS OF 10 TIMES 5, 2.5, 2,
C     AND 1.  IN CASES WHERE SCALEING CAUSES PORTIONS OF THE GRAPH TO
C     NOT CONTAIN POINTS, THE PORTIONS WILL BE SURPRESSED IN THE OUTPUT.

C     AT ANY POINT THE CHARACTER SHOWN INDICATES THE NUMBER OF 
C     CASES FALLING IN THE RANGES OF THAT POINT.  1-9, A IS 10,
C     B IS 11, C IS 12, D IS 13, E IS 14, F IS 15, AND X IS 16 OR MORE.
C     INDICIES OF POINTS ARE FOUND STORED IN IV AND IH
C     AND THE OUTPUT IS FORMED A LINE AT A TIME
C
      SUBROUTINE SPPLOT(NV,NC,MV,MC,DATA,IV,IH,NAMES)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON/EXTRA/HEDR(70),NSZ
      DIMENSION DATA(MC,MV),GR(110),XOUT(12),IV(1),IH(1)
      DIMENSION CHT(37),NAMES(1)
      HALL=0
      VALL=0
      MINUS='-'
      PLUS='+'
      CHT(1)=' '
      CHT(2)='1'
      CHT(3)='2'
      CHT(4)='3'
      CHT(5)='4'
      CHT(6)='5'
      CHT(7)='6'
      CHT(8)='7'
      CHT(9)='8'
      CHT(10)='9'
      CHT(11)='A'
      CHT(12)='B'
      CHT(13)='C'
      CHT(14)='D'
      CHT(15)='E'
      CHT(16)='F'
      CHT(17)='G'
      CHT(18)='H'
      CHT(19)='I'
      CHT(20)='J'
      CHT(21)='K'
      CHT(22)='L'
      CHT(23)='M'
      CHT(24)='N'
      CHT(25)='O'
      CHT(26)='P'
      CHT(27)='Q'
      CHT(28)='R'
      CHT(29)='S'
      CHT(30)='T'
      CHT(31)='U'
      CHT(32)='V'
      CHT(33)='W'
      CHT(34)='X'
      CHT(35)='Y'
      CHT(36)='Z'
      CHT(37)='*'
500   IF(ICC.NE.2) WRITE (IDLG,100)
100   FORMAT('0WHICH IS THE HORIZONTAL VARIABLE? ',$)
      CALL ALPHA(NX,1,I,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IHELP.EQ.1) GO TO 500
      IF(IERR.EQ.1) GO TO 500
      IF(NX.GT.0) GOTO 600
      HALL=1
      NX=0
600   IF(ICC.NE.2) WRITE(IDLG,101)
101   FORMAT('0WHICH IS THE VERTICAL VARIABLE? ',$)
      CALL ALPHA(NY,1,I,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IHELP.EQ.1) GO TO 600
      IF(IERR.EQ.1) GOTO 600
      IF(NY.GT.0) GO TO 4
      NY=0
      VALL=1
      IF(HALL.EQ.1) NX=1
4     NNH=50
      NNV=25
      IF(IOUT.EQ.21) NNH=110
      IF(IOUT.EQ.21) NNV=53
      IF(VALL.NE.1) GO TO 6
      IF(HALL.NE.1) GO TO 8
5     NY=NY+1
      IF(NY.EQ.NX) GO TO 5
      IF(NY.LE.NV) GO TO 10
      NX=NX+1
      NY=NX
      IF(NX.LE.NV) GO TO 5
      RETURN
6     IF(HALL.NE.1) GO TO 10
7     NX=NX+1
      IF(NX.EQ.NY) GO TO 7
      IF(NX.LE.NV) GO TO 10
      RETURN
8     NY=NY+1
      IF(NY.EQ.NX) GO TO 8
      IF(NY.LE.NV) GO TO 10
      RETURN
10    XMIN=DATA(1,NX)
      XMAX=XMIN
      YMIN=DATA(1,NY)
      YMAX=YMIN
      DO 300 I=2,NC
      IF(DATA(I,NX).GT.XMAX)XMAX=DATA(I,NX)
      IF(DATA(I,NX).LT.XMIN) XMIN=DATA(I,NX)
      IF(DATA(I,NY).GT.YMAX) YMAX=DATA(I,NY)
      IF(DATA(I,NY).LT.YMIN) YMIN=DATA(I,NY)
300   CONTINUE
      XSTEP=(XMAX-XMIN)/(NNH-1)
      IF(XSTEP.EQ.0)XSTEP=1.0
      Z=ALOG10(XSTEP)
      M=Z
      B=Z-M
      IF(B.GE.0) GO TO 107
      M=M-1
      B=B+1.
107   C=10.**B
      IF(C.LE.10.) XINC=10.
      IF(C.LE.8.0) XINC=8.
      IF(C.LE.5.) XINC=5.
      IF(C.LE.4.) XINC=4.
      IF(C.LE.2.5) XINC=2.5
      IF(C.LE.2.0) XINC=2.0
      IF(C.LE.1.25)XINC=1.25
      IF(C.LE.1.0) XINC=1.0
      XSTEP=XINC*10.**M
      YSTEP=(YMAX-YMIN)/(NNV-1)
      IF(YSTEP.EQ.0) YSTEP=1.0
      Z=ALOG10(YSTEP)
      M=Z
      B=Z-M
      IF(B.GE.0) GO TO 108
      M=M-1
      B=B+1.
108   C=10.**B
      IF(C.LE.10) XINC=10.
      IF(C.LE.8.) XINC=8.
      IF(C.LE.5.) XINC=5.
      IF(C.LE.4.) XINC=4.
      IF(C.LE.2.5) XINC=2.5
      IF(C.LE.2.0) XINC=2.0
      IF(C.LE.1.25)XINC=1.25
      IF(C.LE.1.0) XINC=1.0
      YSTEP=XINC*10.**M
      DO 302 I=1,NC
      IH(I)=((DATA(I,NX)-XMIN)/XSTEP)+1.5
      IV(I)=((YMAX-DATA(I,NY))/YSTEP)+1.5
302   CONTINUE
      IF(IOUT.NE.21) WRITE(IOUT,5566) (HEDR(K),K=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
110   NNH=NNH-10
      IF((XMIN+(NNH-1)*XSTEP).GE.XMAX) GO TO 110
      NNH=NNH+10
      IF(NNH.LT.10) NNH=10
      NCH=NNH/10
      WRITE(IOUT,990)NAMES(NX),NAMES(NY),((MINUS,I=1,9),PLUS,J=1,NCH)
990   FORMAT(' PLOT OF VARIABLE: ',A5,' (HORIZ.) VS VARIABLE: ',A5,
     1' (VERT.)'/' ',12X,'I',110A1)
111   NNV=NNV-4
      IF((YMAX-(NNV-1)*YSTEP).LE.YMIN) GO TO 111
      NNV=NNV+4
      IF(NNV.LT.1) NNV=1
      YOUT=YMAX
      K=4
      DO 400 I=1,NNV
      DO 40 M=1,NNH
40    GR(M)=' '
      DO 41 M=1,NC
      IF(IV(M).NE.I) GO TO 41
      N=IH(M)
      DO 303 J=1,36
      IF(GR(N).EQ.CHT(J)) GO TO 304
303   CONTINUE
      GO TO 41
304   GR(N)=CHT(J+1)
41    CONTINUE
      DO 403 M=NNH,1,-1
      IF(GR(M).NE.' ') GO TO 402
403   CONTINUE
402   IF(K.EQ.4) GO TO 401
      WRITE(IOUT,102)(GR(J),J=1,M)
102   FORMAT(13X,1HI,110A1)
      GO TO 400
401   WRITE(IOUT,103) YOUT,(GR(J),J=1,M)
103   FORMAT(1X,G11.4,1X,1H+,110A1)
      YOUT=YOUT-4.0*YSTEP
      K=0
400   K=K+1
      WRITE(IOUT,104)((MINUS,J=1,9),PLUS,L=1,NCH)
104   FORMAT(13X,'I',110A1)
      XOUT(1)=XMIN-XSTEP
      NCH=NCH+1
      DO 920 I=2,NCH
920   XOUT(I)=XOUT(I-1)+10.0*XSTEP
      WRITE(IOUT,105)(XOUT(I),I=1,NCH,2)
105   FORMAT(2X,G17.4,5G20.4)
      WRITE(IOUT,106)(XOUT(I),I=2,NCH,2)
106   FORMAT(9X,6G20.4)
      IF((HALL.EQ.1).OR.(VALL.EQ.1)) GO TO 4
      RETURN
501   WRITE(IDLG,109)
109   FORMAT(' VARIABLE DOES NOT EXIST'/)
      GO TO 500
601   WRITE(IDLG,109)
      GO TO 600
      END
C                                      *** STAT PACK ***
C     SUBROUTINE FOR CROSS TABS.
C     CALLING SEQUENCE: CALL STXTAB(NV,NC,MV,MC,DATA,SP,AV,IQ,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           SP - VECTOR USED FOR ADDITIONAL STORAGE.
C           AV - VECTOR USED FOR ADDITIONAL STORAGE.
C           IQ - VARIABLE USED TO SPECIFY TABLE OUTPUT FOR LPT.
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES.
C
C     PROGRAM WRITTEN TO CROSSTAB DATA OF ALMOST ANY DISCRIPTION OR SIZE
C     FIRST A SORT IS EMPLOYED TO SORT MOST MAJOR ON ONE OF THE
C     VARIABLES, AND MINOR ON THE OTHER.  ONCE THE SORT IS COMPLETE,
C     START ACCUMULATING COUNTS FROM THE FIRST VARIABLE, ANY TIME
C     THERE'S A CHANGE WRITE OUT THAT CROSS TAB.  OUTPUT METHODE
C     CHOSE HERE IS FOR SAKE OF BREVITY ON OUTPUT TO TTY.  SUGGESTIONS
C     HAVE BEEN OFFERED TO CREATE A TABLE WHEN OUTPUT HAS BEEN
C     CHANNELED TO THE LINE PRINTER, THESE ARE AT PRESENT BEING
C     STUDIED.  THE ORIGINAL DATA IS RETURNED UNCHANGED TO THE MAIN,
C     HERE THE USE OF VECTOR AV, AND SP BECOMES APPARENT.
C
      SUBROUTINE STXTAB(NV,NC,MV,MC,DATA,SP,AV,IQ,NAMES)
      DIMENSION DATA(MC,MV),AV(1),SP(1),ITMS(2,20),XOUT(6,2)
      DIMENSION IFRE(12),PCENT(12),XIND(12),NAMES(1)
C
C     FOLLOWING DIMENSION FOR SORT ONLY IU(M) AND IL(M)
C     WILL SORT UP TO 2**(M-1)-1
      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
1     IF(ICC.NE.2) WRITE(IDLG,2)
2     FORMAT('0DO YOU ALSO WANT PERCENTAGES (YES OR NO)? ',$)
      READ(ICC,3) ANS
3     FORMAT(A3,1X,I)
      IF(ANS.EQ.'!') RETURN
      IF((ANS.EQ.'YES').OR.(ANS.EQ.'NO')) GO TO 4
      WRITE(IDLG,5)
5     FORMAT('0ANSWER EITHER YES OR NO')
      GO TO 1
4     IF(ICC.NE.2) WRITE(IDLG,6)
6     FORMAT('0LIST THE VARIABLES YOU WISH TO HAVE CROSS TABS',
     1' ON'/' EACH CROSS TAB SEPARATED BY A SEMI-COLON AND THE',
     2' VARIABLES OF'/' EACH CROSS TAB SEPARATED BY A COMMA'/)
      IRET=-98
      CALL ALPHA(ITMS,40,NN,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IHELP.EQ.1) GO TO 4
      IF(IERR.EQ.1) GO TO 4
      NN=NN/2
      IF(IQ.EQ.1) GO TO 7
      IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(J),J=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      LINES=2
7     DO 60 I=1,NN
      IVAR1=ITMS(1,I)
      IVAR2=ITMS(2,I)
      IF((ITMS(1,I).GT.0).AND.(ITMS(2,I).GT.0)) GO TO 13
      IF(IVAR1.LT.0) IVAR1=0
      IF(IVAR2.LT.0) IVAR2=0
      IF((IVAR1.EQ.0).AND.(IVAR2.EQ.0)) IVAR2=1
C
C     *************************************************************
C     ACM SORT INTEGER SUBTRACTION (PARTITIONING SORT)
C
15    IF((ITMS(1,I).GT.0).AND.(ITMS(2,I).GT.0)) GO TO 60
      IF(ITMS(1,I).LT.0) GO TO 12
      IVAR2=IVAR2+1
      IF(IVAR2.LE.NV) GO TO 13
      GO TO 60
12     IVAR1=IVAR1+1
      IF(IVAR1.LE.NV) GO TO 13
      IF(ITMS(2,I).GE.0) GO TO 60
      IVAR2=IVAR2+1
      IVAR1=IVAR2+1
      IF(IVAR1.GT.NV) GO  TO 60
13    IF(IVAR1.EQ.IVAR2) GO TO 15
14    DO 70 J=1,NC
      SP(J)=DATA(J,IVAR2)
70    AV(J)=DATA(J,IVAR1)
      M=1
      II=1
      J=NC
71    IF(II.GE.J) GO TO 78
72    K=II
      IJ=(J+II)/2
      T=AV(IJ)
      S=SP(IJ)
      IF(AV(II).GT.T) GO TO 83
      IF(AV(II).LT.T) GO TO 73
      IF(SP(II).LE.S) GO TO 73
83    AV(IJ)=AV(II)
      AV(II)=T
      T=AV(IJ)
      SP(IJ)=SP(II)
      SP(II)=S
      S=SP(IJ)
73    LL=J
      IF(AV(J).LT.T) GO TO 84
      IF(AV(J).GT.T) GO TO 75
      IF(SP(J).GE.S) GO TO 75
84    AV(IJ)=AV(J)
      AV(J)=T
      T=AV(IJ)
      SP(IJ)=SP(J)
      SP(J)=S
      S=SP(IJ)
      IF(AV(II).GT.T) GO TO 85
      IF(AV(II).LT.T) GO TO 75
      IF(SP(II).LE.S) GO TO 75
85    AV(IJ)=AV(II)
      AV(II)=T
      T=AV(IJ)
      SP(IJ)=SP(II)
      SP(II)=S
      S=SP(IJ)
      GO TO 75
74    AV(LL)=AV(K)
      AV(K)=TT
      SP(LL)=SP(K)
      SP(K)=SS
75    LL=LL-1
      IF(AV(LL).GT.T) GO TO 75
      IF((AV(LL).EQ.T).AND.(SP(LL).GT.S)) GO TO 75
      TT=AV(LL)
      SS=SP(LL)
76    K=K+1
      IF(AV(K).LT.T) GO TO 76
      IF((AV(K).EQ.T).AND.(SP(K).LT.S)) GO TO 76
      IF(K.LE.LL) GO TO74
      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
      S=SP(II+1)
      T=AV(II+1)
      IF(AV(II).LT.T) GO TO 80
      IF((AV(II).EQ.T).AND.(SP(II).LE.S)) GO TO 80
      K=II
81    AV(K+1)=AV(K)
      SP(K+1)=SP(K)
      K=K-1
      IF(T.LT.AV(K)) GO TO 81
      IF((T.EQ.AV(K)).AND.(S.LT.SP(K))) GO TO 81
      AV(K+1)=T
      SP(K+1)=S
      GO TO 80
C     ************************************************************
C
90    IF(IQ.EQ.1) GO TO 100
C     ==========================================================
C
C     OUTPUT GIVING CROSSTABS AS ORDERED PAIRS
C
      LLEND=2
      IF(ANS.EQ.'YES') LLEND=1
      IF((ANS.NE.'YES').AND.(IOUT.EQ.21))LLEND=4
      IF((ANS.EQ.'YES').AND.(IOUT.EQ.21)) LLEND=3
      ZVAR='VAR'
      ZPC1='PERC'
      ZPC2='ENT'
      ZFRE='FREQ.'
      DASH='-----'
      WRITE(IOUT,58) NAMES(IVAR1),NAMES(IVAR2)
58    FORMAT('0CROSS TAB VARIABLE: ',A5,' VS VARIABLE: ',A5)
      LINES=LINES+3
      IF(ANS.EQ.'YES')WRITE(IOUT,57)(ZVAR,NAMES(IVAR1),ZVAR,
     1NAMES(IVAR2),ZFRE,ZPC1,ZPC2,KK=1,LLEND)
57    FORMAT('0',6(A4,A5,2X,A4,A5,2X,A5,1X,A4,A3,5X))
      IF(ANS.NE.'YES') WRITE(IOUT,40)(ZVAR,NAMES(IVAR1),ZVAR,
     1NAMES(IVAR2),ZFRE,KK=1,LLEND)
40    FORMAT('0',6(A4,A5,2X,A4,A5,2X,A5,5X))
      IF(ANS.EQ.'YES') WRITE(IOUT,152)(DASH,KK=1,LLEND*7)
152   FORMAT(1X,6(7A5,5X))
      IF(ANS.NE.'YES') WRITE(IOUT,153) (DASH,KK=1,LLEND*6)
153   FORMAT(1X,6(5A5,A2,5X))
      LINES=LINES+3
      SSP=SP(1)
      SAV=AV(1)
      LL=1
      XOUT(1,1)=AV(1)
      XOUT(1,2)=SP(1)
      IFRE(1)=1
      DO 44 J=2,NC
      IF(SAV.NE.AV(J)) GO TO 59
      IF(SSP.EQ.SP(J)) GO TO 44
59    SSP=SP(J)
      SAV=AV(J)
      LL=LL+1
      IF(LL.LE.LLEND) GO TO 52
      IF(ANS.EQ.'YES') GO TO 50
      IF(IOUT.NE.21) GO TO 53
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 53
      CALL PRNTHD
      WRITE(IOUT,40)(ZVAR,NAMES(IVAR1),ZVAR,NAMES(IVAR2),ZFRE,
     1KK=1,LLEND)
      WRITE(IOUT,153)(DASH,KK=1,LLEND*6)
      LINES=6
53    WRITE(IOUT,45)((XOUT(K,1),XOUT(K,2),IFRE(K)),K=1,LLEND)
45    FORMAT(1X,4(G10.4,1X,G10.4,I5,6X))
      GO TO 46
50    Y=NC
      DO 48 K=1,LLEND
      Z=IFRE(K)
48    PCENT(K)=Z/Y*100.
      IF(IOUT.NE.21) GO TO 51
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 51
      CALL PRNTHD
      WRITE(IOUT,57)(ZVAR,NAMES(IVAR1),ZVAR,NAMES(IVAR2),ZFRE,ZPC1,
     1ZPC2,KK=1,LLEND)
      WRITE(IOUT,152)(DASH,KK=1,LLEND*7)
      LINES=6
51    WRITE(IOUT,49)((XOUT(K,1),XOUT(K,2),IFRE(K),PCENT(K)),K=1,LLEND)
49    FORMAT(1X,3(G10.4,1X,G10.4,I5,1X,F6.1,'%',6X))
46    LL=1
52    XOUT(LL,1)=AV(J)
      XOUT(LL,2)=SP(J)
      IFRE(LL)=0
44    IFRE(LL)=IFRE(LL)+1
      IF(ANS.EQ.'YES') GO TO 47
      IF(IOUT.NE.2) GO TO 54
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 54
      CALL PRNTHD
      WRITE(IOUT,40)(ZVAR,NAMES(IVAR1),ZVAR,NAMES(IVAR2),ZFRE,
     1KK=1,LLEND)
      LINES=6
54    WRITE(IOUT,45)((XOUT(K,1),XOUT(K,2),IFRE(K)),K=1,LL)
      GO TO 15
47    Y=NC
      DO 56 K=1,LL
      Z=IFRE(K)
56    PCENT(K)=Z/Y*100.
      IF(IOUT.NE.2) GO TO 55
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 55
      CALL PRNTHD
      WRITE(IOUT,57) (ZVAR,NAMES(IVAR1),ZVAR,NAMES(IVAR2),ZFRE,ZPC1,
     1ZPC2,KK=1,LLEND)
      WRITE(IOUT,152) (DASH,KK=1,LLEND*7)
55    WRITE(IOUT,49)((XOUT(K,1),XOUT(K,2),IFRE(K),PCENT(K)),K=1,LL)
      GO TO 15
C
C     =========================================================
C
C     OUTPUT IN STANDARD CROSS TAB TABLE OUTPUT FOR LINE PRINTER
C
100   IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(J),J=1,NSZ)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,58) NAMES(IVAR1),NAMES(IVAR2)
      LINES=4
C     VARIABLE MVAR ADJUSTS NUMBER OF COLUMNS PER PAGE.
      MVAR=11
      XMIN=SP(1)
      DO 101 J=2,NC
      IF(SP(J).LT.XMIN) XMIN=SP(J)
101   CONTINUE
      XMIN=XMIN-1.
102   K=0
      DO 103 J=1,NC
      IF(SP(J).LE.XMIN) GO TO 103
      IF(K.NE.0) GO TO 104
      K=K+1
      XIND(K)=SP(J)
      GO TO 103
C
C     TABLE LOOK UP AND CREATION
C
104   IF(SP(J).GT.XIND(K)) GO TO106
      DO  105 L=1,K
      IF(SP(J).LT.XIND(L)) GO TO 108
      IF(SP(J).EQ.XIND(L)) GO TO 103
105   CONTINUE
106   IF(K.GE.MVAR) GO TO 103
      K=K+1
      XIND(K)=SP(J)
      GO TO 103
108   IF(L.EQ.MVAR) GO TO 110
      IF(K.GT.(MVAR-1)) K=MVAR-1
      DO 109 M=K,L,-1
109   XIND(M+1)=XIND(M)
      K=K+1
110   XIND(L)=SP(J)
103   CONTINUE
      IF(K.EQ.0) GO TO 15
      XMIN=XIND(K)
      IF(IOUT.NE.21) GO TO 107
      LINES=LINES+7
      IF(LINES.LE.(LINPP-6)) GO TO 107
      CALL PRNTHD
      LINES=9
107   WRITE(IOUT,111)
111   FORMAT('0')
      WRITE(IOUT,120) NAMES(IVAR1),NAMES(IVAR2),(XIND(J),J=1,K)
120   FORMAT('0VARIABLE: ',A5,50X,'VARIABLE: ',A5/'0VALUE',8X,12G10.3)
      MINUS='-----'
      WRITE(IOUT,121)((MINUS,L=1,2),J=1,K)
121   FORMAT(11X,'--',12(2A5))
130   DO 131 J=1,12
131   IFRE(J)=0
      SAV=AV(1)
      Y=NC
      J=0
132   J=J+1
      IF(J.GT.NC) GO TO 148
133   IF(AV(J).NE.SAV) GO TO 140
      IF(SP(J).LT.XIND(1)) GO TO 132
      IF(SP(J).GT.XIND(K)) GO TO 132
      DO 134 L=1,K
      IF(SP(J).EQ.XIND(L)) GO TO 135
134   CONTINUE
      CALL EXIT
135   IFRE(L)=IFRE(L)+1
      GO TO 132
140   IF(IOUT.NE.21) GO TO 146
      LINES=LINES+2
      IF(ANS.EQ.'YES') LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 146
      CALL PRNTHD
      WRITE(IOUT,120) NAMES(IVAR1),NAMES(IVAR2),(XIND(JJ),JJ=1,K)
      WRITE(IOUT,121)((MINUS,L=1,2),JJ=1,K)
      LINES=11
      IF(ANS.EQ.'YES') LINES=LINES+1
146   WRITE(IOUT,141)SAV,(IFRE(L),L=1,K)
141   FORMAT(11X,'I'/1X,G9.3,' I ',12(2X,I4,4X))
      IF(ANS.NE.'YES') GO TO 144
      DO 142 L=1,K
      Z=IFRE(L)
142   PCENT(L)=(Z/Y)*100.
      WRITE(IOUT,143)(PCENT(L),L=1,K)
143   FORMAT(11X,'I ',12(2X,F7.2,'%'))
144   SAV=AV(J)
      DO 145 L=1,12
145   IFRE(L)=0
      GO TO 133
148   IF(IOUT.NE.21) GO TO 147
      LINES=LINES+2
      IF(ANS.EQ.'YES') LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 147
      CALL PRNTHD
      WRITE(IOUT,120) NAMES(IVAR1),NAMES(IVAR2),(XIND(J),J=1,K)
      WRITE(IOUT,121)((MINUS,L=1,2),J=1,K)
      LINES=9
      IF(ANS.EQ.'YES') LINES=LINES+1
147   WRITE(IOUT,141) SAV,(IFRE(L),L=1,K)
      IF(ANS.NE.'YES') GO TO 102
      DO 150 L=1,K
      Z=IFRE(L)
150   PCENT(L)=(Z/Y)*100.
      WRITE(IOUT,143) (PCENT(L),L=1,K)
      GO TO 102
60    CONTINUE
      RETURN
      END
C                                     *** STAT PACK ***
C     SUBROUTINE FOR FINDING CORRELATED T'S
C     CALLING SEQUENCE: CALL CORRT(NV,NC,MV,MC,VMN,CORR,STD,T,NAMES)
C     WHERE NV - NUMBER OF VARIABLES
C           NC - NUMBER OF OBSERVATIONS
C           MV - MAXIMUM NUMBER OF VARIABLES
C           MC - MAXIMUM NUMBER OF CASES (OBSERVATIONS)
C           VMN - VECTOR CONTAINING VARIABLE MEANS
C           CORR - CORRELATION MATRIX
C           STD - VECTOR CONTAINING STANDARD DEVIATIONS
C           T - EXTRA VECTOR AT LEAST NV LONG
C           NAMES - VECTOR CONTAINING VARIABLE NAMES
C
      SUBROUTINE CORRT(NV,NC,MV,MC,VMN,CORR,STD,T,NAMES)
      DIMENSION VMN(1),CORR(MV,MV),STD(1),T(1),NAMES(1)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON /EXTRA/ HEDR(70),NSZ
      IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(I),I=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,10)
10    FORMAT('0',15X,'***** CORRELATED T *****')
      LINES=4
      LEN=5
      IF(IOUT.EQ.21) LEN=10
      A=NC
      A=SQRT(A)
      DO 1 I=1,NV
      STDI=STD(I)
      DO 2 J=1,I
      T(J)=0
      IF(J.EQ.I) GO TO 2
      SD=SQRT(STDI**2+STD(J)**2-2.*CORR(I,J)*STDI*STD(J))
      T(J)=(A*(VMN(I)-VMN(J)))/SD
2     CONTINUE
      IF(IOUT.NE.21) GO TO 9
      M=(I+LEN-1)/LEN
      LINES=LINES+M+1
      IF(LINES.LE.(LINPP-M-1)) GO TO 9
      WRITE(IOUT,6)
      DO 11 J=1,I-1,LEN
      K=J+LEN-1
      IF(K.GT.(I-1)) K=I-1
11    WRITE(IOUT,8)(NAMES(L),L=J,K)
      CALL PRNTHD
      LINES=3+M
9     DO 3 J=1,I,LEN
      K=J+LEN-1
      IF(K.GT.I) K=I
      IF(J.EQ.1) WRITE(IOUT,4) NAMES(I),(T(L),L=J,K)
4     FORMAT('0',A5,10(1X,G11.4))
      IF(J.NE.1) WRITE(IOUT,5)(T(L),L=J,K)
5     FORMAT(6X,10(1X,G11.4))
3     CONTINUE
1     CONTINUE
      WRITE(IOUT,6)
6     FORMAT(1X)
      DO 7 I=1,NV,LEN
      K=I+LEN-1
      IF(K.GT.NV) K=NV
      WRITE(IOUT,8) (NAMES(L),L=I,K)
8     FORMAT(8X,10(1X,A5,6X))
7     CONTINUE
      RETURN
      END
C                                           *** STAT PACK ***
C     SUBROUTINE FOR 1 WAY ANALYSIS OF VARIANCE.
C     CALLING SEQUENCE: CALL ANOV1(NV,NC,MV,MC,DATA,VMN,STD,ISUB,IGRP,NAMES)
C     WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED(VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED(OBSERVATIONS,CASES)
C           MV - IS MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN MAIN.
C           MC - IS MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN MAIN.
C           DATA - STORAGE FOR DATA DIMENSIONED FOR MAXIMUM MATRIX.
C           VMN - IS A VECTOR CONTAINING VARIABLE MEANS.
C           STD - IS A VECTOR CONTAINING VARIABLE STANDARD DEVIATIONS
C           ISUB - IS A VECTOR DIMENSIONED AT LEAST NC
C           IGRP - IS A VECTOR DIMENSIONED AT LEAST NC
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C
C     1 WAY ANALYSIS OF VARIANCE. OPTIONS AVAILABLE TO CREATE CELLS
C     OUT OF VARIABLES, OR CREATE CELLS BASED ON THE VALUE OF A SECOND VARIABLE.
C     IN CREATING CELLS BY VALUE OF A SECOND VARIABLE, A PARTITIONING
C     SORT IS USED (PROBABLY THE BEST ALL AROUND SORT IN TERMS OF 
C     SPEED AND EASE OF USE).  ORIGINAL MODEL TAKEN FROM WINER
C     PAGES 96 THROUGH 101.
C
      SUBROUTINE ANOV1(NV,NC,MV,MC,DATA,VMN,STD,ISUB,IGRP,NAMES)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON/EXTRA/HEDR(70),NSZ
      DIMENSION DATA(MC,MV),VMN(1),OPT(6),STD(1),R(50,5)
      DIMENSION ISUB(1),IGRP(1),JJ(30),JJI(30),NAMES(1)
      DIMENSION IL(16),IU(16)
      REAL MSTRT,MSERR
      ALL=0
1     IF(ICC.NE.2) WRITE(IDLG,2)
2     FORMAT('0LIST OPTIONS SEPARATED BY COMMAS'/)
      DISCR=0
      BREAK=0
      HEADR=0
      AUTO=0
      RANGE=0
      READ(ICC,3) OPT
3     FORMAT(10(A5,1X))
      IF(OPT(1).EQ.'!') RETURN
      DO 4 I=1,6
      IF(OPT(I).EQ.' ') GO TO 17
      IF(OPT(I).NE.'HELP') GO TO 6
      WRITE (IDLG,5)
5     FORMAT('0THE ANALYSIS OF VARIANCE ASSUMES THE INDIVIDUAL TREAT',
     1'MENTS'/' OF THE DATA TO BE VARIABLES.  OPTIONS ARE AVIALABLE TO'
     2,' CREATE THE'/' TREATMENTS FROM A SINGLE VARIABLE BASED ON'
     3,' VALUES OF ANOTHER VARIABLE.'/
     4,' IF THIS OPTION IS CALLED FOR, IT ASSUMES RANGES FOR THE ',
     5'BREAKDOWN WILL'/' BE GIVEN.  ANOTHER OPTION ALLOWS THE ',
     6'BREAKDOWN TO BE DONE ON EACH'/' INDIVIDUAL VALUE OF THE ',
     7'BREAKDOWN VARIABLE'/'0OPTIONS ARE:'/' "BREAK" - ',
     8'CREATE BREAKDOWNS BASED ON ANOTHER VARIABLE'/' "DISCR" -',
     9' ALLOW FOR BREAKDOWNS BASED ON INDIVIDUAL VALUES'/
     1'          (ONLY AVAILABLE WHEN "BREAK" IS USED)'/
     2' "HEADR" - ELIMINATE MEANS, AND STD.DEV. REPORT'/
     3' "RANGE" - LIST RANGES WHEN AUTOMATIC BREAKDOWN IS USED'/
     4' "AUTO" - AUTOMATIC BREAKDOWN (SPECIFIED WHEN ASKED FOR RANGES)'/
     5'0IF NO OPTIONS ARE DESIRED TYPE A RETURN')
      GO TO 1
6     IF(OPT(I).NE.'BREAK') GO TO 7
      BREAK=1
      GO TO 4
7     IF(OPT(I).NE.'DISCR') GO TO 101
      DISCR=1
      GO TO4
101   IF(OPT(I).NE.'HEADR') GO TO 102
      HEADR=1
      GO TO 4
102   IF(OPT(I).NE.'RANGE') GO TO 103
      RANGE=1
      GOTO 4
103   IF(OPT(I).NE.'AUTO') GO TO 106
104   WRITE(IDLG,105)
105   FORMAT('0"AUTO" MAY ONLY BE SPECIFIED WHEN ASKED FOR RANGES')
      GO TO 1
106   IF(OPT(I).EQ.'AUTO,') GOTO 104
8     WRITE(IDLG,9)OPT(I)
9     FORMAT('0OPTION ',A5,' DOES NOT EXIST')
      GO TO 1
4     CONTINUE
17    IF(BREAK.EQ.1) GO TO 20
C
C     ***************:::::::::::::::::::::***************************
C
C     THIS PORTION INDIVIDUAL VARIABLES USED AS TREATMENTS
C
10    IF(ICC.NE.2) WRITE(IDLG,11)
11    FORMAT('0WHICH VARIABLES? ',$)
      CALL ALPHA(JJI,30,NN,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IHELP.EQ.1) GO TO 10
      IF(IERR.EQ.1) GO TO 10
      K=1
      DO 200 I=1,NN
      JJ(I)=JJI(I)
      IF(JJI(I).GT.0) GO TO 200
      JJ(I)=K
      K=K+1
200   CONTINUE
      GO TO 206
201   J=NN
202   IF(JJI(J).GT.0) GO TO 203
      JJ(J)=JJ(J)+1
      IF(JJ(J).LE.NV) GO TO 204
203   J=J-1
      IF(J.GE.1) GO TO 202
      RETURN
204   K=JJ(J)
      IF(J.EQ.NN) GO TO 206
      DO 205   I=J+1,NN
      IF(JJI(I).GT.0) GO TO 205
      K=K+1
      IF(K.GT.NV) GO TO 203
      JJ(I)=K
205   CONTINUE
206   DO 207 I=1,NN-1
      DO 207 K=I+1,NN
      IF(JJ(I).EQ.JJ(K)) GO TO 201
207   CONTINUE
      ST2N=0
      G=0
      SX2=0
      T=NC
      IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(I),I=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,18)
18    FORMAT('0',18X,'***** 1-WAY ANOVA *****')
      IF(HEADR.NE.1) WRITE(IOUT,19)
19    FORMAT('0TRET.',3X,'SIZE',6X,'MEAN',8X,'STD. DEV.')
      LINES=6
      DO 16 I=1,NN
      L=JJ(I)
      X=VMN(L)*T
      X2=(STD(L)**2)*T*(T-1.)+X**2
      X2=X2/T
      G=G+X
      ST2N=ST2N+X**2/T
      SX2=SX2+X2
      IF(HEADR.EQ.1) GO TO 16
      IF(IOUT.NE.21) GO TO 25
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 25
      CALL PRNTHD
      WRITE(IOUT,19)
      LINES=5
25    WRITE(IOUT,22) NAMES(L),NC,VMN(L),STD(L)
22    FORMAT(1X,A5,3X,I4,4X,G10.4,1X,G)
16    CONTINUE
      NK=NN*NC
      GO TO 85
C
C     ***************************************************************
C
C     BREAK DOWN IS RESPONSIBLE FOR TREATMENTS
C
20    IF(ICC.NE.2) WRITE(IDLG,21)
21    FORMAT('0WHICH VARIABLES ARE TO BE ANALYZED? ',$)
      CALL ALPHA(JJ,30,NG,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IHELP.EQ.1) GO TO 20
      IF(IERR.EQ.1) GO TO 20
23    IF(ICC.NE.2) WRITE(IDLG,24)
24    FORMAT(' WHAT IS THE BREAKDOWN VARIABLE? ',$)
      CALL ALPHA(IB,1,I,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1)RETURN
      IF(IHELP.EQ.1) GO TO 23
      IF(IERR.EQ.1) GO TO 23
      IF(DISCR.EQ.1) GO TO 45
27    IF(ICC.NE.2) WRITE(IDLG,26) NAMES(IB)
26    FORMAT('0ENTER RANGES FOR BREAKDOWN VARIABLE: ',A5/)
      I=1
30    IF(ICC.NE.2) WRITE(IDLG,37)
37    FORMAT('+? ',$)
      READ(ICC,3,END=31,ERR=31) HELP
      IF(HELP.EQ.'!') RETURN
      IF(HELP.EQ.'AUTO') GO TO 45
      IF(HELP.EQ.'  ') GOTO 31
      IF(HELP.EQ.'STOP') GO TO 31
      IF(HELP.NE.'HELP') GO TO 32
      WRITE(IDLG,28)
28    FORMAT('0ENTER RANGE FOR EACH TREATMENT, SMALLER FIRST, SEPARAT',
     1'ED'/' BY A COMMA.  WHEN FINISHED TYPE A ^Z(CONTROL Z), A <CR>',
     2' OR STOP'/' EXAMPLE:'/' 75,80'/'0CONTINUE NOW'/)
      GO TO 30
32    REREAD 38,(R(I,J),J=1,2)
38    FORMAT(2F)
      IF(R(I,1).LE.R(I,2)) GO TO 34
      WRITE(IDLG,33)
33    FORMAT('0RANGE NOT CORRECT REENTER PLEASE')
      GO TO 30
34    I=I+1
      IF(I.LE.50) GO TO 30
      WRITE (IDLG,35)
35    FORMAT('0TOO MANY BREAKDOWNS - NO MORE ACCEPTED')
31    NN=I-1
      NK=0
      DO 40 I=1,NC
      DO 41 J=1,NN
      IF(DATA(I,IB).LT.R(J,1)) GO TO 41
      IF(DATA(I,IB).GT.R(J,2)) GO TO 41
      NK=NK+1
      ISUB(NK)=I
      IGRP(NK)=J
      GO TO 40
41    CONTINUE
40    CONTINUE
C
C     PARTITIONING SORT ON GROUP PULLING SUBSCRIPT ALONG
C
      M=1
      II=1
      J=NK
71    IF(II.GE.J) GO TO 78
72    K=II
      IJ=(J+II)/2
      KT=IGRP(IJ)
      IF(IGRP(II).LE.KT) GO TO 73
      IGRP(IJ)=IGRP(II)
      IGRP(II)=KT
      KT=IGRP(IJ)
      ISAV=ISUB(IJ)
      ISUB(IJ)=ISUB(II)
      ISUB(II)=ISAV
73    LL=J
      IF(IGRP(J).GE.KT) GO TO 75
      IGRP(IJ)=IGRP(J)
      IGRP(J)=KT
      KT=IGRP(IJ)
      ISAV=ISUB(IJ)
      ISUB(IJ)=ISUB(J)
      ISUB(J)=ISAV
      IF(IGRP(II).LE.KT) GO TO 75
      IGRP(IJ)=IGRP(II)
      IGRP(II)=KT
      KT=IGRP(IJ)
      ISAV=ISUB(IJ)
      ISUB(IJ)=ISUB(II)
      ISUB(II)=ISAV
      GO TO 75
74    IGRP(LL)=IGRP(K)
      IGRP(K)=KTT
      ISAV=ISUB(LL)
      ISUB(LL)=ISUB(K)
      ISUB(K)=ISAV
75    LL=LL-1
      IF(IGRP(LL).GT.KT) GO TO 75
      KTT=IGRP(LL)
76    K=K+1
      IF(IGRP(K).LT.KT) 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 95
      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
      KT=IGRP(II+1)
      ISAV=ISUB(II+1)
      IF(IGRP(II).LE.KT) GO TO 80
      K=II
81    IGRP(K+1)=IGRP(K)
      ISUB(K+1)=ISUB(K)
      K=K-1
      IF(KT.LT.IGRP(K)) GO TO 81
      IGRP(K+1)=KT
      ISUB(K+1)=ISAV
      GO TO 80
C
C     DISCR WAS USED
C
45    NK=NC
      DO 46 I=1,NK
46    ISUB(I)=I
      M=1
      II=1
      J=NK
51    IF(II.GE.J) GO TO 58
52    K=II
      IJ=(J+II)/2
      T=DATA(ISUB(IJ),IB)
      IF(DATA(ISUB(II),IB).LE.T) GO TO 53
      ISAV=ISUB(II)
      ISUB(II)=ISUB(IJ)
      ISUB(IJ)=ISAV
      T=DATA(ISUB(IJ),IB)
53    LL=J
      IF(DATA(ISUB(J),IB).GE.T) GO TO 55
      ISAV=ISUB(IJ)
      ISUB(IJ)=ISUB(J)
      ISUB(J)=ISAV
      T=DATA(ISUB(IJ),IB)
      IF(DATA(ISUB(II),IB).LE.T) GO TO 55
      ISAV=ISUB(IJ)
      ISUB(IJ)=ISUB(II)
      ISUB(II)=ISAV
      T=DATA(ISUB(IJ),IB)
      GO TO 55
54    ISAV=ISUB(LL)
      ISUB(LL)=ISUB(K)
      ISUB(K)=ISAV
55    LL=LL-1
      IF(DATA(ISUB(LL),IB).GT.T) GO TO 55
      TT=DATA(ISUB(LL),IB)
56    K=K+1
      IF(DATA(ISUB(K),IB).LT.T) GO TO 56
      IF(K.LE.LL) GO TO 54
      IF((LL-II).LE.(J-K)) GO TO 57
      IL(M)=II
      IU(M)=LL
      II=K
      M=M+1
      GO TO 59
57    IL(M)=K
      IU(M)=J
      J=LL
      M=M+1
      GO TO 59
58    M=M-1
      IF(M.EQ.0) GO TO 63
      II=IL(M)
      J=IU(M)
59    IF((J-II).GE.11) GO TO 52
      IF(II.EQ.1) GO TO 51
      II=II-1
60    II=II+1
      IF(II.EQ.J) GO TO 58
      T=DATA(ISUB(II+1),IB)
      IF(DATA(ISUB(II),IB).LE.T) GO TO 60
      ISAV=ISUB(II+1)
      K=II
61    ISUB(K+1)=ISUB(K)
      K=K-1
      IF(T.LT.DATA(ISUB(K),IB)) GO TO 61
      ISUB(K+1)=ISAV
      GO TO 60
C
63    IF(RANGE.EQ.1) WRITE(IDLG,64) NAMES(IB)
64    FORMAT('0BREAKDOWN RANGES FOR VARIABLE: ',A5)
      T=DATA(ISUB(1),IB)
      IF(RANGE.EQ.1) WRITE(IDLG,65) T,T
65    FORMAT(1X,G10.4,',',G10.4)
      L=1
      DO 62 I=1,NK
      IF(T.EQ.DATA(ISUB(I),IB)) GO TO 62
      T=DATA(ISUB(I),IB)
      IF(RANGE.EQ.1) WRITE(IDLG,65) T,T
      L=L+1
62    IGRP(I)=L
      NN=L
95    DO 96 I=1,NG
      IF(JJ(I).GT.0) GO TO 96
      ALL=1
      IA=0
      GO TO 82
96    CONTINUE
      I=0
82    IF(ALL.NE.1) GO TO 83
      IA=IA+1
      IF(IA.GT.NV) RETURN
      IF(IA.EQ.IB) GO TO 82
      GO TO 84
83    I=I+1
      IF(I.GT.NG) RETURN
      IA=JJ(I)
84    IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(J),J=1,NSZ)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,18)
      WRITE(IOUT,90) NAMES(IA),NAMES(IB)
90    FORMAT(' ANALYSIS ON VARIABLE: ',A5,' WITH TREATMENTS',
     1' DETERMINED'/' BY A BREAKDOWN ON VARIABLE: ',A5)
      IF(HEADR.NE.1) WRITE(IOUT,19)
      LINES=7
      G=0
      SX2=0
      ST2N=0
      N=1
      XSUM=0
      X2SUM=0
      NSIZE=0
      DO 91 J=1,NK
      IF(IGRP(J).EQ.N) GO TO 94
      SX2=SX2+X2SUM
      G=G+XSUM
      ST2N=ST2N+(XSUM**2/NSIZE)
      IF(HEADR.EQ.1) GO TO 93
      XMN=XSUM/NSIZE
      XSTD=0
      IF(NSIZE.GT.1) XSTD=SQRT((NSIZE*X2SUM-XSUM**2)/(NSIZE*(NSIZE-1.)))
      ENCODE(5,92,NAM)N
92    FORMAT(I4,1X)
      IF(IOUT.NE.21) GO TO 97
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 97
      CALL PRNTHD
      WRITE(IOUT,19)
      LINES=5
97    WRITE(IOUT,22) NAM,NSIZE,XMN,XSTD
93    N=N+1
      XSUM=0
      X2SUM=0
      NSIZE=0
94    X=DATA(ISUB(J),IA)
      XSUM=XSUM+X
      X2SUM=X2SUM+X**2
      NSIZE=NSIZE+1
91    CONTINUE
      SX2=SX2+X2SUM
      G=G+XSUM
      ST2N=ST2N+(XSUM**2/NSIZE)
      IF(HEADR.EQ.1) GO TO 85
      XMN=XSUM/NSIZE
      XSTD=0
      IF(NSIZE.GT.1)XSTD=SQRT((NSIZE*X2SUM-XSUM**2)/(NSIZE*(NSIZE-1.)))
      ENCODE(5,92,NAM)N
      IF(IOUT.NE.21) GO TO 98
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 98
      CALL PRNTHD
      WRITE(IOUT,19)
      LINES=5
98    WRITE(IOUT,22)NAM,NSIZE,XMN,XSTD
C
C     COMMON ENTRY POINT FOR BOTH ROUTINES
C     HERE CALCULATED VALUES OR PUT OUT.
C
85    TNN=NK
      SSTRT=ST2N-G**2/TNN
      SSERR=SX2-ST2N
      SSTOT=SX2-G**2/TNN
      NDFTRT=NN-1
      NDFERR=NK-NN
      NDFTOT=NDFTRT+NDFERR
      MSTRT=SSTRT/NDFTRT
      MSERR=SSERR/NDFERR
      F=MSTRT/MSERR
      IF(IOUT.NE.21) GO TO 99
      LINES=LINES+5
      IF(LINES.LE.LINPP) GO TO 99
      CALL PRNTHD
99    WRITE(IOUT,86)
86    FORMAT('0SOURCE',3X,'SUM OF SQ.',5X,'D.F.',3X,'MEAN SQ.'
     1,6X,'F',9X,'PROB')
      PROB=FISHER(NDFTRT,NDFERR,F)
      WRITE(IOUT,87) SSTRT,NDFTRT,MSTRT,F,PROB
87    FORMAT(' BETWEEN', G,1X,I4,3X,G10.4,1X,G11.4,1X,F7.4)
      WRITE(IOUT,88)SSERR,NDFERR,MSERR
88    FORMAT(' WITHIN',1X,G,1X,I4,3X,G10.4)
      WRITE(IOUT,89) SSTOT,NDFTOT
89    FORMAT(' TOTAL',2X,G,1X,I4)
      IF(BREAK.NE.1) GO TO 201
      GO TO 82
      END