Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/advaov/advaov.for
There is 1 other file named advaov.for in the archive. Click here to see a list.
C	WESTERN MICHIGAN UNIVERSITY
C	ADVAOV.F4 (FILENAME ON LIBRARY DECTAPE)
C	ADVAOV, 1.9.8 (CALLING NAME, SUBLST #)
C	ADVANCED ONE WAY ANALYSIS OF VARIANCE
C	PROGRAMMER - RUSSELL R. BARR III
C	DESIGNER AND STATISTICIAN - DR. MICHAEL R. STOLINE
C	LIBRARY DECTAPE PROGRAMS USED:  USAGE.MAC
C	APLIB PROGRAMS USED:  IOB, GETFOR, CHISGR, FISHER, FPCT, TPCT,
C	 STUDR, DUNCAN
C	FORWMU PROGRAMS USED:  EXISTS, DELETE, ALLCOR, DEVCHG, PRINTS, 
C	 TTYPTY
C	INTERNAL SUBR. USED:  INITIA, TRANSF, RANKER, SORT
C	MAIN PROG USES FUNCTIONS - TUKEY, DUNC
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
c
c	Some modifications made for the transition to the DEC-20 library
c	such as replacing WRITEs to negative unit numbers by TYPE
c	statements. Modifications are in lower case.
c			Paul T. Robinson, Wesleyan Univ, 18 Oct 1980
c
C---------------2400, START, 1180, 1720, 1800, 2600, 2900, 3100,
C--------------- 3200 REPRESENT REGIONS OF PROG.  WHEREIN INDICATED
C--------------- SUBSC. VARS. ARE USED
C---------------UNIQUE MEANS INDICATED SUBSC. VARS. LOCATIONS MAY
C--------------- NOT BE USED FOR SCRATCH AREA.  ANYTHING NOT UNIQUE COULD
C--------------- BE USED FOR SCRATCH AREA IF DESIRED.
C	2400
	DOUBLE PRECISION TRAN(5)
C	START UNIQUE
	DIMENSION ID(16),IFT(48)
C******ALL 20'S IN FOLLOWING GROUP CONTROL THE MAXIMUM OF K.
C	1180 UNIQUE
	DIMENSION N(20),XBK(20),X(125),XB(20),V(20),S(20)
C	1720
	DIMENSION DAY(2)
C	1800 UNIQUE
	DIMENSION OPT(20)
C	2600
	DIMENSION SC(20),FC(20),FPC(20),E(20,20),SD(20)
C	2900
	DIMENSION XC(20),N1(20),I1(20),BB(20,20)
	DIMENSION SIMFMT(8),ANUM(0/9)
C	3100
	DIMENSION Q(20)
C	3100
	DIMENSION WORDS(2)
C	3200
	DIMENSION IG(20),XD(20),ND(20),JG(20),NC(20),VD(20)
C******END OF CHANGABLE 20'S GROUP.
C	COMN FOR STUDR
	COMMON/START/ISTRZA,ISTRZB,ISTRZC
C	COMMON TO AND FROM SUBR. IOB
	COMMON/IOBLK/IDLG,IRSP,INP,IOUT,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON/IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
	EQUIVALENCE (SC(1),XC(1),Q(1),IG(1)),(FC(1),N1(1),XD(1))
	EQUIVALENCE (FPC(1),I1(1),ND(1)),(E(1,1),BB(1,1))
	EQUIVALENCE (SD(1),JG(1))
	DATA (TRAN(L),L=1,5)/'SQUAREROOT','  ARCSIN','LOGARITHM',
     1	'RECIPROCAL','   RANKS'/
C	I/O CHANNELS
	DATA IDLG,IRSP,INP,IOUT,IAUX,ITYCH,IRGCH,IRNK/-1,-4,4,6,7,0,3,2/
	DATA ANUM/'0    ','1    ','2    ','3    ','4    ','5    ',
     1'6    ','7    ','8    ','9    '/
	DATA SIMFMT/'(/,I3',',T   ',3*'     ',',5(3X',',F8.3','))'/
C
C	START OF EXECUTABLE CODE
C
	ITMP=IAUX
	ISTRZA=0
	ISTRZB=0
	ISTRZC=0
	WRITE(IDLG,1040)
1040	FORMAT(//,' WMU ADVANCED ANALYSIS OF VARIANCE',/)
C	CALL USAGE('ADVAOV')
C	TTYPTY RETURNS ZERO-TTY JOB,ONE-BATCH JOB
	CALL TTYPTY(ICODE)
C	DEVCHG DOES - .AS DSK 7 - APPROX.
	CALL DEVCHG('DSK',IRGCH)
	CALL DEVCHG('DSK',IAUX)
	CALL DEVCHG('DSK',IRNK)
C	I/O SUBROUTINE CALLS
	CALL IOB(1)
1050	CALL IOB(0)
	REWIND (INP)
C	START WITH AUTOMATIC 'DATA' OPTION
	IP=2
	ITRAN=0
	WRITE(IDLG,1128)
1128	FORMAT(' ENTER ID, ELSE RETURN',/)
	READ(IRSP,1130,END=1178)ID
1130	FORMAT(16A5)
	DO 1140 I=16,1,-1
	IF(ID(I).NE.'     ')GO TO 1142
1140	CONTINUE
	IDSIZE=0
	GO TO 1144
1142	IDSIZE=I
1144	CALL DEFINE FILE(IAUX,0,NV,'AOVDAT.TMP',0,0)
1154	WRITE(IDLG,1156)
1156	FORMAT(' WHICH METHOD OF DATA ENTRY?(1,2,OR 3)',/,
     1	' TYPE "HELP" FOR EXPLANATION',/)
	READ(IRSP,1158,END=1178)METH,REST
1158	FORMAT(A1,A3)
1160	IF(METH.NE.'1')GO TO 1162
	METH=1
	GO TO 1180
1162	IF(METH.NE.'2')GO TO 1164
	METH=2
	GO TO 1180
1164	IF(METH.NE.'3')GO TO 1166
	METH=3
	GO TO 1180
1166	IF(METH.NE.'H'.OR.REST.NE.'ELP')GO TO 1172
	WRITE(IDLG,1170)
1170	FORMAT(' TYPE:',/,'  1 TO ENTER DATA BY GROUP',/,
     1	'  2 TO ENTER DATA BY BREAKDOWN VARIABLE',/,
     1	'  3 TO ENTER PROCESSED DATA(# OF GROUPS, MEANS, STD. DEV.)',/)
	GO TO 1154
1172	WRITE(IDLG,1174)
1174	FORMAT(' RESPONSE OUT OF BOUNDS')
	IF(ITRY.EQ.1)GO TO 1173
	ITRY=1
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1154
C
C	ALL FATALS WILL COME HERE
C
1173	WRITE(IDLG,1175)
1175	FORMAT(' SECOND TIME ERROR - CALLING EXIT - PRESERVING OUTPUT')
1176	CALL RELEAS(IAUX)
	CALL RELEAS(IRGCH)
	CALL RELEAS(IRNK)
	CALL DELETE('AOVDAT.TMP')
	CALL DELETE('AOVORG.TMP')
	CALL DELETE('AOVRNK.TMP')
	CALL RELEAS(IOUT)
	IF(IDVO.EQ.'LPT')CALL PRINTS(NAMO,2,1,NCOPYS)
	CALL EXIT
1178	WRITE(IDLG,1179)
1179	FORMAT(' DIALOGUE TERMINATED BY AN END OF FILE',/)
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1050
C
C
1180	WRITE(IDLG,1182)
1182	FORMAT(' HOW MANY GROUPS? ',$)
	READ(IRSP,1184,END=1178)K
1184	FORMAT(10I)
	IF(K.GT.0)GO TO 1185
	IF(ITRY.GT.0)GO TO 1173
	ITRY=1
	WRITE(IDLG,1174)
	GO TO 1180
1185	CALL RELEAS(IRGCH)
	CALL DEFINE FILE(IRGCH,0,NZ,'AOVORG.TMP',0,0)
C	DYNAMIC ALLOCATION COULD OCCUR AT THIS POINT
	ITRY=0
1187	CALL GETFOR(IDLG,IRSP,IFT,ISTD,38,2)
	IF(IERR.EQ.0)GO TO 1189
	WRITE(IDLG,1174)
	IF(ITRY.EQ.1)GO TO 1173
	ITRY=1
	GO TO 1187
1189	IF(ISTD.EQ.1.AND.METH.NE.3)IFT(1)='(2F)'
	IF(ISTD.EQ.1.AND.METH.EQ.3)IFT(1)='(10F)'
	CALL INITIA(K,V,XB)
	DO 1190 I=1,K
1190	N(I)=0
	XG=0
	SW=0
	NT=0
	IERR=0
	IF(METH.EQ.2)GO TO 1300
C
C	METHOD 1 AND 3
C
1200	ITRY=0
1202	WRITE(IDLG,1204)
1204	FORMAT(' ENTER SAMPLE SIZES(10 PER LINE)',/)
	READ(IRSP,1184,END=1178)(N(I),I=1,K)
	NT=0
C---------------NT=TOTAL NO. OF OBS. IN ALL SAMPLES
	DO 1212 I=1,K
	NT=NT+N(I)
	IF(N(I).GE.2)GO TO 1212
	WRITE(IDLG,1208)
1208	FORMAT(' SAMPLE SIZE MUST BE >=2',/)
	IF(ITRY.EQ.1)GO TO 1173
	ITRY=1
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1202
1212	CONTINUE
	IF(METH.EQ.1)GO TO 1400
	GO TO 1600
C
C	METHOD 2
C
1300	ITRY=0
1304	WRITE(IDLG,1308)
1308	FORMAT(' WHICH IS THE BREAKDOWN VARIABLE?(1 OR 2) ',$)
	READ(IRSP,1184,END=1178)IBKOL
	IF(IBKOL.EQ.1.OR.IBKOL.EQ.2)GO TO 1312
	WRITE(IDLG,1174)
	IF(ITRY.EQ.1)GO TO 1173
	ITRY=1
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1304
1312	ITRY=0
	IDKOL=1
	IF(IBKOL.EQ.1)IDKOL=2
1314	WRITE(IDLG,1316)
1316	FORMAT(' ENTER BREAKDOWN LIMITS(10 PER LINE)',/)
	READ(IRSP,1320,END=1178)(XBK(IA),IA=1,K)
1320	FORMAT(10F)
	DO 1324 IA=2,K
	IF(XBK(IA).LT.XBK(IA-1))GO TO 1328
1324	CONTINUE
	IF(XBK(1).GE.0)GOTO 1500
1328	WRITE(IDLG,1332)
1332	FORMAT(' BREAKDOWN LIMITS OUT OF ORDER OR LESS THEN ZERO',/)
	IF(ITRY.EQ.1)GO TO 1173
	ITRY=1
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1314
C
C	METH 1 READ
C
1400	REWIND (IAUX)
	IF(IDVI.EQ.'TTY'.OR.IP.NE.2)GO TO 1411
	WRITE(IDLG,1404)
1404	FORMAT(' DATA IS BEING READ',/)
1411	L=0
	DO 1422 I=1,K
	IF(IDVI.EQ.'TTY'.AND.IP.EQ.2)WRITE(IDLG,1412)I
1412	FORMAT(' ENTER DATA FOR GROUP ',I3,/)
	DO 1421 J=1,N(I)
	IF(IP.NE.2)GO TO 1416
	READ(INP,IFT,ERR=1440,END=1432)X(L+1)
	L=L+1
	IF(L.LT.125)GO TO 1420
	WRITE(IAUX)(X(L),L=1,125)
	XB(I)=XB(I)+X(125)
	L=0
	GO TO 1421
1416	L=L+1
	IF(L.LE.125.AND.L.NE.1)GO TO 1419
	READ(IAUX)(X(L),L=1,125)
	L=1
1419	IF(IP.EQ.4)CALL TRANSF(ITRAN,X(L),IERR)
	IF(IERR.EQ.0)GO TO 1420
1417	XERR=X(L)
	GO TO 2440
1420	XB(I)=XB(I)+X(L)
1421	CONTINUE
1422	XB(I)=XB(I)/N(I)
	IF(L.EQ.0.OR.IP.NE.2)GO TO 1423
	WRITE(IAUX)(X(L),L=1,125)
	ENDFILE(IAUX)
1423	REWIND(IAUX)
	L=0
	DO 1428 I=1,K
	DO 1424 J=1,N(I)
	L=L+1
	IF(L.LE.125.AND.L.NE.1)GO TO 1425
	READ(IAUX)(X(L),L=1,125)
	L=1
1425	IF(IP.NE.4)GO TO 1424
	CALL TRANSF(ITRAN,X(L),IERR)
	IF(IERR.NE.0)GO TO 1417
1424	V(I)=V(I)+(X(L)-XB(I))**2
	V(I)=V(I)/(N(I)-1)
	S(I)=SQRT(V(I))
1428	CONTINUE
	GO TO 1700
1432	WRITE(IDLG,1436)I
1436	FORMAT(' END OF FILE WHILE READING GROUP',I5,/)
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1050
1440	WRITE(IDLG,1442)I
1442	FORMAT(' ERROR IN DATA WHILE READING GROUP',I5,/)
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1050
C
C	METH 2 READ
C
1500	IRJ=0
	IF(IDVI.NE.'TTY')WRITE(IDLG,1404)
	IF(IDVI.EQ.'TTY')WRITE(IDLG,1502)
1502	FORMAT(' ENTER DATA',/)
1504	REWIND (IAUX)
	NT=0
	DO 1501 I=1,K
1501	N(I)=0
	IREC=0
	LVAL=124
	L=0
1509	IF(IP.NE.2)GO TO 1510
1505	READ(INP,IFT,ERR=1560,END=1503)X(L+1),X(L+2)
	L=L+2
	IF(L.LT.124)GO TO 1505
	WRITE(IAUX)(X(L),L=1,124)
	L=0
	IREC=IREC+1
	GO TO 1505
1503	LMAX=124
	IF(L.EQ.0)GO TO 1507
	LMAX=L
	WRITE(IAUX)(X(L),L=1,124)
	IREC=IREC+1
1507	NREC=IREC
1512	ENDFILE(IAUX)
1510	REWIND(IAUX)
	IREC=0
	LVAL=124
	GO TO 1513
1514	IF(L.EQ.LVAL.AND.IREC.EQ.NREC)GO TO 1521
	IF(L.NE.LVAL)GO TO 1506
1513	READ(IAUX)(X(L),L=1,124)
	IREC=IREC+1
	IF(IREC.EQ.NREC)LVAL=LMAX
	L=0
1506	L=L+2
	IF(IP.NE.4)GO TO 1516
	CALL TRANSF(ITRAN,X(IDKOL+L-2),IERR)
	IF(IERR.EQ.0)GO TO 1516
1511	XERR=X(IDKOL+L-2)
	GO TO 2440
1516	DO 1520 I=1,K
	IF(X(IBKOL+L-2).GT.XBK(I))GO TO 1520
	N(I)=N(I)+1
	XB(I)=XB(I)+X(IDKOL+L-2)
	GO TO 1514
1520	CONTINUE
	IRJ=IRJ+1
	GO TO 1514
1521	IF(IP.NE.2)GO TO 1534
	WRITE(IDLG,1532)IRJ
1532	FORMAT(' NUMBER OF REJECTED SAMPLES IS ',I5,/)
1534	DO 1536 I=1,K
	IF(N(I).GE.2)GO TO 1535
	WRITE(IDLG,1208)
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1050
1535	XB(I)=XB(I)/N(I)
1536	NT=NT+N(I)
	REWIND(IAUX)
	IREC=0
	LVAL=124
	GO TO 1541
1540	IF(L.EQ.LVAL.AND.IREC.EQ.NREC)GO TO 1552
	IF(L.NE.LVAL)GO TO 1542
1541	READ(IAUX)(X(L),L=1,124)
	IREC=IREC+1
	IF(IREC.EQ.NREC)LVAL=LMAX
	L=0
1542	L=L+2
	IF(IP.NE.4)GO TO 1543
	CALL TRANSF(ITRAN,X(IDKOL+L-2),IERR)
	IF(IERR.NE.0)GO TO 1511
1543	DO 1544 I=1,K
	IF(X(IBKOL+L-2).GT.XBK(I))GO TO 1544
	V(I)=V(I)+(X(IDKOL+L-2)-XB(I))**2.
	GO TO 1540
1544	CONTINUE
	GO TO 1540
1552	DO 1556 I=1,K
	V(I)=V(I)/(N(I)-1)
	S(I)=SQRT(V(I))
1556	CONTINUE
	GO TO 1700
1560	WRITE(IDLG,1564)
1564	FORMAT(' ERROR IN DATA',/)
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1050
C
C	METH 3 READ
C
1600	WRITE(IDLG,1604)K
1604	FORMAT(' ENTER THE ',I3,' MEANS',/)
	READ(INP,IFT,END=1620)(XB(I),I=1,K)
1608	FORMAT(10F)
	WRITE(IDLG,1612)K
1612	FORMAT(' ENTER THE ',I3,' STANDARD DEVIATIONS',/)
	READ(INP,IFT,END=1620)(S(I),I=1,K)
	DO 1616 I=1,K
	V(I)=S(I)*S(I)
1616	CONTINUE
	GO TO 1700
C	NON FATAL ERROR - METHOD 3
1620	WRITE(IDLG,1621)
1621	FORMAT(' END OF FILE WHILE READING WITH INPUT METHOD 3',/)
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1050
C
C	ALL METHOD COME HERE TO FINISH PRELIM CALCS.
C
1700	SW=0
	XG=0
	CSUB=0
	BSUB=0
	SB=0
	DO 1702 I=1,K
	XG=XG+N(I)*XB(I)
	SW=SW+(N(I)-1)*V(I)
1702	CONTINUE
	XG=XG/NT
	SMW=SW/(NT-K)
	DO 1704 I=1,K
	CSUB=CSUB+1./(N(I)-1.)
	BSUB=BSUB+(N(I)-1)*ALOG(V(I))
1704	SB=SB+N(I)*(XB(I)-XG)**2.
	SMB=SB/(K-1)
	F=SMB/SMW
	FP=FISHER(K-1,NT-K,F)
	ST=SW+SB
	C=1.+(CSUB-1./(NT-K))/(3.*(K-1.))
	B=(NT-K)*ALOG(SMW)-BSUB
	NTM1=NT-1
	NTMK=NT-K
	KM1=K-1
	BART=B/C
	CALL CHISQR(KM1,BART,CHIBRT,IERRBT)
	IF(ITRAN.NE.5)GO TO 1720
	H=SB*NTM1/ST
	CALL CHISQR(KM1,H,CHIH,IERRH)
C
C	START OF OUTPUT (PRELIM CALCS)
C
1720	IF(IP.NE.2)GO TO 1726
	CALL TIME(TIM)
	CALL DATE(DAY)
	WRITE(IOUT,1724)TIM,DAY,(ID(I),I=1,IDSIZE)
1724	FORMAT('1WMU ADVANCED ANALYSIS OF VARIANCE PROGRAM',///,
     1	1X,A5,' ',2A5,//,1X,16A5)
	WRITE(IOUT,1721)
1721	FORMAT(//)
1726	IF(IP.EQ.4)WRITE(IOUT,1725)TRAN(ITRAN)
1725	FORMAT(/,1X,T25,'TRANSFORMATION BY ',A10)
	IF(IP.EQ.3)WRITE(IOUT,1723)
1723	FORMAT(/,1X,T32,'ORIGINAL')
	WRITE(IOUT,1728)(I,N(I),XB(I),S(I),V(I),I=1,K)
1728	FORMAT(T25,'*** DESCRIPTIVE DATA ***',//,1X,'GROUP',
     1	T10,'SAMPLE SIZE',T31,'MEAN',T43,'STD. DEV.',T60,'VARIANCE',/,
     1	1X,72('-'),/,(T2,I3,T10,I6,T20,F15.3,T37,F15.3,T54,F15.3,/))
	WRITE(IOUT,1731)BART
1731	FORMAT(//,' BARTLETT''S TEST STATISTIC VALUE IS ',F15.3)
	IF(IERRBT.LT.0)GO TO 1733
	WRITE(IOUT,1732)CHIBRT,KM1
1732	FORMAT(' WHICH HAS A CHI-SQUARE PROBABILITY VALUE',/,
     1	' OF ',F15.3,' WITH ',I3,' DEGREES OF FREEDOM.',/)
	GO TO 1735
1733	WRITE(IOUT,1734)
1734	FORMAT(1X,'NO PROBABILITY CALC., D.F. OR BARTLETT OUTSIDE',
     1	' LIMITS',/)
1735	WRITE(IOUT,1736)SB,KM1,SMB,F,FP,SW,NTMK,SMW,ST,NTM1
1736	FORMAT(/,T25,'*** AOV TABLE ***',//,
     1	1X,'SOURCE',T20,'SS',T30,'DF',T44,'MS',
     1	T60,'F',T67,'F-PROB',/,1X,72('-'),/,
     1	1X,'GROUPS',T11,F15.3,T28,I4,T34,F15.3,T51,F13.3,T68,F5.3,//,
     1	1X,'WITHIN GR',T11,F15.3,T28,I4,T34,F15.3,//,
     1	1X,'TOTAL',T11,F15.3,T28,I4,/)
	IF(ITRAN.NE.5)GO TO 1746
	WRITE(IOUT,1738)H
1738	FORMAT(//,' THE KRUSKAL-WALLIS H-STATISTIC IS ',F15.3)
	IF(IERRH.LT.0)GO TO 1742
	WRITE(IOUT,1732)CHIH,KM1
	GO TO 1746
1742	WRITE(IOUT,1744)
1744	FORMAT(' NO PROBABILITY CALC., D.F. OR H-STATISTIC OUTSIDE',
     1	' LIMITS',/)
C	RESTORE IAUX TO ORIGINAL VALUE
1746	IF(ITRAN.EQ.5)IAUX=ITMP
	REWIND (IRGCH)
	IF(IP.NE.2)GO TO 1800
	WRITE(IRGCH)(XB(I),I=1,K)
	WRITE(IRGCH)(S(I),I=1,K)
	WRITE(IRGCH)(V(I),I=1,K)
	WRITE(IRGCH)XG,SB,SMB,SW,SMW,F,FP,ST,BART,CHIBRT
	GO TO 1800
C
C	END OF PRELIMINARY CALCULATIONS
C
C
C	START OF MAIN PART OF PROGRAM
C
	DATA OPT/'HELP ','DATA ','ORIG ','TRANS','VAR  ','TREND',
     1	'TTEXC','TTAPP','SIMTE','SIMES','COMPA','COLAO','NESTE',5*0,
     1	'EXIT','FINI'/
1800	CALL RELEAS(IDLG)
C	TWOFLG=1 MEANS ONLY 2 VALUES FROM TUKEY
	TWOFLG=1
C	TWOFLH=1 MEANS ONLY 2 VALUES FROM DUNCAN
	TWOFLH=1
	WRITE(IDLG,1804)
1804	FORMAT(//,' WHICH OPTION?(TYPE "HELP" FOR EXPLANATION)',/)
	READ(IRSP,1808,END=1178)OPTION
1808	FORMAT(A5)
	DO 1812 IP=1,20
1812	IF(OPT(IP).EQ.OPTION)GO TO 1824
1816	WRITE(IDLG,1820)
1820	FORMAT(' NO SUCH OPTION',/)
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1800
1824	GO TO (1900,1050,2300,2400,2500,2600,2700,2800,2900,
     1	3000,3100,3200,3300,1816,1816,1816,1816,1816,1176,1176),IP
1900	WRITE(IDLG,1904)
1904	FORMAT(' OPTIONS AVAILABLE:',//,
     1	1X,'VAR',T18,'TESTS THE EQUALITY OF PAIRS OF VARIANCES.',///,
     1	1X,'TREND',T18,'LINEAR, QUADRATIC,CUBIC,QUARTIC, AND QUINTIC',/,
     1	1X,T18,'COMPONENTS OF THE MEANS ARE GIVEN IN A TREND',/,
     1	1X,T18,'ANALYSIS. THIS ANALYSIS CAN ONLY BE USED FOR',/,
     1	1X,T18,'EQUI-SPACED MEANS AND BALANCED SAMPLES.',//,
     1	1X,'TTEXC',T18,'T-VALUES AND INDIVIDUAL CONFIDENCE INTERVALS',/,
     1	1X,T18,'FOR ALL DIFFERENCES OF PAIRS OF MEANS.',//,
     1	1X,'TTAPP',T18,'APPROXIMATE T-VALUES AND APPROXIMATE',
     1	' INDIVIDUAL',/,T18,'CONFIDENCE INTERVALS FOR ALL DIFFERENCES',
     1	' OF PAIRS',/,T18,'OF MEANS. THIS OPTION IS USED INSTEAD OF ',
     1	7H'TTEXC',/,T18,'IF THE POPULATION VARIANCES ARE NOT',
     1	' EQUAL.',/)
	WRITE(IDLG,1906)
1906	FORMAT(1X,'SIMTES',T18,'A SIMULTANEOUS TESTING OPTION. THE',
     1	' USER MAY SELECT',/,T18,'EITHER SCHEFFE, TUKEY,',
     1	' NEWMAN-KEULS, DUNCAN, OR',/,T18,'LEAST SIGNIFICANT',
     1	' DIFFERENCE PROCEDURE.',//,
     1	1X,'SIMEST',T18,'A SIMULTANEOUS ESTIMATION OPTION.',
     1	' THE USER MAY',/,T18,'SELECT THE SCHEFFE, TUKEY, OR',
     1	' BONFERRONI PROCEDURES.',//,
     1	1X,'COMPAR',T18,'THE T-VALUE AND CONFIDENCE INTERVALS ARE',
     1	' PRODUCED',/,T18,'FOR A USER SPECIFIED LINEAR EXPRESSION OR',/,
     1	1X,T18,'COMPARISON OF THE MEANS.',//,
     1	1X,'COLAOV',T18,'A COLLAPSING AOV OPTION. THE USER FORMS NEW',/,
     1	1X,T18,'GROUPINGS OF THE ORIGINAL VARIABLES. AN AOV',/,
     1	1X,T18,'TABLE IS PRODUCED.',/)
	WRITE(IDLG,1908)
1908	FORMAT(
     1	1X,'TRANS',T18,'TRANSFORM THE ORGINAL VALUES OF THE CURRENT ',
     1	'DATA',/,T18,'SET. THE TRANSFORMED DATA IS NOT TRANSFORMED.',//,
     1	1X,'ORIG',T18,'RETURN CURRENT DATA SET TO UNTRANSFORMED',
     1	' STATE.',//,
     1	1X,'DATA',T18,'ALLOWS THE ENTRY OF A NEW DATA SET.',//,
     1	1X,'HELP',T18,'TYPES THIS TEXT.',//,
     1	1X,'EXIT (OR FINI)',T18,
     1'PRESERVES OR PRINTS RESULTS AND RETURNS TO',
     1	' MONITER.',/)
	GO TO 1800
C	CONTROL-Z TRAP FOR ALL OPTIONS FOLLOWING
1920	WRITE(IDLG,1922)
1922	FORMAT(' OPTION TERMINATED BY AN END OF FILE',/)
	IF(ICODE.NE.0)GO TO 1176
	GO TO 1800
C
C	ORIG OPTION
C
2300	REWIND (IRGCH)
	READ(IRGCH)(XB(I),I=1,K)
	READ(IRGCH)(S(I),I=1,K)
	READ(IRGCH)(V(I),I=1,K)
	READ(IRGCH)XG,SB,SMB,SW,SMW,F,FP,ST,BART,CHIBRT
	WRITE(IOUT,2302)
2302	FORMAT(' THE ORIGINAL DATA IS RESTORED.',/)
	GO TO 1800
C
C	TRANSFORMATION OPTION
C
2400	IF(METH.NE.3)GO TO 2410
2401	WRITE(IDLG,2402)
2402	FORMAT(' NO TRANSFORMATION POSSIBLE WITH DATA ENTRY',
     1	' METHOD #3',/)
	GO TO 1800
2410	REWIND (IAUX)
2411	WRITE(IDLG,2412)
2412	FORMAT(' ENTER TRANSFORM NUMBER',/,
     1	' TYPE "HELP" FOR EXPLANATION',/)
	READ(IRSP,2414,END=1920)TRANS
2414	FORMAT(A5)
	IF(TRANS.NE.'HELP ')GOTO 2418
	WRITE(IDLG,2416)
2416	FORMAT(' TYPE:',/,'  1 FOR SQUARE ROOT',/,'  2 FOR ARC-SIN',/,
     1	'  3 FOR NATURAL LOGARITHM',/,'  4 FOR RANKS',/)
	GO TO 2411
2418	DECODE(1,2420,TRANS)ITRAN
2420	FORMAT(I1)
C	RECIPROCAL WAS #4, IS NOW DELETED.
C	RANKS WAS #5, IS NOW #4 OPTION BUT CONVERTED TO #5 FOR INTERNAL.
	IF(ITRAN.GE.4)ITRAN=ITRAN+1
	IF(ITRAN.GE.1.AND.ITRAN.LE.5)GO TO 2424
	WRITE(IDLG,1174)
	GO TO 2411
2424	WRITE(IDLG,2428)
2428	FORMAT(' DATA BEING PROCESSED',/)
	CALL INITIA(K,V,XB)
	XG=0
	SW=0
	IF(ITRAN.NE.5)GO TO 2438
	CALL RELEAS(IRNK)
	CALL DEFINE FILE(IRNK,0,NV,'AOVRNK.TMP',0,0)
	MAX=2*NT
	IF(METH.EQ.2)MAX=MAX+NT
	DIMENSION SRNK(1)
	CALL ALLCOR(MAX,IERR,IREL,SRNK)
	IF(IERR.EQ.0)GO TO 2436
	WRITE(IDLG,2434)
2434	FORMAT(' NOT ENOUGH CORE AVAILABLE TO USE RANKS TRANS',
     1'FORMATION',/)
	GO TO 1800
2436	CONTINUE
	CALL RANKER(SRNK(IREL),SRNK(IREL+NT),X,NT,IAUX,IRNK,METH,IDKOL,
     1IBKOL,NREC,LMAX)
	REWIND(IRNK)
	IAUX=IRNK
2438	IF(METH-2)1411,1504,2401
C
C	TRANSFORMATION ERROR
C
2440	WRITE(IDLG,2444)TRAN(ITRAN),XERR
2444	FORMAT(' CAN''T COMPUTE ',A10,' OF ',F,/)
	IERR=0
	GO TO 1800
C
C	VAR OPTION
C
2500	WRITE(IOUT,2504)
2504	FORMAT(/,' THE RATIOS OF VARIANCES ARE USED TO',/,
     1	' DETERMINE IF THE NUMERATOR POPULATION',/,
     1	' POPULATION VARIANCE IS SIGNIFICANTLY GREATER THAN',/,
     1	' THE DENOMINATOR POPULATION VARIANCE. THE',/,
     1	' RATIOS HAVE AN F DISTRIBUTION WHEN',/,
     1	' THE POPULATION VARIANCES ARE EQUAL.',/)
	WRITE(IOUT,2508)
2508	FORMAT(/,T20,'VAR OPTION',//,1X,'VAR A  VAR B',
     1	T21,'VAR A/VAR B',T45,'PROBABILITY',/,1X,71('-'),/)
	DO 2516 I=1,K
	NIM1=N(I)-1
	DO 2516 J=1,K
	IF(I.EQ.J)GO TO 2516
	NJM1=N(J)-1
	VV=V(I)/V(J)
	FPV=FISHER(NIM1,NJM1,VV)
	WRITE(IOUT,2512)I,J,VV,FPV,NIM1,NJM1
2512	FORMAT(1X,I4,T9,I4,T16,F15.3,T34,F15.3,T51,'WITH D.F.',
     1	T61,'(',I4,',',I4,')',/)
2516	CONTINUE
	GO TO 1800
C
C	TREND OPTION
C
2600	WRITE(IOUT,2601)
2601	FORMAT(/,' THE FOLLOWING TREND ANALYSIS ASSUMES',/,
     1	' THAT THE GROUP MEANS ARE EQUALLY SPACED.',/)
	DO 2604 I=1,K-1
	DO 2604 J=I+1,K
	IF(N(I).EQ.N(J))GO TO 2604
	WRITE(IDLG,2602)
2602	FORMAT(' THIS TREND ANALYSIS NOT POSSIBLE SINCE THE SAMPLE',/,
     1	' SIZES ARE NOT EQUAL.',/)
	GO TO 1800
2604	CONTINUE
	DO 2606 I=1,K
	E(1,I)=1
2606	E(2,I)=I-(K+1)/2.
	DO 2608 I=3,6
	DO 2608 J=1,K
2608	E(I,J)=E(I-1,J)*E(2,J)-(I-2)*(I-2)*((K*K)-
     1	(I-2)*(I-2))*E(I-2,J)/(4.*(4.*(I-2.)*(I-2.)-1.))
	SDT=0
	DO 2612 I=1,5
	SC(I)=0
	SD(I)=0
	DO 2610 J=1,K
	SC(I)=SC(I)+E(I+1,J)*XB(J)
2610	SD(I)=SD(I)+E(I+1,J)**2./N(J)
	SC(I)=SC(I)**2./SD(I)
	FC(I)=SC(I)/SMW
	FPC(I)=FISHER(1,NTMK,FC(I))
2612	SDT=SDT+SC(I)
	WRITE(IOUT,2616)SB,KM1,SMB,F,FP,SC(1),SC(1),FC(1),FPC(1)
2616	FORMAT(/,T10,'AOV - TREND ANALYSIS',//,
     1	1X,'SOURCE',T19,'SS',T29,'DF',T41,'MS',
     1	T59,'F',T67,'F-PROB',/,1X,72('-'),/,
     1	1X,'GROUPS',T11,F15.3,T28,I4,T34,F15.3,T51,F15.3,T68,F5.3,//,
     1	1X,'LINEAR',T11,F15.3,T31,'1',T34,F15.3,T51,F15.3,T68,F5.3,/)
	IF(K.LE.2)GO TO 2664
2624	WRITE(IOUT,2628)SC(2),SC(2),FC(2),FPC(2)
2628	FORMAT(' QUADRATIC',T11,F15.3,T31,'1',
     1	T34,F15.3,
     1	T51,F15.3,T68,F5.3,/)
	IF(K.LE.3)GO TO 2664
2632	WRITE(IOUT,2636)SC(3),SC(3),FC(3),FPC(3)
2636	FORMAT(' CUBIC',T11,F15.3,T31,'1',
     1	T34,F15.3,T51,F15.3,T68,F5.3,/)
	IF(K.LE.4)GO TO 2664
2640	WRITE(IOUT,2644)SC(4),SC(4),FC(4),FPC(4)
2644	FORMAT(' QUARTIC',T11,F15.3,T31,'1',
     1	T34,F15.3,T51,F15.3,T68,F5.3,/)
	IF(K.LE.5)GO TO 2664
2648	WRITE(IOUT,2652)SC(5),SC(5),FC(5),FPC(5)
2652	FORMAT(' QUINTIC',T11,F15.3,T31,'1',
     1	T34,F15.3,T51,F15.3,T68,F5.3,/)
	IF(K.LE.6)GO TO 2664
2656	SDT=SB-SDT
	SMDT=SDT/(K-6.)
	FDT=SMDT/SMW
	FPT=FISHER(K-6,NTMK,FDT)
	KM6=K-6
	WRITE(IOUT,2660)SDT,KM6,SMDT,FDT,FPT
2660	FORMAT(' DEPARTURE',/,' OF GROUPS',
     1	T11,F15.3,T28,I4,T34,F15.3,T51,F15.3,T68,F5.3,/,
     1	' FROM QUINTIC',/)
2664	WRITE(IOUT,2668)SW,NTMK,SMW,ST,NTM1
2668	FORMAT(' WITHIN GR',T11,F15.3,T28,I4,T34,F15.3,/,
     1	1X,'TOTAL',T11,F15.3,T28,I4,/)
	GO TO 1800
C
C	TTEXC OPTION AND TTAPP OPTION COMBINED
C
2700	WRITE(IDLG,2702)
2702	FORMAT(/,' TYPE A TWO-DIGIT NUMBER WHICH WILL BE THE',/,
     1	' CONFIDENCE LEVEL FOR THE CONFIDENCE INTERVALS ',/,
     1	' FOR EACH OF THE DIFFERENCES BETWEEN PAIRS OF',/,
     1	' MEANS. TYPING A RETURN AUTOMATICALLY GIVES',/,
     1	' A 95% CONFIDENCE LIMIT.',/)
	READ(IRSP,2704,END=1920)AL
2704	FORMAT(F)
	IF(AL.EQ.0)AL=95
	ALL=AL/100.
	IF(IP.EQ.8)GO TO 2804
2705	WRITE(IDLG,2706)
2706	FORMAT(' TYPE:',/,'  1 FOR INDIVIDUAL ERROR',/,
     1	'  2 FOR GROUP MEAN SQUARE ERROR',/)
2708	READ(IRSP,2710,END=1920)IAM
2710	FORMAT(I)
	IF(IAM.GE.1.AND.IAM.LE.2)GO TO 2738
	WRITE(IDLG,1174)
	GO TO 2705
C
C	TTEXC OPTION ONLY
C
2738	WRITE(IOUT,2716)AL
2716	FORMAT(/,' EXACT TWO SAMPLE T-VALUES AND ',F4.0,' PER CENT',/,
     1	' INDIVIDUAL CONFIDENCE INTERVALS FOR PAIRS OF MEAN',/,
     1	' DIFFERENCES.',/,
     1	' THE PROBABILITY ASSOCIATED WITH EACH T-VALUE IS',/,
     1	' CORRECT FOR A TWO-TAILED TEST. A ONE-TAILED TEST MAY',/,
     1	' BE OBTAINED BY HALVING THE PROBABILITY VALUES GIVEN.',/)
	WRITE(IOUT,2720)AL
2720	FORMAT(/,T61,F4.0,' %',/,T13,'TWO SAMPLE',
     1	T43,'MEAN',T60,'IND. CONF.',/,
     1	' GROUP-GROUP',T15,'T-VALUE',T26,'DF',T33,'PROB',T41,
     1	'DIFFERENCE',T60,'INTERVALS',/,1X,72('-'))
	TPP=TPCT((1-ALL)/2,NTMK)
	IDF=NTMK
	DO 2736 I=1,KM1
	DO 2736 J=I+1,K
	NN2=N(I)+N(J)-2
	RNINJ=1./N(I)+1./N(J)
	TIJ=XB(I)-XB(J)
	IF(IAM.EQ.2)GO TO 2724
	SP=((N(I)-1)*V(I)+(N(J)-1)*V(J))/NN2
	TV=TIJ/SQRT(SP*RNINJ)
	TP=FISHER(1,NN2,TV*TV)
	TPP=TPCT((1-ALL)/2,NN2)
	TU=TPP*SQRT(SP*RNINJ)
	TL=TIJ-TU
	TU=TIJ+TU
	IDF=NN2
	GO TO 2728
2724	TV=TIJ/SQRT(SMW*RNINJ)
	TP=FISHER(1,NTMK,TV*TV)
	TU=TPP*SQRT(SMW*RNINJ)
	TL=TIJ-TU
	TU=TIJ+TU
2728	WRITE(IOUT,2732)I,J,TV,IDF,TP,TIJ,TL,TU
2732	FORMAT(1X,I3,T8,I3,T13,F9.3,T24,I4,T30,F9.3,T41,F9.3,T51,
     1	'(',F9.3,',',F9.3,')',/)
2736	CONTINUE
	GO TO 1800
C
C	TTAPP OPTION USES FIRST PART OF TTEXC OPTION
C
2800	GO TO 2700
C
C	RETURN FROM TTEXC
2804	WRITE(IOUT,2808)AL
2808	FORMAT(/,' APPROXIMATE TWO-SAMPLE T-VALUES AND ',F3.0,'%',/,
     1	' INDIVIDUAL CONFIDENCE INTERVALS FOR PAIRS OF MEAN',/,
     1	' DIFFERENCES.',/,
     1	'    THE PROBABILITY ASSOCIATED WITH EACH T-VALUE',/,
     1	' IS CORRECT FOR A TWO-TAILED TEST. A ONE-TAILED TEST MAY',/,
     1	' MAY BE OBTAINED BY HALVING THE PROBABILITY VALUE GIVEN.',/)
	WRITE(IOUT,2720)AL
	DO  2828 I=1,KM1
	DO 2828 J=I+1,K
	TIJ=XB(I)-XB(J)
	TVD=V(I)/N(I)+V(J)/N(J)
	TV=TIJ/SQRT(TVD)
	IDF=TVD*TVD/((V(I)/N(I))**2./(N(I)-1)+(V(J)/N(J))**2./
     1	(N(J)-1))
	TP=FISHER(1,IDF,TV*TV)
	TPP=TPCT((1-ALL)/2,IDF)
	TL=TIJ-TPP*SQRT(TVD)
	TU=TIJ+TPP*SQRT(TVD)
2820	WRITE(IOUT,2732)I,J,TV,IDF,TP,TIJ,TL,TU
2828	CONTINUE
	GO TO 1800
C
C	SIMTES OPTION
C
2900	WRITE(IDLG,2902)
2902	FORMAT(' SIMULTANEOUS TESTING PROCEDURE',/)
2904	WRITE(IDLG,2906)
2906	FORMAT(' SELECT ONE OF THE FIVE TESTING PROCEDURES.',/,
     1	' TYPE:',/,' 1 FOR SCHEFFE',/,' 2 FOR TUKEY',/,
     1	' 3 FOR NEWMAN-KEULS',/,' 4 FOR DUNCANS',/,
     1	' 5 FOR LEAST SIGNIFICANT DIFFERENCE',/)
	READ(IRSP,2908,END=1920)IAB
2908	FORMAT(I)
	IF(IAB.GE.1.AND.IAB.LE.5)GO TO 2912
	WRITE(IDLG,1174)
	GO TO 2904
2912	IF(IAB.EQ.1)WRITE(IOUT,2914)
	IF(IAB.EQ.2)WRITE(IOUT,2916)
	IF(IAB.EQ.3)WRITE(IOUT,2918)
	IF(IAB.EQ.4)WRITE(IOUT,2920)
	IF(IAB.EQ.5)WRITE(IOUT,2922)
2914	FORMAT(/,T20,'SCHEFFE')
2916	FORMAT(/,T20,'TUKEY')
2918	FORMAT(/,T20,'NEWMAN-KEULS')
2920	FORMAT(/,T20,'DUNCANS')
2922	FORMAT(/,T10,'LEAST SIGNIFICANT DIFFERENCE')
	WRITE(IOUT,2924)
2924	FORMAT(T9,'SIMULTANEOUS TESTING PROCEDURE',//,
     1	T15,'THE ORDERED MEANS',//)
	IF(IAB.EQ.1.OR.IAB.EQ.5)GO TO 2934
	DO 2932 I=1,KM1
	DO 2932 J=I+1,K
	IF(N(I).EQ.N(J))GO TO 2932
	WRITE(IDLG,2930)
2930	FORMAT(' THE TESTING PROCEDURE CHOSEN IS NOT POSSIBLE SINCE',/,
     1	' THE SAMPLE SIZES ARE NOT EQUAL.',/)
	GO TO 1800
2932	CONTINUE
C	SORT FOR SIMTES
2934	DO 2936 I=1,K
	XC(I)=XB(I)
	N1(I)=N(I)
2936	I1(I)=I
	DO 2938 I=1,KM1
	DO 2938 J=I+1,K
	IF(XC(I).LE.XC(J))GO TO 2938
	TEMP=XC(I)
	XC(I)=XC(J)
	XC(J)=TEMP
	ITMP=N1(I)
	N1(I)=N1(J)
	N1(J)=ITMP
	ITMP=I1(I)
	I1(I)=I1(J)
	I1(J)=ITMP
2938	CONTINUE
	IF(K.LT.5)GO TO 2967
	DO 2966 I=1,(K/5)*5,5
	WRITE(IOUT,2964)(IA,IA=I,I+4),(I1(IA),IA=I,I+4),
     1	(XC(IA),IA=I,I+4)
2964	FORMAT(///' ORDERED MEANS',5(8X,I3),//,
     1	' GROUP #',6X,5(8X,I3),//,' MEAN',9X,5(3X,F8.3))
2966	CONTINUE
	IF(K.EQ.(K/5)*5)GO TO 2976
2967	KB=(K/5)*5+1
	WRITE(IOUT,2969)(IA,IA=KB,K)
2969	FORMAT(///,' ORDERED MEANS',4(8X,I3))
	WRITE(IOUT,2968)(I1(IA),IA=KB,K)
2968	FORMAT(/,' GROUP #',6X,4(8X,I3))
	WRITE(IOUT,2970)(XC(IA),IA=KB,K)
2970	FORMAT(/,' MEAN',9X,4(3X,F8.3))
2976	DO 2921 I=1,KM1
	DO 2921 J=I+1,K
2921	BB(I,J)=XC(J)-XC(I)
	IF(K.LT.6)GO TO 2929
	DO 2923 J=1,(KM1/5)*5,5
	WRITE(IOUT,2931)(JA,JA=J+1,J+5)
2931	FORMAT(///,' ORDERED MEAN DIFFERENCES',//,3X,5(8X,I3))
	DO 2923 IA=1,J+4
	IB=1
	IF(IA.GE.J+1)IB=IA-J+1
	IN0=(IB-1)*11+5
	IN1=IN0/100
	IN2=IN0/10-IN1*10
	IN3=IN0-IN1*100-IN2*10
	SIMFMT(3)=ANUM(IN1)
	SIMFMT(4)=ANUM(IN2)
	SIMFMT(5)=ANUM(IN3)
2923	WRITE(IOUT,SIMFMT)IA,(BB(IA,JA),JA=MAX0(J+1,IA+1),J+5)
	IF((KM1/5)*5.EQ.KM1)GO TO 2927
2929	KB=(KM1/5)*5+2
	WRITE(IOUT,2931)(JA,JA=KB,K)
	DO 2925 IA=1,KM1
	IB=1
	IF(IA.GE.KB)IB=IA-KB+2
	IN0=(IB-1)*11+5
	IN1=IN0/100
	IN2=IN0/10-IN1*10
	IN3=IN0-IN1*100-IN2*10
	SIMFMT(3)=ANUM(IN1)
	SIMFMT(4)=ANUM(IN2)
	SIMFMT(5)=ANUM(IN3)
2925	WRITE(IOUT,SIMFMT)IA,(BB(IA,JA),JA=MAX0(KB,IA+1),K)
2927	CONTINUE
	BB(K,K)=0
	DO 5042 I=1,KM1
	DO 5042 J=I+1,K
	IF(N(I).NE.N(J))GO TO 2939
5042	CONTINUE
	GO TO (5043,5044,5045,5046,5047),IAB
5043	TX=SMW*KM1*2./N1(1)
	T01=SQRT(TX*FPCT(.01,KM1,NTMK))
	T05=SQRT(TX*FPCT(.05,KM1,NTMK))
	T10=SQRT(TX*FPCT(.10,KM1,NTMK))
	WRITE(IOUT,5048)T01,T05,T10
5048	FORMAT(/,' A PAIR OF MEANS IS SIGNIFICANTLY',/,
     1	' DIFFERENT USING THE SCHEFFE PROCEDURE',/,
     1	' AT THE LEVEL OF SIGNIFICANCE',T40,'1%',T50,'5%',T60,'10%',/,
     1	' IF THE DIFFERENCE BETWEEN ANY',/,
     1	' PAIR OF MEANS EXCEEDS',T36,F8.3,T46,F8.3,T56,F8.3,/,
     1	' RESPECTIVELY.',/)
	GO TO 2939
5044	TX=SQRT(SMW/N1(1))
	T01=TX*TUKEY(K,NTMK,1)
	T05=TX*TUKEY(K,NTMK,2)
	IF(TWOFLG.NE.0)GO TO 5049
	T10=TX*TUKEY(K,NTMK,3)
C	WRITE WITH T10
	GO TO 2939
5049	WRITE(IOUT,5050)T01,T05
5050	FORMAT(/,' A PAIR OF MEANS IS SIGNIFICANTLY',/,
     1	' DIFFERENT USING THE TUKEY PROCEDURE',/,
     1	' AT THE LEVEL OF SIGNIFICANCE',T40,'1%',T50,'5%',/,
     1	' IF THE DIFFERENCE BETWEEN ANY',/,
     1	' PAIR OF MEANS EXCEEDS',T36,F8.3,T46,F8.3,/,
     1	' RESPECTIVELY.',/)
	GO TO 2939
5045	TX=SQRT(SMW/N1(1))
	WRITE(IOUT,5051)
5051	FORMAT(/,' A PAIR OF MEANS IS SIGNIFICANTLY DIFFERENT USING',/,
     1	' THE NEWMAN-KEULS PROCEDURE AT THE 1% (5%) LEVEL',/,
     1	' OF SIGNIFICANCE ONLY IF THE RANGE (OR DIFFERENCE)',/,
     1	' OF EACH AND EVERY ORDERED PAIR OF MEANS CONTAINING',/,
     1	' THE ORIGINAL PAIR OF MEANS AND SEPARATED BY I MEANS',/,
     1	' IS GREATER THAN THE 1%(5%) CRITICAL TEST VALUE FOR',/,
     1	' I MEANS.',//,
     1	T13,'CRITICAL TEST VALUE',/,' I',T15,'1%',T25,'5%',/,1X,29('-'))
	DO 5052 I=2,K
	T01=TX*TUKEY(I,NTMK,1)
	T05=TX*TUKEY(I,NTMK,2)
	IF(TWOFLG.NE.0)GO TO 5053
	T10=TX*TUKEY(I,NTMK,3)
C	WRITE WITH T10
	GO TO 5052
5053	WRITE(IOUT,5054)I,T01,T05
5054	FORMAT(1X,I3,T11,F8.3,T21,F8.3)
5052	CONTINUE
	GO TO 2939
5046	TX=SQRT(SMW/N1(1))
	WRITE(IOUT,5055)
5055	FORMAT(/,' A PAIR OF MEANS IS SIGNIFICANTLY DIFFERENT USING',/,
     1	' THE DUNCAN''S PROCEDURE AT THE 1% (5%) LEVEL',/,
     1	' OF SIGNIFICANCE ONLY IF THE RANGE (OR DIFFERENCE)',/,
     1	' OF EACH AND EVERY ORDERED PAIR OF MEANS CONTAINING',/,
     1	' THE ORIGINAL PAIR OF MEANS AND SEPARATED BY I MEANS',/,
     1	'IS GREATER THAN THE 1%(5%) CRITICAL TEST VALUE FOR',/,
     1	' I MEANS.',//,
     1	T13,'CRITICAL TEST VALUE',/,' I',T15,'1%',T25,'5%',/,1X,29('-'))
	IF(NTMK.LE.100)GO TO 5060
	WRITE(IOUT,5062)
	IF(IDVO.NE.'TTY')WRITE(IDLG,5062)
5062	FORMAT(/,' %%%TEST ABORTED SINCE NT-K > 100',/)
	GO TO 1800
5060	DO 5056 I=2,K
	T01=TX*DUNC(I,NTMK,1)
	T05=TX*DUNC(I,NTMK,2)
	IF(TWOFLH.NE.0)GO TO 5064
	WRITE(IOUT,5057)I,T01,T05,T10
5057	FORMAT(1X,I3,T11,F8.3,T21,F8.3,T31,F8.3)
	GO TO 5056
5064	T10=TX*DUNC(I,NTMK,3)
	WRITE(IOUT,5057)I,T01,T05
5056	CONTINUE
	GO TO 2939
5047	TX=SQRT(SMW*2./N1(1))
	T01=TX*TPCT(.005,NTMK)
	T05=TX*TPCT(.025,NTMK)
	T10=TX*TPCT(.05,NTMK)
	WRITE(IOUT,5058)T01,T05,T10
5058	FORMAT(/,' A PAIR OF MEANS IS SIGNIFICANTLY DIFFERENT',/,
     1	' USING THE LEAST SIGNIFICANT DIFFERENCE PROCEDURE',/,
     1	' AT THE LEVEL OF SIGNIFICANCE',T40,'1%',T50,'5%',T60,'10%',/,
     1	' IF THE DIFFERENCE BETWEEN ANY',/,
     1	' PAIR OF MEANS EXCEEDS',T36,F8.3,T46,F8.3,T56,F8.3,/,
     1	' RESPECTIVELY.',/)
2939	DO 2962	I=1,KM1
	BB(I,I)='   '
	DO 2962 J=I+1,K
	RN1N1=1./N1(I)+1./N1(J)
	GO TO (2942,2944,2946,2948,2950),IAB
2942	TX=SMW*(KM1)*RN1N1
	T01=TX*FPCT(.01,KM1,NTMK)
	T05=TX*FPCT(.05,KM1,NTMK)
	T10=TX*FPCT(.1,KM1,NTMK)
	GO TO 2954
2944	TX=SMW/N1(1)
	T01=TX*TUKEY(K,NTMK,1)**2.
	T05=TX*TUKEY(K,NTMK,2)**2.
	IF(TWOFLG.NE.0)GO TO 2954
	T10=TX*TUKEY(K,NTMK,3)**2.
	GO TO 2954
2946	TX=SMW/N1(1)
	JMI1=J-I+1
	T01=TX*TUKEY(JMI1,NTMK,1)**2.
	T05=TX*TUKEY(JMI1,NTMK,2)**2.
	IF(TWOFLG.NE.0)GO TO 2954
	T10=TX*TUKEY(JMI1,NTMK,3)**2.
	GO TO 2954
2948	TX=SMW/N1(1)
	JMI1=J-I+1
	T01=TX*DUNC(JMI1,NTMK,1)**2.
	T05=TX*DUNC(JMI1,NTMK,2)**2.
	IF(TWOFLH.NE.0)GO TO 2954
	T10=TX*DUNC(JMI1,NTMK,3)**2.
	GO TO 2954
2950	TX=SMW*RN1N1
	T01=TX*TPCT(.005,NTMK)**2.
	T05=TX*TPCT(.025,NTMK)**2.
	T10=TX*TPCT(.05,NTMK)**2.
2954	BB(I,J)=0
	BB(J,I)='   '
	XX=(XC(J)-XC(I))**2.
	IF(XX.GE.T01)GO TO 2956
	IF(XX.GE.T05)GO TO 2958
	IF(TWOFLG.NE.0.AND.((IAB.AND.2).EQ.2))GO TO 2962
	IF(TWOFLH.NE.0.AND.IAB.EQ.4)GO TO 2962
	IF(XX.GE.T10)GO TO 2960
	GO TO 2962
2956	BB(I,J)=3.
	GO TO 2962
2958	BB(I,J)=2.
	GO TO 2962
2960	BB(I,J)=1.
2962	CONTINUE
	IF(IAB.EQ.3.OR.IAB.EQ.4)GO TO 2963
	GO TO 2972
2963	DO 2974 I=1,K-2
	DO 2974 J=K,I+2,-1
	IF(BB(I,J).LT.BB(I,J-1))BB(I,J-1)=BB(I,J)
	IF(BB(I,J).LT.BB(I+1,J))BB(I+1,J)=BB(I,J)
2974	CONTINUE
2972	DO 2973 I=1,KM1
	DO 2973 J=I+1,K
	IF(BB(I,J).EQ.0)BB(I,J)='   '
	IF(BB(I,J).EQ.1.)BB(I,J)='  *'
	IF(BB(I,J).EQ.2.)BB(I,J)=' **'
	IF(BB(I,J).EQ.3.)BB(I,J)='***'
2973	CONTINUE
	IF(K.LT.6)GO TO 2982
	DO 2977 J=1,((KM1)/5)*5,5
	WRITE(IOUT,2978)(JA,JA=J+1,J+5)
2978	FORMAT(///,' ORDERED MEANS TEST RESULTS',//,3X,5(8X,I3))
	DO 2977 IA=1,J+4
2977	WRITE(IOUT,2979)IA,(BB(IA,JA),JA=J+1,J+5)
2979	FORMAT(/,1X,I3,5(8X,A3))
	IF(((KM1)/5)*5.EQ.K-1)GO TO 2988
2982	KB=((K-1)/5)*5+2
	WRITE(IOUT,2978)(JA,JA=KB,K)
	DO 2981 IA=1,KM1
2981	WRITE(IOUT,2979)IA,(BB(IA,JA),JA=KB,K)
2988	WRITE(IOUT,2990)
2990	FORMAT(//,' CODE',T22,'*',T30,'SIGNIFICANT AT 10 PERCENT',/,
     1	T21,'**',T30,'SIGNIFICANT AT  5 PERCENT',/,
     1	T20,'***',T30,'SIGNIFICANT AT  1 PER CENT',/,
     1	T20,'(BLANK)',T30,'NON-SIGNIFICANT FOR',/,
     1	T30,'LEVEL LESS THAN 10 PER CENT',/)
	IF(TWOFLG.NE.0.AND.((IAB.AND.2).EQ.2))WRITE(IOUT,2992)
2992	FORMAT(/,' TUKEY SIGNIFICANCE TEST - .1 - IS NOT IMPLEMENTED',/)
	IF(TWOFLH.NE.0.AND.IAB.EQ.4)WRITE(IOUT,2994)
2994	FORMAT(/,' DUNCAN SIGNIFICANCE TEST - .1 IS NOT IMPLEMENTED',/)
	GO TO 1800
C
C	SIMEST OPTION
C
3000	WRITE(IDLG,3002)
3002	FORMAT(' SIMULTANIOUS ESTIMATION PROCEDURE',/)
3004	WRITE(IDLG,3006)
3006	FORMAT(' SELECT ONE OF THE THREE ESTIMATION PROCEDURES',//,
     1	' TYPE:',/,'  1 FOR SCHEFFE',/,'  2 FOR TUKEY',/,
     1	'  3 FOR BONFERRONI',/)
	READ(IRSP,3008,END=1920)IAC
3008	FORMAT(I)
	IF(IAC.GE.1.AND.IAC.LE.3)GO TO 3010
	WRITE(IDLG,1174)
	GO TO 3004
3010	WRITE(IDLG,3012)
3012	FORMAT(' SELECT ONE OF THE THREE CONFIDENCE PROBABILITIES',/,
     1	' TYPE:',/,'  1 FOR 99%',/,'  2 FOR 95%',/,
     1	'  3 FOR 90%',/)
	READ(IRSP,3008,END=1920)IAD
	IF((IAC.NE.2.OR.IAD.NE.3).OR.TWOFLG.EQ.0)GO TO 3015
	WRITE(IDLG,3013)
3013	FORMAT(' 90% CONFIDENCE LEVEL IS NOT IMPLEMENTED',/)
	GO TO 3010
3015	IF(IAD.GE.1.AND.IAD.LE.3)GO TO 3014
	WRITE(IDLG,1174)
	GO TO 3010
3014	IF(IAC.EQ.1)WRITE(IOUT,3016)
3016	FORMAT(' SCHEFFE SIMULTANEOUS ESTIMATION PROCEDURE')
	IF(IAC.EQ.2)WRITE(IOUT,3020)
3020	FORMAT(' TUKEY SIMULTANEOUS ESTIMATION PROCEDURE',/)
	IF(IAC.EQ.3)WRITE(IOUT,3024)
3024	FORMAT(' BONFERRONI SIMULTANEOUS ESTIMATION PROCEDURE',/)
	AE=.01
	IF(IAD.EQ.2)AE=.05
	IF(IAD.EQ.3)AE=.1
3026	ICON=(1.-AE)*100.
	WRITE(IOUT,3028)ICON,ICON
3028	FORMAT(1X,T50,I4,'%',T65,I4,'%',/,
     1	1X,'GROUP-GROUP',T24,'MEAN DIFFERENCE',
     1	T45,'LOWER LIMIT',T60,'UPPER LIMIT',/,1X,72('-'))
	DO 3042 I=1,KM1
	DO 3042 J=I+1,K
	RNINJ=1./N(I)+1./N(J)
	IF(IAC.EQ.1)TT=SQRT(SMW*KM1*RNINJ*FPCT(AE,KM1,NTMK))
	IF(IAC.EQ.2)TT=SQRT(SMW/MIN0(N(I),N(J)))*TUKEY(K,NTMK,IAD)
	IF(IAC.EQ.3)TT=SQRT(SMW*RNINJ)*TPCT(AE/(K*KM1),NTMK)
	DMEAN=XB(I)-XB(J)
	TSEL=DMEAN-TT
	TSEU=DMEAN+TT
	WRITE(IOUT,3040)I,J,DMEAN,TSEL,TSEU
3040	FORMAT(1X,I4,2X,I4,T16,F20.3,T41,F15.3,T57,F15.3,/)
3042	CONTINUE
	GO TO 1800
C
C	COMPAR OPTION
C
3100	WRITE(IDLG,3102)
3102	FORMAT(' ENTER THE COEFFICIENT WEIGHTS ONE AT A TIME',/,
     1	' SEPARATED BY COMMAS (NO MORE THAN 10 PER LINE).',/)
	READ(IRSP,3104,END=1920)(Q(I),I=1,K)
3104	FORMAT(10F)
	CC=0
	CD=0
	SS=0
	DO 3106 I=1,K
	CC=CC+Q(I)*XB(I)
	CD=CD+Q(I)*Q(I)/N(I)
3106	SS=SS+Q(I)
	CD=SQRT(CD*SMW)
	T1=CC/CD
	T1P=FISHER(1,NTMK,T1*T1)
	TU=CD*TPCT(.025,NTMK)
	TL=CC-TU
	TU=CC+TU
	IF(SS.GE.-.000001.AND.SS.LE..000001)GO TO 3108
	T1U=SQRT(K*FPCT(.05,K,NTMK))
	GO TO 3109
3108	T1U=SQRT((K-1)*FPCT(.05,KM1,NTMK))
3109	T1L=CC-T1U*CD
	T1U=CC+T1U*CD
	PLUS='+'
	IF(SS.GE.-.000001.AND.SS.LE..000001)GO TO 3110
	WORDS(1)='EXPRE'
	WORDS(2)='SSION'
	GO TO 3112
3110	WORDS(1)='  CON'
	WORDS(2)='TRAST'
3112	WRITE(IOUT,3114)WORDS,(Q(I),XB(I),PLUS,I=1,KM1),Q(K),XB(K)
3114	FORMAT(/,' THE ESTIMATE FOR THE LINEAR ',2A5,'S',//,
     1	(2(1X,F,' * ',F,1X,A1)/))
	WRITE(IOUT,3116)CC,T1,T1P,TL,TU,T1L,T1U,WORDS
3116	FORMAT(/,' IS ',F,/,' WITH T-VALUE ',F15.3,/,
     1	' AND PROBABILITY ',F6.3,/,' 95% IND. CONF. LIMITS (',
     1	F15.3,',',F15.3,')',/,' AND 95 % SCHEFFE SIMULTANEOUS',/,
     1	' CONFIDENCE LIMITS     (',F15.3,',',F15.3,')',/,
     1	' FOR ALL LINEAR ',2A5,/)
	GO TO 1800
C
C	COLAOV OPTION
C
3200	WRITE(IDLG,3204)
3204	FORMAT(//,' COLLAPSING AOV',/)
3206	WRITE(IDLG,3208)
3208	FORMAT(' HOW MANY NEW GROUPS? ',$)
	READ(IRSP,3212,END=1920)L
3212	FORMAT(I)
	IF(L.GT.0.AND.L.LE.K)GO TO 3216
	WRITE(IDLG,1174)
	GO TO 3206
3216	DO 3218 I=1,K
3218	JG(I)=1
	WRITE(IDLG,3217)
3217	FORMAT(' ENTER NUMBER OF GROUPS FOR EACH OF THE NEW GROUPS',
     1	'(10 PER LINE)',/)
	READ(IRSP,3219,END=1920)(NC(I),I=1,L)
3219	FORMAT(10I)
	KI=0
	DO 3215 I=1,L
3215	KI=KI+NC(I)
	IF(KI.EQ.K)GO TO 3222
	WRITE(IDLG,3221)
3221	FORMAT(' ALL GROUPS MUST BE INCLUDED IN THE COLLAPSED AOV -',
     1' TRY AGAIN',/)
	GO TO 3216
3222	KK=0
	DO 3240 I=1,L
	WRITE(IDLG,3220)I
3220	FORMAT(' SPECIFY THE GROUP NUMBERS FOR THE NEW',
     1	' GROUP ',I3,' (10 PER LINE)',/)
	READ(IRSP,3224,END=1920)(IG(J),J=KK+1,KK+NC(I))
3224	FORMAT(10I)
	DO 3236 J=KK+1,KK+NC(I)
	IF(IG(J).EQ.0.OR.IG(J).GT.K)GO TO 3244
	IF(JG(IG(J)).EQ.0)GO TO 3244
3236	JG(IG(J))=0
3240	KK=KK+NC(I)
	GO TO 3252
3244	WRITE(IDLG,3248)
3248	FORMAT(' THE GROUP NUMBERS ARE INCOMPATABLE - TRY AGAIN',/)
	GO TO 3216
3252	NTD=0
	XDT=0
	WRITE(IOUT,3254)
3254	FORMAT(//,' COLLAPSING AOV ANALYSIS',//,' NEW GROUP',T13,
     1	'OLD GROUPS',T35,'MEAN',T51,'VARIANCE',T63,'STD. DEV.'
     1	,/,1X,70('-'))
	KK=0
	DO 3264 I=1,L
	XD(I)=0
	ND(I)=0
	VD(I)=0
	DO 3260 J=KK+1,KK+NC(I)
	XD(I)=XD(I)+N(IG(J))*XB(IG(J))
	ND(I)=ND(I)+N(IG(J))
	VD(I)=VD(I)+(N(IG(J))-1)*V(IG(J))
3260	CONTINUE
	XD(I)=XD(I)/ND(I)
	DO 3286 J=KK+1,KK+NC(I)
3286	VD(I)=VD(I)+N(IG(J))*(XB(IG(J))-XD(I))**2
	VD(I)=VD(I)/(ND(I)-1)
	NTD=NTD+ND(I)
	XDT=XDT+ND(I)*XD(I)
	SVD=SQRT(VD(I))
	WRITE(IOUT,3258)I,(IG(J),J=KK+1,KK+NC(I))
3258	FORMAT(5X,I3,(T17,15(I3,1X),/))
	WRITE(IOUT,3256)XD(I),VD(I),SVD
3256	FORMAT(1X,T23,F15.3,T48,F10.3,F10.3,/)
	KK=KK+NC(I)
3264	CONTINUE
	XDT=XDT/NTD
	SDA=0
	SWD=0
	DO 3268 I=1,L
3268	SDA=SDA+ND(I)*(XD(I)-XDT)**2.
	SWD=ST-SDA
	SMD=SDA/(L-1)
	SMWD=SWD/(NTD-L)
	FD=SMD/SMWD
	NTDML=NTD-L
	NTDM1=NTD-1
	LM1=L-1
	FPD=FISHER(LM1,NTDML,FD)
	STD=SDA+SWD
	WRITE(IOUT,3274)SDA,LM1,SMD,FD,FPD,SWD,NTDML,SMWD,STD,NTDM1
3274	FORMAT(/,T21,'*** COLLAPSED AOV TABLE ***',//,
     1	1X,'SOURCE',T20,'SS',T30,'DF',T44,'MS',
     1	T60,'F',T67,'F-PROB',/,1X,72('-'),/,
     1	1X,'GROUPS',T11,F15.3,T28,I4,T34,F15.3,T51,F13.3,T68,F5.3,//,
     1	1X,'WITHIN GR',T11,F15.3,T28,I4,T34,F15.3,//,
     1	1X,'TOTAL',T11,F15.3,T28,I4,/)
	WRITE(IOUT,3276)L
3276	FORMAT(/,' T-TESTS FOR THE EQUALITY OF EACH PAIR OF THE ',I5,/,
     1	' NEW GROUPS.',/,' THE PROBABILITY ASSOCIATED WITH EACH',
     1	' T-VALUE IS CORRECT',/,' FOR A TWO-TAILED TEST. A ONE-TAILED',
     1	' TEST MAY BE OBTAINED',/,' BY HALVING THE PROBABILITY',
     1	' VALUE GIVEN.',/)
C	ANOVA TABLE HEADING
	WRITE(IOUT,3277)
3277	FORMAT(//,T5,'NEW',T17,'TWO-SAMPLE T',T60,'MEAN',/,
     1	1X,'GROUP-GROUP',T20,'VALUE',T32,'DF',T44,'PROB',T56,
     1	1X,'DIFFERENCE',/,1X,70('-'),/)
	DO 3284 I=1,LM1
	DO 3284 J=I+1,L
	XDD=XD(I)-XD(J)
	TXDD=XDD/SQRT(SMWD*(1./ND(I)+1./ND(J)))
	TPDD=FISHER(1,NTDML,TXDD*TXDD)
	WRITE(IOUT,3278)I,J,TXDD,NTDML,TPDD,XDD
3278	FORMAT(1X,I3,T9,I3,T12,F15.3,T28,I6,T34,F15.3,T50,F15.3,/)
3284	CONTINUE
	GO TO 1800
C
C	NEST OPTION
C
3300	WRITE(IDLG,3304)
3304	FORMAT(//' NESTED AOV'/)
3306	WRITE(IDLG,3308)
3308	FORMAT(' HOW MANY NESTS? ',$)
	READ(IRSP,3312,END=1920)L
3312	FORMAT(I)
	IF(L.GT.0.AND.L.LE.K) GOTO 3316
	WRITE(IDLG,1174)
	GOTO 3306
3316	DO 3318 I=1,K
3318	JG(I)=1
	WRITE(IDLG,3317)
3317	FORMAT(' ENTER NUMBER OF GROUPS FOR EACH OF THE NESTS',
	1	'(10 PER LINE)'/)
	READ(IRSP,3319,END=1920)(NC(I),I=1,L)
3319	FORMAT(10I)
	KI=0
	DO 3315 I=1,L
3315	KI=KI+NC(I)
	IF(KI.EQ.K) GOTO 3322
	WRITE(IDLG,3321)
3321	FORMAT(' ALL GROUPS MUST BE INCLUDED IN THE NESTED AOV -',
	1	' TRY AGAIN'/)
	GOTO 3316
3322	KK=0
	DO 3340 I=1,L
	WRITE(IDLG,3320)I
3320	FORMAT(' SPECIFY THE GROUP NUMBERS FOR THE NEST ',I3,
	1	' (10 PER LINE)'/)
	READ(IRSP,3324,END=1920)(IG(J),J=KK+1,KK+NC(I))
3324	FORMAT(10I)
	DO 3336 J=KK+1,KK+NC(I)
	IF(IG(J).EQ.0.OR.IG(J).GT.K) GOTO 3344
	IF(JG(IG(J)).EQ.0) GOTO 3344
3336	JG(IG(J))=0
3340	KK=KK+NC(I)
	GOTO 3352
3344	WRITE(IDLG,3348)
3348	FORMAT(' THE GROUP NUMBERS ARE INCOMPATIBLE - TRY AGAIN'/)
	GOTO 3316
3352	NTD=0
	XDT=0
	WRITE(IOUT,3354)
3354	FORMAT(//' NESTED AOV ANALYSIS'//' NEST',T13,
	1	'OLD GROUPS',T35,'MEAN',T51,'VARIANCE',T63,
	2	'STD. DEV.'/1X,70('-'))
	KK=0
	DO 3364 I=1,L
	XD(I)=0
	ND(I)=0
	VD(I)=0
	DO 3360 J=KK+1,KK+NC(I)
	XD(I)=XD(I)+N(IG(J))*XB(IG(J))
	ND(I)=ND(I)+N(IG(J))
	VD(I)=VD(I)+(N(IG(J))-1)*V(IG(J))
3360	CONTINUE
	XD(I)=XD(I)/ND(I)
	DO 3386 J=KK+1,KK+NC(I)
3386	VD(I)=VD(I)+N(IG(J))*(XB(IG(J))-XD(I))**2
	VD(I)=VD(I)/(ND(I)-1)
	NTD=NTD+ND(I)
	XDT=XDT+ND(I)*XD(I)
	SVD=SQRT(VD(I))
	WRITE(IOUT,3358)I,(IG(J),J=KK+1,KK+NC(I))
3358	FORMAT(5X,I3,(T17,15(I3,1X)/))
	WRITE(IOUT,3356)XD(I),VD(I),SVD
3356	FORMAT(1X,T23,F15.3,T48,F10.3,F10.3/)
	KK=KK+NC(I)
3364	CONTINUE
	XDT=XDT/NTD
	SDA=0
	SWD=0
	DO 3368 I=1,L
3368	SDA=SDA+ND(I)*(XD(I)-XDT)**2.
	SMD=SDA/(L-1)
	SWA=SB-SDA
	SMA=SWA/(K-L)
	FD1=SMD/SMW
	FD2=SMA/SMW
	IDFF=NT-K
	LM1=L-1
	LM2=K-L
	FPD1=FISHER(LM1,IDFF,FD1)
	FPD2=FISHER(LM2,IDFF,FD2)
	WRITE(IOUT,3374)SDA,LM1,SMD,FD1,FPD1,SWA,LM2,SMA,FD2,FPD2,
	1	SW,IDFF,SMW,ST,NTM1
3374	FORMAT(/T21,'*** NESTED AOV TABLE ***',//
	1  ' SOURCE',T20,'SS',T30,'DF',T44,'MS',T60,'F',T67,'F-PROB'/
	2  1X,72('-')/
	3  ' BETWEEN'/
	4  ' NESTS',T11,F15.3,T28,I4,T34,F15.3,T51,F13.3,T68,F5.3/
	5  ' WITHIN'/
	6  ' NESTS',T11,F15.3,T28,I4,T34,F15.3,T51,F13.3,T68,F5.3/
	7  ' '/
	8  ' WITHIN',T11,F15.3,T28,I4,T34,F15.3/
	9  1X,72('-')/
	1  ' TOTAL',T11,F15.3,T28,I4//)
	WRITE(IOUT,3376)L
3376	FORMAT(/' T-TESTS FOR THE EQUALITY OF EACH PAIR OF THE ',I5/
	1	' NEW GROUPS'/' THE PROBABILITY ASSOCIATED WITH EACH',
	2	' T-VALUE IS CORRECT'/' FOR A TWO-TAILED TEST. A ONE-',
	3	'TAILED TEST MAY BE OBTAINED'/' BY HALVING THE PROBA',
	4	'BILITY VALUE GIVEN.'/)
C
C	ANOVA TABLE HEADING
C
	WRITE(IOUT,3377)
3377	FORMAT(//T5,'NEW',T17,'TWO-SAMPLE T',T60,'MEAN'/
	1	' GROUP-GROUP',T20,'VALUE',T32,'DF',T44,'PROB',T56,
	2	' DIFFERENCE'/1X,70('-')/)
	DO 3384 I=1,LM1
	DO 3384 J=I+1,L
	XDD=XD(I)-XD(J)
	TXDD=XDD/SQRT(SMW*(1./ND(I)+1./ND(J)))
	TPDD=FISHER(1,IDFF,TXDD*TXDD)
	WRITE(IOUT,3378)I,J,TXDD,IDFF,TPDD,XDD
3378	FORMAT(1X,I3,T9,I3,T12,F15.3,T28,I6,T34,F15.3,T50,F15.3/)
3384	CONTINUE
	GOTO 1800
9999	END
C
C	SUBROUTINE PACKAGE FOR ADVAOV
C
C---------------STUDR RETURNS TUKEY WHICH IS THE FUNCTION VALUE
	FUNCTION TUKEY(IM,IDF,IA1)
	IA=2-IA1
	CALL STUDR(TUKEY,IA,IDF,IM,IER)
	IF(IER.EQ.0)RETURN
c	Next four TYPE statements were WRITE(-1,n) which is illegal.
c	Edit by Paul T. Robinson, Wesleyan Univ, 18 Oct 1980
	type 40
40	FORMAT(' ERROR IN SUBROUTINE-STUDR')
10	type 11
11	FORMAT(' -INCORRECT VALUE FOR SIGNIFICANCE LEVEL',/)
	RETURN
20	type 21, idf
21	FORMAT(' -DEGREES OF FREEDOM OUTSIDE LIMITS',I5,/)
	RETURN
30	type 31, im
31	FORMAT(' -ILLEGAL NUMBER OF MEANS ',I5,/)
	RETURN
	END
C---------------DUNCAN RETURNS DUNC WHICH IS THE FUNCTION VALUE.
	FUNCTION DUNC(L,M,N)
C	INTERFACE ROUTINE FOR DUNCAN SUBROUTINE
	IA=2-N
	CALL DUNCAN(DUNC,IA,M,L,IERR)
C	ERRORS HANDLED INTERNALLY IN ADVAOV
	RETURN
	END
C---------------K IS INPUT, I1, I2 ARE OUTPUT.
	SUBROUTINE INITIA(K,I1,I2)
	DIMENSION I1(1),I2(1)
	DO 1000	I=1,K
	I1(I)=0
	I2(I)=0
1000	CONTINUE
	RETURN
	END
C	TRANSFORMATION SUBROUTINE
C---------------I, X ARE INPUT;  X IS MODIFIED, IERR IS OUTPUT.
	SUBROUTINE TRANSF(I,X,IERR)
	IF(I.EQ.0)RETURN
	GO TO (3910,3920,3930,3940,3950),I
3910	IF(X.GE.0)GO TO 3916
3912	IERR=1
	RETURN
3916	X=SQRT(X)
	RETURN
3920	IF(X.LT.0.OR.X.GT.1)GO TO 3912
	X=ASIN(SQRT(X))
	RETURN
3930	IF(X.LE.0)GO TO 3912
	X=ALOG(X)
	RETURN
3940	IF(X.EQ.0)GO TO 3912
	X=1./X
3950	RETURN
	END
C	RANKS TRANSFORMATION ROUTINE
C---------------IAUX, METH, NT, LMAX, IRNK, IDKOL, IBKOL, 
C--------------- NREC ARE INPUT.  IV, DATA, X ARE OUTPUT.
	SUBROUTINE RANKER(IV,DATA,X,NT,IAUX,IRNK,METH,IDKOL,IBKOL,
     1NREC,LMAX)
	DIMENSION DATA(1),IV(1),X(1)
	REWIND(IAUX)
	IF(METH-2)4110,4210,4210
4110	DO 4112 I=1,(NT+124)/125
4112	READ(IAUX)(DATA((I-1)*125+L),L=1,125)
	GO TO 4410
4210	IREC=0
	LVAL=124
4214	IF(IREC.EQ.NREC)GO TO 4410
4213	READ(IAUX)(X(L),L=1,124)
	IREC=IREC+1
	IF(IREC.EQ.NREC)LVAL=LMAX
	DO 4220 L=1,LVAL/2
	DATA(L)=X(L*2-2+IDKOL)
4220	DATA(L+NT)=X(L*2-2+IBKOL)
	GO TO 4214
4410	CALL SORT(1,NT,1,NT,DATA,1,1,IV,1)
	J=1
	SUM=1
	DO 4416 I=2,NT
	IF(DATA(IV(I)).EQ.DATA(IV(J)))GO TO 4416
	R=SUM/(I-J)
	DO 4414 K=J,I-1
4414	DATA(IV(K))=R
	J=I
	SUM=0
4416	SUM=SUM+I
	DO 4418 K=J,NT
4418	DATA(IV(K))=SUM/(NT-J+1)
	REWIND(IRNK)
	IF(METH-2)4510,4610,4610
4510	DO 4512 I=1,(NT+124)/125
4512	WRITE(IRNK)(DATA((I-1)*125+L),L=1,125)
	RETURN
4610	IREC=0
	LVAL=124
4614	IF(IREC.EQ.NREC)RETURN
4613	WRITE(IRNK)(X(L),L=1,124)
	IREC=IREC+1
	IF(IREC.EQ.NREC)LVAL=LMAX
	DO 4620 L=1,64
	X(L*2-2+IDKOL)=DATA(L)
4620	X(L*2-2+IBKOL)=DATA(L+NT)
	GO TO 4614
	END
C---------------THIS SUBR. WAS TAKEN FROM STP.
C	SORT ROUTINE FOR RANKS TRANSFORMATION CALLED FROM RANKER.
C     CALLING SEQUENCE: CALL SORT(NV,NC,MV,MC,DATA,IS,KKL,IV,SP)
C     WHERE: NV - NUMBER OF VARIABLES
C            NC - NUMBER OF OBSERVATIONS
C            MV - MAXIMUM NUMBER OF VARIABLES POSSIBLE
C            MC - MAXIMUM NUMBER OF OBSERVATIONS POSSIBLE
C            DATA - MATRIX CONTAINING DATA
C            IS - IS A VECTOR CONTAINING SORT KEYS MUST BE AT LEAST
C                 KKL LONG
C            KKL - NUMBER OF SORT KEYS
C            IV - EXTRA VECTOR AT LEAST NV LONG
C            SP - EXTRA VECTOR AT LEAST NC LONG
C
C     SORTING METHOD USED IS PARTITIONING SORT ORIGINALLY OBTAINED
C     FROM CACM, MARCH 1969, PAGES 185-187.
C---------------THIS IS A SUBSTANTIAL MODIFICATION OF THE
C--------------- ORIGINAL PROGRAM.
C---------------CALL ARGUMENTS ARE INPUT AND IV IS MODIFIED.
C--------------- E.G. IV STARTS WITH 1,2,3,4,5(SEE SUBR. SORT ST. 1
C--------------- AND 1-1.);  DATA HAS 4,2,5,3,1;  SUBR. SORT PUTS
C--------------- IV INTO 5,2,4,1,3 I.E. DATA (IV) IS IN ASCENDING ORDER.
C
      SUBROUTINE SORT(NV,NC,MV,MC,DATA,IS,KKL,IV,SP)
C---------------SP NOT FOUND IN SORT
      DIMENSION DATA(MC,MV),IV(1),IS(1),IU(16),IL(16),SP(1)
      DIMENSION GIP(25)
      DO 1 I=1,NC
1     IV(I)=I
      M=1
      II=1
      J=NC
11    IF(II.GE.J) GO TO 18
12    K=II
      IJ=(J+II)/2
      I=0
31    I=I+1
      IF(I.GT.KKL) GO TO 33
      T1=DATA(IV(IJ),IS(I))
      T2=DATA(IV(II),IS(I))
      IF(T2.EQ.T1) GO TO 31
      IF(T2.LT.T1) GO TO 13
      GO TO 32
33    IF(IV(II).LE.IV(IJ)) GO TO 13
32    ISAV=IV(IJ)
      IV(IJ)=IV(II)
      IV(II)=ISAV
13    LL=J
      I=0
34    I=I+1
      IF(I.GT.KKL) GO TO 36
      T1=DATA(IV(IJ),IS(I))
      T2=DATA(IV(J),IS(I))
      IF(T2.EQ.T1) GO TO 34
      IF(T2.GT.T1) GO TO 5
      GO TO 35
36    IF(IV(J).GE.IV(IJ)) GO TO 5
35    ISAV=IV(IJ)
      IV(IJ)=IV(J)
      IV(J)=ISAV
      I=0
37    I=I+1
      IF(I.GT.KKL) GO TO 39
      T1=DATA(IV(IJ),IS(I))
      T2=DATA(IV(II),IS(I))
      IF(T2.EQ.T1) GOTO 37
      IF(T2.LT.T1) GO TO 5
      GO TO 38
39    IF(IV(II).LE.IV(IJ)) GO TO 5
38    ISAV=IV(IJ)
      IV(IJ)=IV(II)
      IV(II)=ISAV
      GO TO 5
5     DO 6 L=1,KKL
6     GIP(L)=DATA(IV(IJ),IS(L))
      NEXTRA=IV(IJ)
      GO TO 15
14    ISAV=IV(LL)
      IV(LL)=IV(K)
      IV(K)=ISAV
15    LL=LL-1
      I=0
40    I=I+1
      IF(I.GT.KKL) GO TO 41
      T1=GIP(I)
      T2=DATA(IV(LL),IS(I))
      IF(T2.EQ.T1) GO TO 40
      IF(T2.GT.T1) GO TO 15
      GO TO 16
41    IF(IV(LL).GT.NEXTRA) GO TO 15
16    K=K+1
      I=0
42    I=I+1
      IF(I.GT.KKL) GO TO 44
      T1=GIP(I)
      T2=DATA(IV(K),IS(I))
      IF(T2.EQ.T1) GO TO 42
      IF(T2.LT.T1) GO TO 16
      GO TO 43
44    IF(IV(K).LT.NEXTRA) GO TO 16
43    IF(K.LE.LL) GO TO 14
      IF((LL-II).LE.(J-K)) GO TO 17
      IL(M)=II
      IU(M)=LL
      II=K
      M=M+1
      GOTO 19
17    IL(M)=K
      IU(M)=J
      J=LL
      M=M+1
      GOTO 19
18    M=M-1
      IF(M.EQ.0) GO TO 90
      II=IL(M)
      J=IU(M)
19    IF((J-II).GE.11) GO TO 12
      IF(II.EQ.1) GO TO 11
C
C     BUBLE SORT PORTION (FASTER THAN PARTITION ONLY IF SUBSET
C     BEING LOOKED AT IS 11 OBSERVATIONS OR LESS)
C
106   FORMAT(1X,I4)
      II=II-1
20    II=II+1
      IF(II.EQ.J) GO TO 18
      I=0
      NEXTRA=IV(II+1)
45    I=I+1
      IF(I.GT.KKL) GO TO 47
      T1=DATA(NEXTRA,IS(I))
      T2=DATA(IV(II),IS(I))
      IF(T2.EQ.T1) GO TO 45
      IF(T2.LT.T1) GO TO 20
      GO TO 46
47    IF(IV(II).LE.NEXTRA) GO T O 20
46    K=II
21    IV(K+1)=IV(K)
      K=K-1
      I=0
48    I=I+1
      IF(I.GT.KKL) GO TO 50
      T1=DATA(NEXTRA,IS(I))
      T2=DATA(IV(K),IS(I))
      IF(T2.EQ.T1) GOTO 48
      IF(T1.LT.T2) GO TO 21
      GO TO 49
50    IF(NEXTRA.LT.IV(K)) GO TO 21
49    IV(K+1)=NEXTRA
      GO TO 20
90	RETURN
	END