Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50520/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
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