Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
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