PDP-10 Archive: 43,50520/stp19.stp from decuslib10-10

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50520/stp19.stp
There are no other files named stp19.stp in the archive.
      SUBROUTINE LATIN(NV,NC,MV,MC,DATA,IVAR,NAMES)
      DIMENSION D(20,20),LEV(20,20),INPUT(80),OPT(4),IVECT(20),ITMP(2)
      DIMENSION IVAR(1),ALPH(20),BETA(20),GAMMA(20),NAMES(1)
      DIMENSION DATA(MC,MV)
      COMMON /DEV/ ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP
      COMMON /EXTRA/ HEDR(70),NSZ
1     MAXSIZ=20
      DO 999 I=1,4
999   OPT(I)=0
      IF(ICC.NE.2) WRITE(IDLG,2)
2     FORMAT(' ENTER OPTIONS? ',$)
      READ(ICC,3,END=9999) (INPUT(J),J=1,10)
3     FORMAT(10(A5,1X))
      IF(INPUT(1).EQ.'!') RETURN
      DO 4 J=1,4
      IF(INPUT(J).EQ.' ') GO TO 4
      IF(INPUT(J).NE.'HELP') GO TO 6
      WRITE(IDLG,5)
5     FORMAT('0THE LATIN SQUARE COMMAND ALLOWS FOR A MAXIMUM OF A'/
     1' 20X20 LATIN SQUARE, AND REQUIRES ALL CELLS TO BE FILLED WITH'/
     1' EXACTLY ONE OBSERVATION PER CELL. THE NORMAL DATA INPUT'/
     1' METHOD WILL BE N VARIABLES EACH CONTAINING N OBSERVATIONS.'/
     1' WHERE THE LATIN SQUARE IS CREATED BY SHIFTING EACH '/
     1' SUCCESSIVE ROW 1 COLUMN.  THE MODEL USED DOES NOT ALLOW'/
     1' FOR INTERACTION PARAMETERS.  OPTIONS ARE AVAILABLE TO ENTER'/
     1' AN ALTERNATE LATIN SQUARE, AND TO FORM CELLS FROM ONE'/
     1' VARIABLE ON THE BASIS OF 2 BREAKDOWN VARIABLES'/
     1' OPTIONS ARE:'/
     1'   BREAK - FORM CELLS FROM ONE VARIABLE BASED ON THE VALUES'/
     1'           FOUND IN TWO OTHER VARIABLES (ROW AND COLUMN'/
     1'           BREAKDOWN VARIABLES).'/
     1'   LATIN - USER SPECIFIED LATIN SQUARE TO BE USED.'/
     1'   LEAST - OUTPUT LEAST SQUARE ROW, COLUMN, AND TREATMENT'/
     1'           ESTIMATES.'/
     1'   LSIZE - USER SPECIFIED SIZE OF LATIN SQUARE OTHER THAN'/
     1'           MACHINE DETERMINED DEFAULT.'/
     1'0IF NO OPTIONS ARE DESIRED TYPE A CARRIAGE RETURN.')
      GO TO 1
6     IF(INPUT(J).NE.'BREAK') GO TO 7
      OPT(1)=1
      GO TO 4
7     IF(INPUT(J).NE.'LATIN') GO TO 8
      OPT(2)=1
      GO TO 4
8     IF(INPUT(J).NE.'LEAST') GO TO 9
      OPT(3)=1
      GO TO 4
9     IF(INPUT(J).NE.'LSIZE') GO TO 20
      OPT(4)=1
      GO TO 4
20    WRITE(IDLG,21) INPUT(J)
21    FORMAT(' OPTION "',A5,'" NOT AVAILABLE')
      GO TO 1
4     CONTINUE
C
C     SIZE OF LATIN SQUARE ENTERED BY USER
C
30    IF(OPT(4).NE.1) GO TO 60
      WRITE(IDLG,31)
31    FORMAT('+SIZE OF LATIN SQUARE? ',$)
      READ(ICC,32,END=9999) INPUT
32    FORMAT(80A1)
      IF(INPUT(1).EQ.'!') RETURN
      IF((INPUT(1).NE.'H').OR.(INPUT(2).NE.'E').OR.(INPUT(3).NE.'P')
     1.OR.(INPUT(4).NE.'P')) GO TO 35
      WRITE(IDLG,34)
34    FORMAT(' ENTER SIZE OF LATIN SQUARE TO BE RUN (MAXIMUM IS 20).'/
     1' TO LWT THE MACHINE CHOOSE THE SIZE BASED ON THE DATA TYPE'/
     1' "DEFLT"'/)
      GO TO 30
35    IF((INPUT(1).EQ.'D').AND.(INPUT(2).EQ.'E').AND.(INPUT(3).EQ.'F')
     1.AND.(INPUT(4).EQ.'L').AND.(INPUT(5).EQ.'T')) GO TO 60
      I=1
36    IF(INPUT(I).EQ.' ') GO TO 41
      IF((INPUT(I).LT.'0').OR.(INPUT(I).GT.'9')) GO TO 39
      I=I+1
      IF(I.LE.2) GO TO 36
      IF(INPUT(3).EQ.' ') GO TO 42
37     WRITE(IDLG,38)
38    FORMAT(' MAXIMUM SIZE FOR LATIN SQUARE IS 20 X 20'/)
      GO TO 30
39    WRITE(IDLG,40) INPUT(I)
40    FORMAT(' ILLEGAL CHARACTER "',A1,'" IN SPECIFICATION')
      GO TO 30
41    INPUT(2)=INPUT(1)
      INPUT(1)=' '
42    ENCODE(2,32,INPUT(3))(INPUT(J),J=1,2)
      DECODE(2,43,INPUT(3)) MAXSIZ
43    FORMAT(I2)
      IF(MAXSIZ.LE.20) GO TO 60
      MAXSIZ=20
      GO TO 37
C
C     ****************************************************************
C     *****************************************************************
60    IF(OPT(1).EQ.1) GO TO 150
C
C     BREAK OPTION NOT USED
C
61    IF(ICC.NE.2) WRITE(IDLG,62)
62    FORMAT(' WHICH VARIABLES? ',$)
      CALL ALPHA(IVECT,MAXSIZ,N,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 61
      IF(IHELP.NE.1) GO TO 64
      WRITE(IDLG,63)
63    FORMAT(' ENTER VARIABLES TO BE USED AS COLUMNS IN THE LATIN'/
     1' SQUARE.  THE LATIN SQUARE SHOULD CONTAIN THE SAME NUMBER OF'/
     1' VARIABLES AS OBSERVATIONS.  IF FEWER OBSERVATIONS EXIST THAN'/
     1' VARIABLES, THE LAST VARIABLES ENTERED WILL BE ELIMINATED.'/
     1' IF FEWER VARIABLES EXIST THAN OBSERVATIONS, THEN THE'/
     1' ADDITIONAL OBSERVATIONS WILL BE ELIMINATED.'/)
      GO TO 61
64    IF(N.GT.1) GO TO 66
      WRITE(IDLG,65)
65    FORMAT(' MUST BE AT LEAST A 2 X 2 MATRIX')
      GO TO 61
66    DO 72 I=1,N
      IF(IVECT(I).NE.-2) GO TO 72
      IF(MAXSIZ.GT.NV) MAXSIZ=NV
      DO 73 J=1,MAXSIZ
73    IVECT(J)=J
      GO TO 74
72    CONTINUE
      DO 67 I=1,N-1
      IF(IVECT(I).EQ.-1) GO TO 67
      DO 68 J=I+1,N
      IF(IVECT(J).EQ.-1) GO TO 68
      IF(IVECT(J).NE.IVECT(I)) GO TO 68
      WRITE(IDLG,69) NAMES(IVECT(J))
69    FORMAT(' VARIABLE "',A5,' LISTED TWICE')
      GO TO 61
68    CONTINUE
67    CONTINUE
      IF(NV.GE.N) GO TO 71
      WRITE(IDLG,70)
70    FORMAT(' MORE *''S THAN AVAILABLE VARIABLES')
      GO TO 61
71    MAX=N
      IF(NC.LT.MAX) MAX=NC
      IF(MAXSIZ.LT.MAX) MAX=MAXSIZ
      IF(MAX.LT.MAXSIZ) MAXSIZ=MAX
74    IF(OPT(2).EQ.1) GO TO 90
C
C     CONSTRUCT LATIN SQUARE
C
      DO 80 I=1,MAXSIZ
      J=I
      DO 80 K=1,MAXSIZ
      LEV(I,J)=K
      J=J+1
      IF(J.GT.MAXSIZ) J=1
80    CONTINUE
	DO 9911 I=1,MAXSIZ
9911	TYPE 9912,(LEV(I,J),J=1,MAXSIZ)
9912	FORMAT(10I3)
      GO TO 121
C
C     USER ENTERS THE LATIN SQUARE
C
90    IF(ICC.NE.2) WRITE(IDLG,91)
91    FORMAT('0ENTER THE LATIN SQUARE'/)
      DO 92 I=1,MAXSIZ
93    IF(ICC.NE.2) WRITE(IDLG,94) I
94    FORMAT('+',I2,'? ',$)
      READ(ICC,32,END=9999) INPUT
      IF(INPUT(1).EQ.'!') RETURN
      IF((INPUT(1).NE.'H').OR.(INPUT(2).NE.'E').OR.(INPUT(3).NE.'L')
     1.OR.(INPUT(4).NE.'P')) GO TO 101
      WRITE(IDLG,95) MAXSIZ
95    FORMAT(' AFTER EACH LINE NUMBER, ENTER THE CELL TREATMENTS'/
     1' (1 TO ',I2,') FOR THAT ROW.  REMEMBER EACH TREATMENT'/
     1' MUST APPEAR EXACTLY ONCE IN EACH ROW.  THIS SAME LATIN'/
     1' SQUARE WILL BE USED FOR ALL DATA IN THIS COMMAND'/)
      GO TO 93
101   M=1
      J=1
96    L=1
      ITMP(1)=' '
      ITMP(2)=' '
97    IF(INPUT(J).EQ.' ') GO TO 102
      IF(INPUT(J).EQ.',') GO TO 102
      IF((INPUT(J).GE.'0').AND.(INPUT(J).LE.'9')) GO TO 100
98    WRITE(IDLG,99) INPUT(J),MAXSIZ
99    FORMAT(' ILLEGAL CHARACTER "',A1,'" ALL TREATMENTS MUST'/
     1' BE EXPRESSED AS NUMBERS 1-',I2,'.'/)
      GO TO 93
100   IF(L.GT.2) GO TO 98
      ITMP(L)=INPUT(J)
      L=L+1
      J=J+1
      IF(J.LE.80) GO TO 97
102   IF(ITMP(2).NE.' ') GO TO 103
      ITMP(2)=ITMP(1)
      ITMP(1)=' '
103   ENCODE(2,32,TMP) ITMP
      DECODE(2,104,TMP) LEV(I,M)
104   FORMAT(I2)
      IF((LEV(I,M).NE.0).AND.(LEV(I,M).LE.MAXSIZ)) GO TO 106
      TYPE 9731,ITMP,M,LEV(I,M)
9731  FORMAT(1X,2A1,2X,I3,2X,I3)
      WRITE(IDLG,105) MAXSIZ
105   FORMAT(' LATIN SQUARE MUST BE DEFINED BY NUMBERS BETWEEN 1 AND ',
     1I2/)
      GO TO 93
106   IF(M.EQ.1) GO TO 109
      DO 107 K=1,M-1
      IF(LEV(I,M).NE.LEV(I,K)) GO TO 107
      WRITE(IDLG,108) LEV(I,M)
108   FORMAT(' TREATMENT ',I2,' USED TWICE IN THIS ROW'/)
      GO TO 93
107   CONTINUE
109   IF(I.EQ.1) GO TO 112
      DO 110 K=1,I-1
      IF(LEV(I,M).NE.LEV(K,M)) GO TO 110
      WRITE(IDLG,111) LEV(I,M)
111   FORMAT(' TREATMENT ',I2,' USED TWICE IN THIS COLUMN'/)
      GO TO 93
110   CONTINUE
112   J=J+1
      M=M+1
      IF(M.LE.MAXSIZ) GO TO 96
92    CONTINUE
C
C     NOW BEGIN ASSEMBLING DATA TO BE USED
C
121   K=1
      DO 120 I=1,MAXSIZ
      IVAR(I)=IVECT(I)
      IF(IVECT(I).GT.0) GO TO 120
      IVAR(I)=K
      K=K+1
120   CONTINUE
      GO TO 135
C
C     FIRST TIME THRU FINISHED (EVERYTHING SETUP), EACH SUCCESSIVE
C     TIME COME BACK TO STATEMENT 130.
C
130   J=MAXSIZ
131   IF(IVECT(J).GT.0) GO TO 132
      IVAR(J)=IVAR(J)+1
      IF(IVAR(J).LE.NV) GO TO 133
132   J=J-1
      IF(J.GE.1) GO TO 131
      RETURN
133   K=IVAR(J)
      IF(J.EQ.MAXSIZ) GO TO 135
      DO 134 I=J+1,NN
      IF(IVECT(I).GT.0) GO TO 134
      K=K+1
      IF(K.GT.NV) GO TO 132
      IVAR(I)=K
134   CONTINUE
135   DO 136 I=1,MAXSIZ-1
      DO 136 J=I+1,MAXSIZ
      IF(IVAR(I).EQ.IVAR(J)) GO TO 130
136   CONTINUE
C
C     DATA IS NOW AVAILABLE ARRANGE IN MATRIX AND DO CALCULATIONS
C
      DO 140 I=1,MAXSIZ
      DO 140 J=1,MAXSIZ
140   D(I,J)=DATA(J,IVAR(I))
      GO TO 250
C
C
C     ****************************************************************
C     *****************************************************************
C
C     BREAK OPTION USED
C
C
C
150   IF(ICC.NE.2) WRITE(IDLG,151)
151   FORMAT('+WHICH VARIABLES ARE TO BE ANALYSED? ',$)
      CALL ALPHA(IVAR,NV,N,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 150
      IF(IHELP.NE.1) GO TO 153
      WRITE(IDLG,152)
152   FORMAT(' ENTER VARIABLE WHICH ARE TO BE ANALYSED ON ONE LINE'/
     1' SEPERATED BY COMMAS.  RANGES OF VARIABLES MAY BE ENTERED'/
     1' BY TYPING THE EXTREMES OF THE RANGE SEPARATED BY A "-"'/
     1' IF ALL VARIABLES EXCEPT THOSE USED AS BREAKDOWN VARIABLES'/
     1' ARE TO BE ANALYSED TYPE "ALL"'/)
      GO TO 150
153   DO 154 J=1,N
      IF(IVAR(J).LT.1) GO TO 155
154   CONTINUE
      GO TO 157
155   N=NV
      DO 156 I=1,NV
156   IVAR(I)=I
157   IF(ICC.NE.2) WRITE(IDLG,158)
158   FORMAT('+WHICH VARIABLE DETERMINES THE COLUMN? ',$)
      CALL ALPHA(ICOL,1,N1,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 157
      IF(IHELP.NE.1) GO TO 160
      WRITE(IDLG,159)
159   FORMAT(' ENTER THE VARIABLE TO BE USED AS THE COLUMN'/
     1' BREAKDOWN VARIABLE.  ONLY 1 VARIABLE MAY BE ENTERED AND'/
     1' IT MUST NOT BE ALL OR *'/)
      GO TO 157
160   IF(N1.NE.1) GO TO 157
      IF(ICOL.GT.0) GO TO 162
      WRITE(IDLG,161)
161   FORMAT(' MUST BE VARIABLE NOT ALL OR *'/)
      GO TO 157
162   IF(ICC.NE.2) WRITE(IDLG,166)
166   FORMAT('+WHICH VARIABLE DETERMINES THE ROW? ',$)
      CALL ALPHA (IROW,1,N1,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 162
      IF(IHELP.NE.1) GO TO 168
      WRITE(IDLG,167)
167   FORMAT(' ENTER THE VARIABLE TO BE USED AS THE ROW BREAKDOWN'/
     1' VARIABLE.  ONLY 1 VARIABLE MAY BE ENTERED AND IT MUST BNOT BE'/
     1' ALL OR *'/)
      GO TO 162
168   IF(N1.NE.1) GO TO 162
      IF(IROW.GT.0) GO TO 170
      WRITE(IDLG,169)
169   FORMAT(' MUST BE VARIABLE NOT ALL OR *'/)
      GO TO 162
C
C     CHECK CELL CONFIGURATION
C
170   DO 171 I=1,20
      DO 171 J=1,20
171   LEV(I,J)=0
      DO 172 I=1,NC
      I1=DATA(I,IROW)
      I2=DATA(I,ICOL)
      IF(I1.GT.MAXSIZ) GO TO 172
      IF(I2.GT.MAXSIZ) GO TO 172
      IF(LEV(I1,I2).EQ.0) GO TO 174
      WRITE(IDLG,173) I1,I2
173   FORMAT(' CELL (',I2,',',I2,') HAD TWO ENTRIES'/)
      RETURN
174   LEV(I1,I2)=1
172   CONTINUE
      DO 175 I=MAXSIZ,2,-1
      DO 176 J=1,MAXSIZ
      IF((LEV(I,J).EQ.0).AND.(LEV(J,I).EQ.0)) GO TO 176
      MAX=I
      GO TO 178
176   CONTINUE
175   CONTINUE
      WRITE(IDLG,177)
177   FORMAT(' NO DATA IN CELLS FOR LATIN SQUARE'/)
      RETURN
178   MAXSIZ=MAX
      DO 179 I=1,MAXSIZ
      DO 179 J=1,MAXSIZ
      IF(LEV(I,J).EQ.1) GO TO 179
      WRITE(IDLG,180) I,J
180   FORMAT(' CELL (',I2,',',I2,') CONTAINED NO DATA')
      RETURN
179   CONTINUE
      IF(OPT(2).EQ.1) GO TO 200
C
C     CONSTRUCT LATIN SQUARE
C
      DO 190 I=1,MAXSIZ
      J=I
      DO 190 K=1,MAXSIZ
      LEV(I,J)=K
      J=J+1
      IF(J.GT.MAXSIZ) J=1
190   CONTINUE
      GO TO 219
C
C     LATIN SQUARE INCLUDED IN VARIABLE CALLED TREATMENT
C
200   IF(ICC.NE.2) WRITE(IDLG,201)
201   FORMAT('+WHICH VARIABLE DETERMINES THE TREATMENT? ',$)
      CALL ALPHA(ITRT,1,N1,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 200
      IF(IHELP.NE.1) GO TO 203
      WRITE(IDLG,202)
202   FORMAT(' ENTER THE VARIABLES TO BE USED AS THE ROW BREAKDOWN'/
     1' VARIABLE.  ONLY 1 VARIABLE MAY BE ENTERED AND IT MUST NOT'/
     1' BE ALL OR *'/)
      GO TO 200
203   IF(N1.NE.1) GO TO 200
      IF(ITRT.GT.0) GO TO 205
      WRITE(IDLG,204)
204   FORMAT(' TREATMENT MUST BE A VARIABLE NOT ALL OR *'/)
      GO TO 200
205   DO 206 I=1,NC
      I1=DATA(I,IROW)
      I2=DATA(I,ICOL)
      IF(I1.GT.MAXSIZ) GO TO 206
      IF(I2.GT.MAXSIZ) GO TO 206
      LEV(I1,I2)=DATA(I,ITRT)
      IF((LEV(I1,I2).GE.1).AND.(LEV(I1,I2).LE.MAXSIZ)) GO TO 206
      WRITE(IDLG,207) LEV(I1,I2)
207   FORMAT(' TREATMENT ',I5,' IS AN ILLEGAL TREATMENT (MUST'/
     1' BE BETWEEN 1 AND ',I2,').'/)
      RETURN
206   CONTINUE
C
C
C     CHEDCK VALIDITY OF LATIN SQUARE
C
      DO 210 I=1,MAXSIZ
      DO 211 J=2,MAXSIZ
      DO 212 K=1,J-1
      IF(LEV(I,J).EQ.LEV(I,K)) GO TO 213
      IF(LEV(J,I).NE.LEV(K,I)) GO TO 212
213   WRITE(IDLG,214) I
214   FORMAT(' ILLEGAL LATIN SQUARE IN ROW OR COLUMN ',I2)
      RETURN
212   CONTINUE
211   CONTINUE
210   CONTINUE
C
C     SET UP VARIABLES TO BE RUN
C
219   I3=0
220   I3=I3+1
      IF(I3.GT.N) RETURN
      IVB=IVAR(I3)
      DO 221 I=1,NC
      I1=DATA(I,IROW)
      I2=DATA(I,ICOL)
      IF(I1.GT.MAXSIZ) GO TO 221
      IF(I2.GT.MAXSIZ) GO TO 221
      D(I1,I2)=DATA(I,IVB)
221   CONTINUE
C
C
C     *****************************************************************
C     *****************************************************************
C
C
C     EVERYTIHING SET UP FOR EITHER CASE -- DO ANALYSIS
C
250   DO 251 I=1,MAXSIZ
      ALPH(I)=0
      BETA(I)=0
      GAMMA(I)=0
251   CONTINUE
      XMEAN=0
      DO 252 I=1,MAXSIZ
      DO 252 J=1,MAXSIZ
      XMEAN=XMEAN+D(I,J)
      ALPH(I)=ALPH(I)+D(J,I)
      BETA(I)=BETA(I)+D(I,J)
      GAMMA(LEV(I,J))=GAMMA(LEV(I,J))+D(I,J)
252   CONTINUE
      NTOT=MAXSIZ*MAXSIZ
      XMEAN=XMEAN/NTOT
      DO 253 I=1,MAXSIZ
      ALPH(I)=ALPH(I)/MAXSIZ
      BETA(I)=BETA(I)/MAXSIZ
      GAMMA(I)=GAMMA(I)/MAXSIZ
253   CONTINUE
      IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(J),J=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      IF(OPT(1).EQ.1) GO TO 257
      COMMA=','
      WRITE(IOUT,260)
260   FORMAT('0',10X,'**** LATIN SQUARE ****')
      WRITE(IOUT,254)(NAMES(IVAR(I)),COMMA,I=1,MAXSIZ-1),
     1NAMES(IVAR(MAXSIZ))
254   FORMAT('0ANALYSIS ON VARIABLES: ',8(A5,A1)/24X,8(A5,A1)/
     124X,8(A5,A1))
      IF(OPT(2).EQ.1) WRITE(IOUT,255)
255   FORMAT('0LATIN SQUARE ENTERED BY USER')
      IF(OPT(2).NE.1) WRITE(IOUT,256)
256   FORMAT('0LATIN SQUARE PROVIDED BY PROGRAM')
      LINES=6+MAXSIZ/8
      GO TO 270
257   WRITE(IOUT,258) NAMES(IVB),NAMES(IROW),NAMES(ICOL)
258   FORMAT('0ANALYSIS ON VARIABLE: ',A5/
     1' ROW DETERMINED BY VARIABLE: ',A5/
     1' COLUMN DETERMINED BY VARIABLE: ',A5)
      IF(OPT(2).EQ.1) WRITE(IOUT,259) NAMES(ITRT)
259   FORMAT('0LATIN SQUARE DETERMINED BY VARIABLE: ',A5)
      IF(OPT(2).NE.1) WRITE(IOUT,256)
      LINES=9
270   IF(OPT(3).NE.1) GO TO 280
C
C     LEAST SQUARE ESTIMATES
C
      LOUT=4
      IF(IOUT.EQ.21) LOUT=9
      WRITE(IOUT,271) XMEAN
271   FORMAT('0  LEAST SQUARES ESTIMATES      OVERALL MEAN =',G15.7)
      LINES=LINES+2
      DO 272 I=1,MAXSIZ,LOUT
      IEND=I+LOUT-1
      IF(IEND.GT.MAXSIZ) IEND=MAXSIZ
      IF(IOUT.NE.21) GO TO 273
      LINES=LINES+5
      IF(LINES.LE.LINPP) GO TO 273
      CALL PRNTHD
      LINES=7
273   WRITE(IOUT,274)(K,K=I,IEND)
274   FORMAT('0',2X,9(11X,I2))
      WRITE(IOUT,275)(ALPH(K),K=I,IEND)
275   FORMAT(' ROW',7X,9(G12.4,1X))
      WRITE(IOUT,276)(BETA(K),K=I,IEND)
276   FORMAT(' COLUMN',4X,9(G12.4,1X))
      WRITE(IOUT,277)(GAMMA(K),K=I,IEND)
277   FORMAT(' TREATMENT ',9(G12.4,1X))
272   CONTINUE
C
C     ANOVA TABLE
C
280   SSROW=0
      SSCOL=0
      SSTRT=0
      SSTOT=0
      DO 281 I=1,MAXSIZ
      SSROW=SSROW+(ALPH(I)-XMEAN)**2
      SSCOL=SSCOL+(BETA(I)-XMEAN)**2
      SSTRT=SSTRT+(GAMMA(I)-XMEAN)**2
      DO 281 J=1,MAXSIZ
281   SSTOT=SSTOT+(D(I,J)-XMEAN)**2
      SSROW=SSROW*MAXSIZ
      SSCOL=SSCOL*MAXSIZ
      SSTRT=SSTRT*MAXSIZ
      SSERR=SSTOT-SSROW-SSCOL-SSTRT
      IF(IOUT.NE.21) GO TO 282
      LINES=LINES+11
      IF(LINES.LE.LINPP) GO TO 282
      CALL PRNTHD
      LINES=13
282   WRITE(IOUT,283)
283   FORMAT('0ANOVA TABLE'/'0SOURCE',6X,'DF',2X,'SUM OF SQUARES',6X,
     1'MEAN SQUARE',5X,'F',12X,'PROB'/1X,6('-'),6X,'--',2X,15('-'),1X,
     115('-'),2X,13('-'),2X,5('-'))
      IDFERR=(MAXSIZ-1)*(MAXSIZ-2)
      IDF=MAXSIZ-1
      XMNROW=SSROW/IDF
      XMNCOL=SSCOL/IDF
      XMNTRT=SSTRT/IDF
      XMNERR=SSERR/IDFERR
      FROW=XMNROW/XMNERR
      FCOL=XMNCOL/XMNERR
      FTRT=XMNTRT/XMNERR
      PRBROW=FISHER(IDF,IDFERR,FROW)
      PRBCOL=FISHER(IDF,IDFERR,FCOL)
      PRBTRT=FISHER(IDF,IDFERR,FTRT)
      WRITE(IOUT,290) IDF,SSROW,XMNROW,FROW,PRBROW
290   FORMAT(' ROW',8X,I3,2X,G15.7,1X,G15.7,1X,G13.5,2X,F6.4)
      WRITE(IOUT,291) IDF,SSCOL,XMNCOL,FCOL,PRBCOL
291   FORMAT(' COLUMN',5X,I3,2X,G15.7,1X,G15.7,1X,G13.5,2X,F6.4)
      WRITE(IOUT,292) IDF,SSTRT,XMNTRT,FTRT,PRBTRT
292   FORMAT(' TREATMENT  ',I3,2X,G15.7,1X,G15.7,1X,G13.5,2X,F6.4)
      WRITE(IOUT,293) IDFERR,SSERR,XMNERR
293   FORMAT(' ERROR',6X,I3,2X,G15.7,1X,G15.7)
      WRITE(IOUT,294)
294   FORMAT(1X,31('-'))
      IDF=MAXSIZ**2-1
      WRITE(IOUT,295) IDF,SSTOT
295   FORMAT(' TOTAL',4X,I5,2X,G15.7)
      IF(OPT(1).EQ.1) GO TO 220
      GO TO 130
9999  RETURN
      END
C                                                     *** STAT PACK ***
C     SUBROUTINE FOR FRIEDMAN TWO-WAY ANALYSES OF VARIANCE
C     CALLING SEQUENCE: CALL FRIED(NV,NC,MV,MC,DATA,SUM,RANK,NAMES)
C     WHERE: NV - NUMBER OF VARIABLES USED
C            NC - NUMBER OF OBSERVATIONS USED
C            MV - MAXIMUM NUMBER OF VARIABLES ALLOWED
C            MC - MAXIMUM NUMBER OF OBSERVATIONS ALLOWED
C            DATA - MATRIX CONTAINING DATA
C            SUM - EXTRA VECTOR AT LEAST NV LONG
C            RANK - EXTRA VECTOR AT LEAST NV LONG
C            NAMES - VECTOR CONTAINING VARIABLE NAMES
C
C     ROUTINE SUGGESTED TO BE INCLUDED IN STAT PACK BY LONNIE
C     HANNAFORD (SPECIAL EDUCATION) AND ULDIS SMIDCHENS (EDUCATION).
C     SOURCE IS NON PARAMETRIC STATISTICS BY SIEGEL PAGES 166-172.
C
      SUBROUTINE FRIED(NV,NC,MV,MC,DATA,SUM,RANK,NAMES)
      DIMENSION DATA(MC,MV),SUM(1),RANK(1),IV(20),IVB(20),NAMES(1)
      COMMON /DEV/ ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON /EXTRA/ HEDR(70),NSZ
1     IF(ICC.NE.2) WRITE(IDLG,2)
2     FORMAT(' WHICH VARIABLES? '$)
      CALL ALPHA(IV,20,N,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 1
      IF(IHELP.NE.1) GO TO 4
      WRITE(IDLG,3)
3     FORMAT('0ENTER UP TO 20 VARIABLES FOR THE FRIEDMAN TWO-WAY'/
     1' ANALYSIS OF VARIANCE.  VARIABLE NAMES OR NUMBERS'/
     2' MAY BE USED TO INDICATED THE VARIABLES.  RANGES OF'/
     3' VARIABLES MAY BE ENTERED BY TYPING THE EXTREMES OF THE RANGE'/
     4' SEPARATED BY A MINUS.  THE ASTERIK MAY BE USED IN ONE'/
     5' OR MORE POSITIONS TO INDICATED ALL POSSIBLE COMBINATIONS.')
      GO TO 1
4     IF(N.LT.2) RETURN
      DO 5 I=1,N-1
      IF(IV(I).LE.0) GO TO 5
      DO 6 J=I+1,N
      IF(IV(I).NE.IV(J)) GO TO 6
      WRITE(IDLG,7) NAMES(IV(J))
7     FORMAT(' SAME VARIABLE (',A5,') LISTED TWICE')
      GO TO 1
6     CONTINUE
5     CONTINUE
C
C     OK NOW INSERT FOR * AND ALL.
C
      K=1
      DO 8 I=1,N
      IVB(I)=IV(I)
      IF(IV(I).GT.0) GO TO 8
      IVB(I)=K
      K=K+1
8     CONTINUE
      GO TO 18
C
C     RETURN HERE TO PICK UP NEXT SET OF VARIABLES
C
10    J=N
14    IF(IV(J).GT.0) GO TO 15
      IVB(J)=IVB(J)+1
      IF(IVB(J).LE.NV) GO TO 16
15    J=J-1
      IF(J.GE.1) GO TO 14
      RETURN
16    K=IVB(J)
      IF(J.EQ.N) GO TO 18
      DO 17 I=J+1,N
      IF(IV(I).GT.0) GO TO 17
      K=K+1
      IF(K.GT.NV) GO TO 15
      IVB(I)=K
17    CONTINUE
18    DO 13 I=1,N-1
      DO 13 K=I+1,N
      IF(IVB(I).EQ.IVB(K)) GO TO 14
13    CONTINUE
C
C     BEGIN THE FRIEDMAN ANALYSIS OF VARIANCE
C
      DO 19 I=1,N
19    SUM(I)=0
      DO 20 J=1,NC
      DO 21 I=1,N
21    RANK(I)=DATA(J,IVB(I))
C
C     RANKING ( ONLY 20 MAX, SO SORT RANK METHOD NOT USED )
C
      DO 22 I=1,N
      SAME=1.
      ALESS=0
      DO 23 K=1,N
      IF(RANK(K).GT.RANK(I)) GO TO 23
      IF(RANK(K).LT.RANK(I)) GO TO 24
      SAME=SAME+1
      GO TO 23
24    ALESS=ALESS+1.
23    CONTINUE
22    SUM(I)=SUM(I)+ALESS+SAME/2.
20    CONTINUE
C
C     RANKING COMPLETE NOW CALCULATE THE CHI SQUARE
C
      IF(IOUT.NE.21) WRITE(IOUT,5566) (HEDR(J),J=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,31)
31    FORMAT('0',8X,'**** FRIEDMAN TWO-WAY ANALYSIS OF VARIANCE ****'/
     1'0VARIABLE  SUM OF RANKS'/' ========  ============')
      LINES=7
      TOTSQ=0
      DO 30 I=1,N
      IF(IOUT.NE.21) GO TO 36
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 36
      CALL PRNTHD
      WRITE(IOUT,31)
      LINES=8
36    WRITE(IOUT,32) NAMES(IVB(I)),SUM(I)
32    FORMAT(2X,A5,5X,F10.2)
30    TOTSQ=TOTSQ+SUM(I)**2
      FRIED=(12./(NC*N*(N+1.)))*TOTSQ-3.*NC*(N+1.)
      IDF=N-1
      FD=FRIED/IDF
      PROB=FISHER(IDF,1000,FD)
      IF(IOUT.NE.21) GO TO 37
      LINES=LINES+3
      IF(LINES.LE.LINPP) GO TO 37
      CALL PRNTHD
37    WRITE(IOUT,35) FRIED,IDF,PROB
35    FORMAT('0CHI SQUARE=',F12.3,', WITH ',I2,' DEGREES OF FREEDOM'/
     1' HAVING A PROBABILITY OF ',F5.2)
      GO TO 10
      END
C                                                     *** STAT PACK ***
C     SUBROUTINE FOR SIGN TEST.
C     CALLING SEQUENCE: CALL SIGNT(NV,NC,MV,MC,DATA,NAMES)
C     WHERE: NV - NUMBER OF VARIABLES USED.
C            NC - NUMBER OF OBSERVATIONS USED.
C            MV - MAXIMUM NUMBER OF VARIABLES ALLOWED
C            MC - MAXIMUM NUMBER OF OBSERVATIONS ALLOWED
C            DATA - MATRIX FOR DATA
C            NAMES - VECTOR CONTAINING VARIABLE NAMES.
C
C     ROUTINE SUGGESTED BY LONNIE HANNAFORD (SPECIAL EDUCATION) AND
C     ULDIS SMIDCHENS (TEACHER EDUCATION).  SOURCE IS NON-
C     PARAMETRIC STATISTICS BY SIEGEL PAGES 68-75.  THE
C     BINOMIAL EXPANSION COULD BE USED FOR N>25, HOWEVER IT IS
C     SLOW FOR LARGE N.  WORKS BY ATTEMPTING TO NORMALIZE NUMBER
C     AS IT IS BEING CALCULATED ABOUT THE VALUE 1.
C
      SUBROUTINE SIGNT(NV,NC,MV,MC,DATA,NAMES)
      DIMENSION DATA(MC,MV),NAMES(1)
      COMMON /DEV/ ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON /EXTRA/ HEDR(70),NSZ
C     EQUIVALENCE FOR BINARY EXPANSION USED TO FIND POWER OF 2
      EQUIVALENCE (ISUM,SUM)
      IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(I),I=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,1)
1     FORMAT('0',20X,'**** SIGN TEST ****'/'0',35X,'FREQUENCY OF'/
     119X,'NUMBER OF',9X,'SIGN WHICH'/19X,'PAIRS WITH',6X,
     2'OCCURED LEAST',7X,'Z',10X,'PROB'/' VAR',4X,'VAR',4X,
     3'SIGNED DIFFERENCE',7X,'OFTEN',8X,'(N>25)',6X,'(N<=25)')
      LINES=9
      DO 2 I=1,NV-1
      DO 2 J=I+1,NV
      N=0
      NMIN=0
      DO 3 K=1,NC
      IF(DATA(K,I)-DATA(K,J)) 4,3,5
4     NMIN=NMIN+1
5     N=N+1
3     CONTINUE
      IF(NMIN.GT.(N-NMIN)) NMIN=N-NMIN
      IF(N.GT.25) GO TO 20
C
C     BINOMIAL EXPANSION (N<=25)
C
      XSUM=0
      IF(N.LT.127) XSUM=1./2.**N
      IF(NMIN.LT.1) GO TO 13
      DO 11 L=1,NMIN
      SUM=1.
      IN=N-L+1
      XONE=1.
      NTWOS=N
      DO 12 K=IN,N
      SUM=SUM*K/XONE
      IF(NTWOS.LT.1) GO TO 12
      IF(SUM.LT.2) GO TO 12
      JJ=(ISUM.AND."377777777777)/2**27-129
      NDIV=JJ
      IF(JJ.GT.NTWOS) NDIV=NTWOS
      SUM=SUM/2.**NDIV
      NTWOS=NTWOS-NDIV
12    XONE=XONE+1.
      IF(NTWOS.GT.127) GO TO 11
      IF(NTWOS.GT.0) SUM=SUM/2.**NTWOS
      XSUM=XSUM+SUM
11    CONTINUE
13    IF(IOUT.NE.21) GO TO 15
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 15
      CALL PRNTHD
      WRITE(IOUT,1)
      LINES=10
15    WRITE(IOUT,14) NAMES(I),NAMES(J),N,NMIN,XSUM
14    FORMAT(1X,A5,2X,A5,8X,I5,13X,I5,20X,F7.4)
      GO TO 2
C
C     BINOMIAL DISTRIBUTION GIVE Z VALUE
C
20    A=N
      XMN=A/2.
      XSTD=SQRT(A)/2.
      Z=N-XMN
      IF(N.LT.XMN) Z=Z+.5
      Z=Z/XSTD
      IF(IOUT.NE.21) GO TO 22
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 22
      CALL PRNTHD
      WRITE(IOUT,1)
      LINES=10
22    WRITE(IOUT,21) NAMES(I),NAMES(J),N,NMIN,Z
21    FORMAT(1X,A5,2X,A5,8X,I5,13X,I5,7X,G12.3)
2     CONTINUE
      RETURN
      END