Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/stp/stp8.for
There is 1 other file named stp8.for in the archive. Click here to see a list.
C                                               *** STAT PACK ***
C     SUBROUTINE FOR MAINTAINING DATA AREA
C     CALLING SEQUENCE: CALL MANIP(NV,NC,MV,MC,DATA,STD,VMN,COR,NAMES,IV)
C     WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (CASES)
C           MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN THE MAIN
C           MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN THE MAIN
C           DATA - IS THE DATA MATRIX, DIMENSIONED FOR MAXIMUM
C           STD - IS A VECTOR CONTAINING STANDARD DEVIATIONS
C           VMN - IS A VECTOR CONTAINING VARIABLE MEANS
C           COR - IS A MATRIX CONTAINING CORRELATIONS.
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C             IV - VECTOR AT LEAST NC LONG
C
C     SUBROUTINE ALLOWS USER TO LOOK AT OR MODIFY INDIVIDUAL
C     PIECES OF DATA HELD IN THE MACHINE AT THAT TIME.  ROUTINES
C     USED IN ADDITION ARE: MNNUM,MNTYPE,MNADD,MNRPLC,MNDELT.  THIS
C     PORTION IS THE BRAINS OF THE OUTFIT USEING THE OTHER
C     ROUTINES EITHER FOR NUMERICAL RECOGNITION OR ACTUAL WORK
C     THE FINAL PORTION OF THE ROUTINE CALCULATES MEANS, STANDARD
C     DEVIATIONS, AND CORRELATION MATRIX.
C
      SUBROUTINE MANIP(NV,NC,MV,MC,DATA,STD,VMN,COR,NAMES,IV)
      COMMON/DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON/MANP/IVH,IVL,IOH,IOL,ISN,SN,IRSN,RSN,W
C
C     ISN IS A QUE FOR SEARCHING FOR A SPECIAL NUMBER
C     1 IS GREATER THAN
C     2 IS LESS THAN
C     3 IS EQUAL
C     SN HERE REPRESENTS THE VALUE TO BE COMPARED AGAINST.
C
C     IRSN IS A QUE FOR REPLACING WITH A SPECIAL NUMBER
C     1-IS CONSTANT
C     2-MEAN OF VARIABLE
C     3-MEAN OF VARIABLE LESS THE VALUE SPECIFIED IN RSN.
C
C     IVL AND IVH REPRESENT THE RANGE OF VARIABLES TO BE LOOKED AT
C     IOL AND IOH REPRESENT THE RANGE OF OBSERVATIONS TO BE LOOKED AT
C
C
      DIMENSION DATA(MC,MV),STG(72),STD(1),VMN(1),COR(MV,MV)
      DIMENSION NAMES(1),IV(1)
1     W=0
      ISN=0
      IRSN=0
      IVH=NV
      IVL=1
      IOH=NC
      IOL=1
      IF(ICC.NE.2) WRITE(IDLG,2)
2     FORMAT('0?? ',$)
      READ(ICC,3,END=70)STG
3     FORMAT(72A1)
      IF(STG(1).EQ.'!') GO TO 70
      IF((STG(1).NE.'E').OR.(STG(2).NE.'X').OR.(STG(3).NE.'P').OR.
     1(STG(4).NE.'L').OR.(STG(5).NE.' ')) GO TO 7
      WRITE(IDLG,4)
      WRITE(IDLG,5)
      WRITE(IDLG,6)
      GO TO 1
4     FORMAT('0  MANIP IS A SPECIAL FUNCTION OF STAT-PACK WHICH',
     1' ALLOWS THE USER'/'   TO EDIT DATA EXISTING IN CORE.'/
     2'   AS AN ADDED FEATURE IT HAS SOME AUTOMATIC FUNCTIONS WHICH'/
     3'   ARE MEANT TO HELP IN CASES OF MISSING DATA. THERE ARE'/
     4'   4 MAIN INSTRUCTIONS (MUST BE PLACED IN THE FIRST COLUMN).'/
     5'  D - DELETE'/
     6'  R - REPLACE'/
     7'  T - TYPE'/
     8'  A - ADD'/
     9'   THESE INSTRUCTIONS ARE USED TO REFERENCE THE LARGEST'/
     1'   POSSIBLE RANGE OF VALUES. A LIMIT TO THE PORTION OF DATA'/
     2'   LOOKED AT CAN, HOWEVER, BE IMPOSED WITH THE FOLLOWING'/
     3'   INSTRUCTIONS: (# INDICATES A NUMERIC VALUE WOULD BE INSERTED'
     3').'/
     4'  V# - SPECIFY VARIABLE NUMBER (#)'/
     5'  O# - SPECIFY OBSERVATION NUMBER (#)'/
     6'   INDIVIDUAL VALUES CAN ALSO BE REPLACED BY RANGES OF NUMBERS.'/
     7'   FOR EXAMPLE:'/
     8' TV12-15'/
     9'   WOULD TYPE ALL DATA FOR VARIABLES 12 THROUGH 15.')
5     FORMAT(' RO19-35'/
     1'   WOULD REPLACE OBSERVATIONS 19 THROUGH 35 WITH DATA TAKEN'/
     2'   FROM TERMINAL.  BOTH THE T AND R INSTRUCTIONS CAN HAVE TWO'/
     3'   QUALIFIERS.  FOR EXAMPLE:'/
     4' TV1309'/
     5'   WOULD TYPE VARIABLE 13 OBSERVATION 9 (ONE VALUE).'/
     6'   NEITHER THE D COMMAND NOR THE A COMMAND WILL ALLOW THE USE'/
     7'   OF BOTH THE V AND O IDENTIFIERS.  FOR EXAMPLE:'/
     8' AV12'/
     9'   WOULD ACCEPT DATA FROM TTY FOR A NEW VARIABLE 12'/
     1' DO6-9'/
     2'   WOULD DELETE OBSERVATIONS 6 THROUGH 9 FOR ALL VARIABLES'/
     3'   IN USING THE R OR A FUNCTIONS 3 ADDITIONAL IDENTIFIERS'/
     4'   MAY BE USED:'/
     5'  C# - SPECIFY A CONSTANT (AS OPOSED TO READING FROM TERMINAL)'/
     6'  M  - SPECIFY THE MEAN OF THE VARIABLE'/
     7'  L# - SPECIFY THE MEAN OF THE VARIABLE AS CALCULATED'/
     8'       LEAVING VALUE # OUT.')
6     FORMAT('    FOR EXAMPLE:'/
     1' RV13O9M'/
     2'   WOULD REPLACE VARIABLE 13 OBSERVATION 9 WITH THE MEAN OF'/
     3'   VARIABLE 13.'/
     3'  IN USEING V INSTRUCTIONS, VARIABLE NAMES MAY BE INCLUDED'/
     3'  IF PLACED IN PARANTHESIS'/
     4' TV(SEX)W'/
     4'   IN USING THE R, T, AND A INSTRUCTIONS, HEADERS WILL BE'/
     5'   PRINTED.  IF YOU DO NOT WISH THESE, W WILL BYPASS THEM.'/
     6'   AT ANY POINT WHEN THE MACHINE IS WAITING FOR A VARIABLE,'/
     7'   A CONTROL Z <^Z> CAN BE TYPED.  THIS WILL ABORT THE'/
     8'   REMAINING PORTION OF PRESENT INSTRUCTION AND GO IMMEDIATLY'/
     9'   TO THE NEXT INSTRUCTION. A ?? INDICATES THE PROGRAM IS'/
     1'   WAITING FOR AN INSTRUCTION. A ? INDICATES IT IS WAITING'/
     2'   FOR A VALUE.'/
     3'   FOR A MORE ADVANCED SET OF INSTRUCTIONS TYPE "EXPL(ADV)".')
7     IF((STG(1).NE.'E').OR.(STG(2).NE.'X').OR.(STG(3).NE.'P').OR.
     1(STG(4).NE.'L').OR.(STG(5).NE.'(').OR.(STG(6).NE.'A')) GO TO 9
      WRITE(IDLG,8)
8     FORMAT('0  THE ADVANCED SECTION OF MANIP ALLOWS USERS TO SEARCH',
     1' AREAS FOR'/
     2'   PARTICULAR VALUES.  USED IN CONJUNCTION WITH THE SEARCH',
     3' ARE THE'/'   INSTRUCTIONS:'/
     4'  G# - GREATER THAN VALUE (#)'/
     5'  L# - LESS THAN VALUE (#)'/
     6'  E# - EQUAL THE VALUE (#)'/
     7'   THE SEARCH COMMAND STRING IS AS FOLLOWS:'/
     8'  S@ - WHERE @ IS ONE OF THE 3 INSTRUCTIONS ABOVE'/
     9'0RV12SE9'/
     1'   WOULD BE REPLACE ANY OBSERVATION OF VARIABLE 12 WHERE'/
     2'   THE OBSERVATION IS EQUAL 9 WITH A VALUE ACCEPTED FROM TTY'/
     3' RSE99.9L99.9W'/
     4'   REPLACE ANY OBSERVATION EQUAL TO 99.9 WITH THE MEAN OF'/
     5'   VARIABLE IN WHICH IT OCCURRS NOT TAKING THE VALUES OF 99.9'/
     6'   INTO ACCOUNT.  HERE 99.9 CAN BE INTERPRETED TO BE A '/
     7'   MISSING DATA SYMBOL')
      GO TO 1
9     IF((STG(1).NE.'H').OR.(STG(2).NE.'E').OR.(STG(3).NE.'L').OR.
     1(STG(4).NE.'P')) GO TO 11
      WRITE(IDLG,10)
10    FORMAT('0INSTRUCTION AVAILABLE TO MANIP'/
     1' D  - DELETE'/' R  - REPLACE'/' T  - TYPE'/' A  - ADD'/
     2' E  - EXIT'/' W  - WITHOUT HEADERS'/' M  - MEAN OF VARIABLE'/
     3' L# - MEAN OF VARIABLE LESS ALL OCCURANCES OF VALUE #'/
     4' C# - CONSTANT VALUE #'/' S@# - SEARCH FOR RELATION @ ON VALUE #'
     5/'          WHERE @ CAN BE'/'          G - GREATER THAN'/
     6'          L - LESS THAN'/'          E - EQUAL TO '/
     7'0V# - VARIABLE NUMBER #'/' O# - OBSERVATION NUMBER #'/
     8'0**FOR FURTHER EXPLANATION TYPE EXPL')
      GO TO 1
11    IF((STG(1).EQ.' ').AND.(STG(2).EQ.' ').AND.(STG(3).EQ.' '))
     1GO TO 70
      IF(STG(1).EQ.'E') GO TO 70
      IF(STG(1).EQ.' ') GO TO 70
      IF (STG(1).NE.'A') GO TO 12
      IVH=MV
      IOH=MC
      GO TO 14
12    IF((STG(1).EQ.'T').OR.(STG(1).EQ.'R').OR.(STG(1).EQ.'D'))GO TO 14
      WRITE(IDLG,13) STG(1)
13    FORMAT('0INSTRUCTION "',A1,'" DOES NOT EXIST')
      GO TO 1
14    I=1
15    I=I+1
      IF(I.GT.70) GO TO 60
      IF(STG(I).EQ.' ')GO TO 60
C
C     HEADER CONTROL
      IF(STG(I).NE.'W')GO TO 16
      W=1
      GO TO 15
C
C     CONSTANT NUMBER
16    IF(STG(I).NE.'C')GO TO 17
      CALL MNNUM(I,VLUE,STG)
      IRSN=3
      RSN=VLUE
      GO TO 15
C
C      MEAN
17    IF(STG(I).NE.'M') GO TO 18
      IF(STG(1).NE.'R')GO TO 80
      IRSN=1
      GO TO 15
C
C     MEAN LESS VALUE
18    IF(STG(I).NE.'L') GO TO 19
      IF(STG(1).NE.'R') GO TO 80
      CALL MNNUM(I,VLUE,STG)
      IRSN=2
      RSN=VLUE
      GO TO 15
C
C     SEARCH
19    IF(STG(I).NE.'S') GO TO 22
      IF(STG(1).EQ.'A') GO TO 82
      I=I+1
      ISN=0
      IF(STG(I).EQ.'>') ISN=1
      IF(STG(I).EQ.'<') ISN=2
      IF(STG(I).EQ.'=') ISN=3
      IF(STG(I).EQ.'G') ISN=1
      IF(STG(I).EQ.'L') ISN=2
      IF(STG(I).EQ.'E') ISN=3
      IF(ISN.NE.0) GO TO 21
      WRITE(IDLG,20)
20    FORMAT('0THE INSTRUCTION FOLLOWING AN "S" MUST BE G,L,OR E')
      GO TO 1
21    CALL MNNUM(I,VLUE,STG)
      SN=VLUE
      GO TO 15
C
C     VARIABLE SPECIFIED
22    IF(STG(I).NE.'V') GO TO 40
      IF((STG(1).EQ.'T').OR.(STG(1).EQ.'R'))GO TO 32
      IF((IOL.EQ.1).AND.(IOH.EQ.MC).AND.(STG(1).EQ.'A')) IOH=NC
      IF((IOL.EQ.1).AND.(IOH.EQ.NC)) GO TO 32
      WRITE(IDLG,23) STG(1)
23    FORMAT('0ON A "',A1,'" INSTRUCTION BOTH V AND O CANNOT BE USED')
      GO TO 1
32    IF(STG(I+1).NE.'(') GO TO 24
      CALL MNNAM(I,VLUE,STG,IERR,NAMES,NV)
      IF(IERR.EQ.1) GO TO 1
      GO TO 33
24    CALL MNNUM(I,VLUE,STG)
33    K1=VLUE
      IF((K1.GE.1).AND.(K1.LE.NV).AND.(STG(1).NE.'A')) GO TO 26
      IF((STG(1).EQ.'A').AND.(K1.GT.NV).AND.(K1.LE.MV)) GO TO 26
      WRITE(IDLG,25)
25    FORMAT('0VARIABLE IN V STATEMENT NOT IN RANGE')
      GO TO 1
26    IF(STG(I+1).EQ.'-') GO TO 27
      IF((STG(1).EQ.'A').AND.(K1.NE.NV+1)) K1=NV+1
      IVL=K1
      IVH=K1
      GO TO 15
27    I=I+1
      IF(STG(I+1).NE.'(') GO TO 34
      CALL MNNAM(I,VLUE,STG,IERR,NAMES,NV)
      IF(IERR.EQ.1) GO TO 1
      GO TO 35
34    CALL MNNUM(I,VLUE,STG)
35    K2=VLUE
      IF((K2.GE.1).AND.(K2.LE.NV).AND.(STG(1).NE.'A')) GO TO 28
      IF((STG(1).EQ.'A').AND.(K2.GT.NV).AND.(K2.LE.MV)) GO TO 28
      WRITE(IDLG,25)
      GO TO 1
28    IF(K1.LT.K2)GO TO 30
      WRITE(IDLG,29)
29    FORMAT('/RANGE ON V INCORRECTLY SPECIFIED - SMALLER FIRST')
      GO TO 1
30    IRG=K2-K1
      IF((STG(1).NE.'A').OR.(K1.EQ.NV+1)) GO TO 31
      K1=NV+1
      K2=K1+IRG
31    IVL=K1
      IVH=K2
      GO TO 15
C
C     OBSERVATION SPECIFIED
40    IF(STG(I).NE.'O') GO TO 50
      IF((STG(1).EQ.'T').OR.(STG(1).EQ.'R')) GO TO 42
      IF((IVL.EQ.1).AND.(IVH.EQ.MV).AND.(STG(1).EQ.'A')) IVH=NV
      IF((IVL.EQ.1).AND.(IVH.EQ.NV)) GO TO 42
      WRITE(IDLG,41) STG(1)
41    FORMAT('0ON A "',A1,'" INSTRUCTION BOTH V AND O CANNOT BE USED')
      GO TO 1
42    CALL MNNUM(I,VLUE,STG)
      K1=VLUE
      IF((K1.GE.1).AND.(K1.LE.NC).AND.(STG(1).NE.'A')) GO TO 44
      IF((STG(1).EQ.'A').AND.(K1.GT.NC).AND.(K1.LE.MC)) GO TO 44
      WRITE(IDLG,43)
43    FORMAT('0OBSERVATION IN A STATEMENT NOT IN RANGE')
      GO TO 1
44    IF(STG(I+1).EQ.'-') GO TO 45
      IF((STG(1).EQ.'A').AND.(K1.NE.NC+1)) K1=NC+1
      IOL=K1
      IOH=K1
      GO TO 15
45    I=I+1
      CALL MNNUM(I,VLUE,STG)
      K2=VLUE
      IF((K2.GE.1).AND.(K2.LE.NC).AND.(STG(1).NE.'A')) GO TO 46
      IF((STG(1).EQ.'A').AND.(K2.GT.NC).AND.(K2.LE.MC)) GO TO 48
      WRITE(IDLG,43)
      GO TO 1
46    IF(K1.LT.K2) GO TO 48
      WRITE(IDLG,47)
47    FORMAT('0RANGE ON O INCORRECTLY SPECIFIED - SMALLER FIRST')
      GO TO 1
48    IRG=K2-K1
      IF((STG(1).NE.'A').OR.(K1.EQ.NC+1)) GO TO 49
      K1=NC+1
      K2=K1+IRG
49    IOL=K1
      IOH=K2
      GO TO 15
50    WRITE(IDLG,13) STG(I)
      GO TO 1
60    IF(STG(1).NE.'A') GO TO 61
      CALL MNADD(NV,NC,MV,MC,DATA,NAMES)
      GO TO 1
61    IF(STG(1).NE.'T') GO TO 62
      CALL MNTYPE(NV,NC,MV,MC,DATA,NAMES)
      GO TO 1
62    IF(STG(1).NE.'R') GO TO 63
      CALL MNRPLC(NV,NC,MV,MC,DATA,NAMES)
      GO TO 1
63    CALL MNDELT(NV,NC,MV,MC,DATA,NAMES,IV)
      GO TO 1
70    DO 90 I=1,NV
      VMN(I)=0
      STD(I)=0
      DO 90 J=1,NV
90    COR(J,I)=0
      DO 71 I=1,NC
      DO 71 J=1,NV
      VMN(J)=VMN(J)+DATA(I,J)
      DO 71 K=1,J
71    COR(K,J)=COR(K,J)+DATA(I,J)*DATA(I,K)
      DO 72 I=1,NV
      DO 72 J=I,NV
72    COR(J,I)=NC*COR(I,J)-VMN(I)*VMN(J)
      DO 73 I=1,NV
      STD(I)=SQRT(COR(I,I)/(NC*(NC-1)))
73    VMN(I)=VMN(I)/NC
      DO 74 I=1,NV
      DO 74 J=I,NV
      IF(I.EQ.J) GO TO 74
      IF(COR(I,I)*COR(J,J).EQ.0) GO TO 75
      COR(I,J)=COR(J,I)/SQRT(COR(I,I)*COR(J,J))
      COR(J,I)=COR(I,J)
      GO TO 74
75    COR(I,J)=0
      COR(J,I)=0
74    CONTINUE
      DO 76 I=1,NV
76    COR(I,I)=1.0
      RETURN
80    WRITE(IDLG,81)
81    FORMAT('OTHE M AND L INSTRUCTIONS ARE ONLY GOOD WHEN USED WITH R'
     1)
      GO TO 1
82    WRITE(IDLG,83)
83    FORMAT('0THE SEACH MAY NOT BE USED WITH THE A')
      GO TO 1
      END
C                                               *** STAT PACK ***
C     SUBROUTINE IS PART OF "MANIP" INSTRUCTION.
C     CALLING SEQUENCE: CALL MNNUM(I,VLUE,STG)
C     WHERE I - IS THE STARTING POSITION OF A NUMERIC
C                 VALUE.
C           VLUE - QUANTITY TO BE RETURNED NUMERICALLY EQUAL TO THE
C                   CHARACTER REPRESENTATION.
C           STG - IS A VECTOR CONTAINING THE STRING OF SINGLE
C                  CHARACTER ALPHANUMERICS.
C
C     ROUTINE TAKES THE ALPHANUMERIC CHARACTERS DEFINED IN THE
C     STRING BY I, AND TRANSLATES THEM TO A NUMERIC VALUE.
C
      SUBROUTINE MNNUM(I,VLUE,STG)
      DIMENSION PLACE(3),STG(1)
      DO 1 L=1,3
1     PLACE(L)='     '
      L=I
2     IF(STG(I+1).EQ.'.') I=I+1
      IF((STG(I+1).LT.'0').OR.(STG(I+1).GT.'9')) GO TO 3
      I=I+1
      GO TO 2
3     M=I-L
      IF(M.LE.0) GO TO 6
      ENCODE (M,4,PLACE) (STG(K),K=L+1,I)
      DECODE(15,5,PLACE) VLUE
4     FORMAT(15A1)
5     FORMAT(F)
      RETURN
6     VLUE=0
      RETURN
      END
C                                               *** STAT PACK ***
C     SUBROTINE IS PART OF "MANIP" INSTRUCTION
C     CALLING SEQUENCE: CALL MNNAM(I,VLUE,STG,IERR,NAMES,NV)
C     WHERE I - IS THE STARTING POSITION OF THE VARIABLE NAME
C            VLUE - QUANTITY TO BE RETURNED NUMERICALLY EQUAL TO THE
C                      VARIABLE NUMBER.
C            STG - IS A VECTOR CONTAINING THE STRING OF SINGLE CHARACTER
C                        ALPHANUMERICS
C            IERR - RETURNED 0- NO ERROR , 1- ERROR
C            NAMES -VECTOR CONTAINING VARIABLE NAMES
C            NV - NUMBER OF VARIABLES ACTUALLY USED
C
C     ROUTINE TAKES ALPHA CHARACTERS AND PUTS THEM TOGETHER CHECKS
C     AGAINST THE NAME LIST AND DETERMINES IF THE VARIABLE EXISTS.
C
      SUBROUTINE MNNAM(I,VLUE,STG,IERR,NAMES,NV)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      DIMENSION STG(1),NAMES(1),B(5)
      IERR=0
      DO 1 J=1,5
1     B(J)=' '
      J=1
      I=I+2
2     IF(I.GT.80) GO TO 4
      IF(STG(I).EQ.')') GO TO 6
      IF(J.GT.5) GO TO 3
      B(J)=STG(I)
      J=J+1
3     I=I+1
      GO TO 2
4     WRITE(IDLG,5)
5     FORMAT(' VARIABLE NAME NOT ENCLOSED IN PARANTHESIS')
10    IERR=1
      RETURN
6     ENCODE(5,7,NAME) B
7     FORMAT(5A1)
      DO 8 J=1,NV
      IF(NAMES(J).EQ.NAME) GO TO 11
8     CONTINUE
      WRITE(IDLG,9)NAME
9     FORMAT(' VARIABLE NAME "',A5,'" DOES NOT EXIST')
      GO TO 10
11    VLUE=J
      RETURN
      END
C                                               *** STAT PACK ***
C     PART OF THE "MANIP" ROUTINES, HERE USED TO TYPE VALUES
C     OUT ON TERMINAL.
C     CALLING SEQUENCE: CALL MNTYPE(NV,NC,MV,MC,DATA,NAMES)
C     WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (CASES)
C           MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN THE MAIN
C           MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN THE MAIN
C           DATA - IS THE DATA MATRIX, DIMENSIONED FOR MAXIMUM
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C
C     ROUTINE USED TO TYPE SPECIFIED VARIABLES OUT FROM CORE.
C
      SUBROUTINE MNTYPE(NV,NC,MV,MC,DATA,NAMES)
      COMMON/DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON/MANP/IVH,IVL,IOH,IOL,ISN,SN,IRSN,RSN,W
      DIMENSION DATA(MC,MV),NAMES(1)
      IF(W.EQ.0) WRITE(IDLG,1)
1     FORMAT('0 VAR.  OBS  VALUE')
      DO 2 I=IVL,IVH
      DO 2 J=IOL,IOH
      IF(ISN.EQ.0) GO TO 3
      IF((ISN.EQ.1).AND.(DATA(J,I).GT.SN)) GO TO 3
      IF((ISN.EQ.2).AND.(DATA(J,I).LT.SN)) GO TO 3
      IF((ISN.EQ.3).AND.(DATA(J,I).EQ.SN)) GO TO 3
      GO TO 2
3     IF(W.EQ.0) WRITE(IDLG,4) NAMES(I),J,DATA(J,I)
      IF(W.NE.0) WRITE(IDLG,5) DATA(J,I)
4     FORMAT(1X,A5,1X,I4,2X,G9.3)
5     FORMAT(1X,G9.3)
2     CONTINUE
      RETURN
      END
C                                               *** STAT PACK ***
C     PART OF "MANIP" ROUTINES, HERE USED TO ADD VARIABLES OR OBSERVATIONS
C     CALLING SEQUENCE: CALL MNADD(NV,NC,MV,MC,DATA,NAMES)
C     WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (CASES)
C           MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN THE MAIN
C           MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN THE MAIN
C           DATA - IS THE DATA MATRIX, DIMENSIONED FOR MAXIMUM
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C
C     ROUTINE USED TO PUT ADDITIONAL VARIABLES OR OBSERVATIONS INT0 CORE
C
      SUBROUTINE MNADD(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/MANP/IVH,IVL,IOH,IOL,ISN,SN,IRSN,RSN,W
      IF(W.EQ.0) WRITE(IDLG,1)
1     FORMAT('0 VAR.  OBS  NEW VALUE'/)
      DO 2 I=IVL,IVH
      ENCODE(5,9,NAMES(I))I
9     FORMAT(I3,2X)
      DO 2 J=IOL,IOH
      IF((I.LE.NV).AND.(J.LE.NC)) GO TO 2
      IF(IRSN.EQ.0) GO TO 4
      IF(W.EQ.0) WRITE(IDLG,3) NAMES(I),J,RSN
3     FORMAT(1X,A5,1X,I4,' ?',G9.3)
      DATA(J,I)=RSN
      GO TO 2
4     IF(W.EQ.0) WRITE(IDLG,5)NAMES(I),J
5     FORMAT('+',A5,1X,I4,' ?',$)
      IF(W.NE.0) WRITE(IDLG,6)
6     FORMAT(' ? ',$)
      READ(ICC,7,END=8)DATA(J,I)
7     FORMAT(F)
2     CONTINUE
      NV=IVH
      NC=IOH
8     RETURN
      END
C                                               *** STAT PACK ***
C     PART OF "MANIP" ROUTINES, HERE USED TO REPLACE ACTUAL VALUES
C     AS ARE FOUND IN CORE.
C     CALLING SEQUENCE: CALL MNRPLC(NV,NC,MV,MC,DATA,NAMES)
C     WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (CASES)
C           MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN THE MAIN
C           MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN THE MAIN
C           DATA - IS THE DATA MATRIX, DIMENSIONED FOR MAXIMUM
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C
C    SUBROUTINE IS USED TO CHANGE SPECIFIED VALUES AS REFERENCED BY
C    VARIABLE NUMBER, OBSERVATION NUMBER.
C
      SUBROUTINE MNRPLC(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 /MANP/IVH,IVL,IOH,IOL,ISN,SN,IRSN,RSN,W
      IF(W.EQ.0) WRITE(IDLG,1)
1     FORMAT('0 VAR.  OBS  VALUE      NEW VALUE'/)
      IF(IRSN.EQ.3) OKRSN=RSN
      DO 22 I=IVL,IVH
      IF(IRSN.NE.1)GO TO 10
      SUM=0
      DO 11 J=1,NC
11    SUM=SUM+DATA(J,I)
      OKRSN=SUM/NC
      GO TO 12
10    IF(IRSN.NE.2) GO TO 12
      SUM=0
      SUMN=0
      DO 13 J=1,NC
      IF(DATA(J,I).EQ.RSN) GO TO 13
      SUMN=SUMN+1
      SUM=SUM+DATA(J,I)
13    CONTINUE
      IF(SUMN.EQ.0) WRITE(IDLG,14)NAMES(I),RSN
      IF(SUMN.EQ.0) GO TO 22
14    FORMAT('0ALL OCCURANCES IN VARIABLE: ',A5,' ARE ',G,
     1' -- VARIABLE SKIPPED')
      OKRSN=SUM/SUMN
12    DO 2 J=IOL,IOH
      IF(ISN.EQ.0) GO TO 3
      IF((ISN.EQ.1).AND.(DATA(J,I).GT.SN)) GO TO 3
      IF((ISN.EQ.2).AND.(DATA(J,I).LT.SN)) GO TO 3
      IF((ISN.EQ.3).AND.(DATA(J,I).EQ.SN)) GO TO 3
      GO TO 2
3     IF(IRSN.EQ.0) GO TO 5
      IF(W.EQ.0) WRITE(IDLG,4) NAMES(I),J,DATA(J,I),OKRSN
4     FORMAT(1X,A5,1X,I4,2X,G9.3,2X,G9.3)
      DATA(J,I)=OKRSN
      GO TO 2
5     IF(W.EQ.0) WRITE(IDLG,6) NAMES(I),J,DATA(J,I)
6     FORMAT('+',A5,1X,I4,2X,G9.3,' ?',$)
      IF(W.NE.0) WRITE(IDLG,7)
7     FORMAT('+? ',$)
      READ(ICC,8,END=9)DATA(J,I)
8     FORMAT(F)
2     CONTINUE
22    CONTINUE
9     RETURN
      END
C                                               *** STAT PACK ***
C     PART OF "MANIP" ROUTINES, HERE USED TO DELETE OBSERVATIONS
C     OR VARIABLES.
C     CALLING SEQUENCE: CALL MNDELT(NV,NC,MV,MC,DATA,NAMES,IV)
C     WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (CASES)
C           MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN THE MAIN
C           MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN THE MAIN
C           DATA - IS THE DATA MATRIX, DIMENSIONED FOR MAXIMUM
C           IV - IS A VECTOR AT LEAST NC LONG
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C
C     SUBROUTINE FOR DELETING VARIABLES OF OBSERVATIONS.  IN CASE
C     VARIABLE IS DELETED ALL VARIABLES ARE MOVED DOWN TO MAINTAIN
C     A CLOSED SYSTEM.
C
      SUBROUTINE MNDELT(NV,NC,MV,MC,DATA,NAMES,IV)
      DIMENSION DATA(MC,MV),NAMES(1),IV(1)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON /MANP/IVH,IVL,IOH,IOL,ISN,SN,IRSN,RSN,W
      IF(ISN.NE.0) GO TO11
      IF((IVL.EQ.1).AND.(IVH.EQ.NV)) GO TO 1
      IF((IOL.EQ.1).AND.(IOH.EQ.NC)) GO TO 5
      WRITE(IDLG,32)
32    FORMAT(' BOTH OBS AND VAR USED NOTHING DONE')
      RETURN
1     IF(IOH.EQ.NC) GO TO 4
      IUL=IOL+(NC-IOH)-1
      INC=IOH-IOL+1
      DO 2 I=IOL,IUL
      DO 3 J=1,NV
3     DATA(I,J)=DATA(I+INC,J)
2     CONTINUE
4     NC=NC-(IOH-IOL+1)
      IF(NC.EQ.0) NV=0
      GO TO 10
5     IUL=IVL+(NV-IVH)-1
      INC=IVH-IVL+1
      DO 6 I=IVL,IUL
      NAMES(I)=NAMES(I+INC)
      DO 7 J=1,NC
7     DATA(J,I)=DATA(J,I+INC)
6     CONTINUE
      NV=NV-(IVH-IVL+1)
      IF(NV.EQ.0) NC=0
10     RETURN
C
C     SEARCH AND DELETE (OBSERVATIONS ONLY CAN BE DELETED)
11    DO 12 I=1,NC
12    IV(I)=1
      DO 13 I=IOL,IOH
      DO 14 J=IVL,IVH
      GO TO (21,22,23) ISN
21    IF(DATA(I,J).GT.SN) GO TO 15
      GO TO 14
22    IF(DATA(I,J).LT.SN) GO TO 15
      GO TO 14
23    IF(DATA(I,J).EQ.SN) GO TO 15
      GO TO 14
15    IV(I)=0
      GO TO 13
14    CONTINUE
13    CONTINUE
      J=0
      DO 30 I=1,NC
      IF(IV(I).EQ.0) GO TO 30
      J=J+1
      IF(J.EQ.I) GO TO 30
      DO 31 K=1,NV
31    DATA(J,K)=DATA(I,K)
30    CONTINUE
      NC=J
      IF(NC.EQ.0) NV=0
      RETURN
      END
C                                               *** STAT PACK ***
C     ROUTINE TO CREATE A HEADER FOR OUTPUT WITH EACH REPORT.
C     CALLING SEQUENCE: CALL STHEDR
C
C
      SUBROUTINE STHEDR
      COMMON/DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON/EXTRA/HEDR(70),NSZ
      IF(ICC.NE.2) WRITE(IDLG,1)
1     FORMAT('0TYPE IN THE LINE OF IDENTIFICATION'/)
      READ(ICC,2)HEDR
2     FORMAT(70A1)
      DO 3 I=70,1,-1
      IF(HEDR(I).EQ.' ') GO TO 3
      NSZ=I
      RETURN
3     CONTINUE
      NSZ=0
      RETURN
      END
C                                               *** STAT PACK ***
C     SUBROUTINE FOR T TESTS
C     CALLING SEQUENCE: CALL TTEST(NV,NC,MV,MC,DATA,VMN,STD,IT,S,NAMES)
C     WHERE NV - IS THE NUMBER OF COLUMNS ACTUALLY FILLED (VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (CASES)
C           MV - IS THE MAXIMUM NUMBER OF COLUMNS, AS SPECIFIED IN THE MAIN
C           MC - IS THE MAXIMUM NUMBER OF ROWS, AS SPECIFIED IN THE MAIN
C           DATA - IS THE DATA MATRIX, DIMENSIONED FOR MAXIMUM
C           VMN - IS AVECTOR CONTAINING VARIABLE MEANS
C           STD - IS A VECTOR CONTAINING VARIABLE STANDARD DEVIATIONS.
C           IT - IS AN EXTRA VECTOR, DIMENSIONED AT LEAST NV.
C           S - IS AN EXTRA VECTOR, DIMENSIONED AT LEAST NV.
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C
C     SUBROUTINE FOR T-TESTS ALLOWS BOTH THE OPTION OF T TESTS BETWEEN
C     VARIABLES AND T TESTS BASED ON BREAKDOWNS OF VARIABLES.
C
      SUBROUTINE TTEST(NV,NC,MV,MC,DATA,VMN,STD,IT,S,NAMES)
      DIMENSION VMN(1),STD(1),IT(1),S(1),A(5),R(100,2)
      DIMENSION DATA(MC,MV),NAMES(1),T(11),PROB(11)
      DIMENSION ITS(20),IL(16),IU(16)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON/EXTRA/HEDR(70),NSZ
      ISQ=5
      IF(IOUT.EQ.21) ISQ=11
15    IF(ICC.NE.2) WRITE(IDLG,7)
7     FORMAT('0ENTER OPTIONS SEPARATED BY COMMAS'/)
      PBO=0
      ALL=0
      DISCR=0
      BREAK=0
      HEADR=0
      RANGE=0
      READ(ICC,8) A
8     FORMAT(5(A5,1X))
      IF(A(1).EQ.'!') RETURN
      DO 9 I=1,5
      IF(A(I).NE.'HELP') GO TO 11
      WRITE(IDLG,10)
10    FORMAT('0T-TEST ASSUMES THE T-VALUES TO BE CALCULATED BETWEEN'/
     1' VARIABLES.  IT IS HOWEVER POSSIBLE TO CREATE THE SAMPLES'/
     2' FROM A SINGLE VARIABLE BASED ON VALUES OF ANOTHER'/
     3' VARIABLE.  IF THIS OPTION IS CALLED FOR IT ASSUMES RANGES'/
     4' FOR THE BREAKDOWN WILL BE GIVEN.  ANOTHER OPTION ALLOWS THE'/
     5' BREAKDOWN TO BE DONE ON EACH INDIVIDUAL VALUE OF THE'/
     6' BREAKDOWN VARIABLE.  OPTIONS ARE:'/
     7' "BREAK" - CREATE BREAKDOWNS BASED ON ANOTHER VARIABLE.'/
     8' "DISCR" - ALLOW FOR BREAKDOWNS BASED ON INDIVIDUAL VALUES'/
     9'           (ONLY AVAILABLE WHEN BREAK IS USED)'/
     1' "HEADR" - ELIMINATE MEANS, AND STD.DEV. REPORT'/
     2' "RANGE" - LIST RANGES WHEN AUTOMATIC BREAKDOWN IS USED'/
     3' "AUTO" - AUTOMATIC BREAKDOWN (SPECIFIED WHEN ASKED FOR RANGES)'/
     4' "PROBS" - OUTPUT PROBABILITIES'/
     5'0IF NO OPTIONS ARED DESIRED TYPE A RETURN')
      GO TO 15
11    IF(A(I).NE.'DISCR') GO TO 12
      DISCR=1
      GO TO 9
12    IF(A(I).NE.'BREAK') GO TO 27
      BREAK=1
      GO TO 9
27    IF(A(I).NE.'HEADR') GO TO 28
      HEADR=1
      GO TO 9
28    IF(A(I).NE.'RANGE') GO TO 29
      RANGE=1
      GO TO 9
29    IF(A(I).NE.'AUTO') GO TO 30
45    WRITE(IDLG,46)
46    FORMAT(' "AUTO" IS SPCEIFIED WHEN ASKED FOR RANGES')
      GO TO 15
30    IF(A(I).EQ.'AUTO') GO TO 45
      IF(A(I).NE.'PROBS') GO TO 13
      PBO=1
      GO TO 9
13    IF(A(I).EQ.'     ') GO TO 9
      WRITE(IDLG,14) A(I)
14    FORMAT('0OPTION "',A5,'" DOES NOT EXIST')
      GO TO 15
9     CONTINUE
      IF(BREAK.EQ.1) GO TO 20
C
C     **********************************************************
C     T TESTS BETWEEN INDIVIDUAL VARIABLES NOT ON BREAKDOWNS
C
      IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(I),I=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,83)
83    FORMAT('0',20X,'***** T TESTS *****')
      WRITE(IOUT,1)
1     FORMAT(' ANALYSIS RUN WITH EACH VARIABLE BEING USED'
     1,' AS A TREATMENT')
      LINES=5
      IF(HEADR.EQ.1) GO TO 161
      WRITE(IOUT,43)
43    FORMAT('0VAR.',3X,'SIZE',4X,'MEAN',8X,'STD. DEV.')
      LINES=LINES+2
      DO 162 I=1,NV
      IF(IOUT.NE.21) GO TO 162
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 162
      CALL PRNTHD
      WRITE(IOUT,43)
      LINES=5
162   WRITE(IOUT,42) NAMES(I),NC,VMN(I),STD(I)
42    FORMAT(1X,A5,2X,I4,4X,G10.4,2X,G12.4)
161   DO 2 I=1,NV
      IF(IOUT.NE.21) GO TO 16
      M=(I+ISQ-1)/ISQ
      LINES=LINES+M+1
      IF(PBO.EQ.1) LINES=LINES+M
      IF(LINES.LE.(LINPP-M-1)) GO TO 16
      WRITE(IOUT,151)
      DO 17 K=1,I-1,ISQ
      NEND=K+ISQ-1
      IF(NEND.GT.(I-1)) NEND=I-1
17    WRITE(IOUT,6)(NAMES(J),J=K,NEND)
      CALL PRNTHD
      LINES=3+M
      IF(PBO.EQ.1) LINES=LINES+M
16    DO 2 K=1,I,ISQ
      NEND=K+ISQ-1
      IF(NEND.GT.I) NEND=I
      DO 3 J=K,NEND
      L=J-K+1
      IF(J.EQ.I) GO TO 4
      TOP=VMN(I)-VMN(J)
      BOT=STD(I)**2/NC+STD(J)**2/NC
      IF(BOT.EQ.0) GO TO 4
      BOT=SQRT(BOT)
      T(L)=TOP/BOT
      NDG=2*NC-2
      TSQ=T(L)**2
      IF(PBO.EQ.1) PROB(L)=FISHER(1,NDG,TSQ)
      GO TO 3
4     T(L)=0.0
      PROB(L)=100.
      IF(J.EQ.I) PROB(L)=1.00
3     CONTINUE
      M=NEND-K+1
      IF(K.EQ.1)WRITE (IOUT,5) NAMES(I),(T(J),J=1,M)
5     FORMAT('0',A5,2X,11(G10.4,1X))
      IF(K.NE.1) WRITE(IOUT,44)(T(J),J=1,M)
44    FORMAT(8X,11(G10.4,1X))
      IF(PBO.EQ.1) WRITE(IOUT,170)(PROB(J),J=1,M)
2     CONTINUE
      WRITE(IOUT,151)
151   FORMAT(1X)
      DO 150 K=1,NV,ISQ
      NEND=K+ISQ-1
      IF(NEND.GT.NV)NEND=NV
150   WRITE(IOUT,6)(NAMES(I),I=K,NEND)
6     FORMAT(8X,11(1X,A5,5X))
      RETURN
C
C
C     ********************************************************
C     T-TESTS BASED ON BREAKDOWNS
C
C
20    IF(ICC.NE.2) WRITE(IDLG,21)
21    FORMAT('0ON WHAT VARIABLES ARE THE T-TESTS TO BE RUN? ',$)
      IRET=0
      CALL ALPHA(ITS,20,NZZ,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 20
      IF(IHELP.EQ.1) GO TO 20
      ALL=0
      DO 33 I=1,NZZ
      IF(ITS(I).GT.0) GO TO 33
      NZZ=NV
      ALL=1
      GO TO 31
33    CONTINUE
31    IF(NZZ.LT.1) RETURN
24    IF(ICC.NE.2) WRITE(IDLG,25)
25    FORMAT('0WHAT IS THE VARIABLE TO BE USED FOR THE BREAKDOWN? ',$)
      IRET=0
      CALL ALPHA(IB,1,I,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 24
      IF(IHELP.EQ.1) GO TO 24
      IF(IB.GT.0) GO TO 26
      WRITE(IDLG,23)
23    FORMAT(' ALL MAY NOT BE USED FOR BREAKDOWN VARIABLES')
26    IF(DISCR.EQ.1) GO TO 80
C     BREAKDOWN WAS USED BUT "DISCR" WAS NOT.  ASK USER TO ENTER RANGES
C     AND MAKE ONE PASS DETERMINING WHICH GROUP EACH OBSERVATION IS IN.
C     OUTPUT MEANS AND STANDARD DEVIATIONS, AND THEN T-TESTS.
C
60    IF(ICC.NE.2) WRITE(IDLG,61)
61    FORMAT('0PLEASE ENTER THE RANGES FOR BREAKDOWNS OF VARIABLES'/)
      I=1
62    IF(ICC.NE.2) WRITE(IDLG,70)
70    FORMAT('+? ',$)
      READ(ICC,8,END=69,ERR=69)HELP
      IF(HELP.EQ.'!') RETURN
      IF(HELP.EQ.'STOP') GO TO 69
      IF(HELP.EQ.'AUTO') DISCR=1
      IF(HELP.EQ.'     ') GO TO 69
      IF(HELP.EQ.'AUTO') GO TO 80
      IF(HELP.NE.'HELP') GO TO 64
      WRITE(IDLG,63)
63    FORMAT('0ENTER RANGE FOR EACH TREATMENT, SMALLER FIRST,',
     1' SEPARATED'/' BY A COMMA.  WHEN FINISHED TYPE A ^Z (CONTROL',
     2' Z)'/' TO GROUP SAMPLES AUTOMATICALLY TYPE "AUTO"'/
     3' EXAMPLE:'/' 75,80'/'0CONTINUE NOW'/)
      GO TO 62
64    REREAD 65,(R(I,J),J=1,2)
65    FORMAT(2F)
      IF(R(I,1).LE.R(I,2)) GO TO 67
      WRITE(IDLG,66)
66    FORMAT('0RANGE NOT CORRECT PLEASE REENTER'/)
      GO TO 62
67    I=I+1
      IF(I.LE.50) GO TO 62
      WRITE(IDLG,68)
68    FORMAT('0TOO MANY BREAKDOWNS - NO MORE ACCEPTED')
69    NN=I-1
C
80    DO 81 I=1,NC
      S(I)=DATA(I,IB)
81    IT(I)=I
C     SORT BY SUBSCRIPTS ACM PARTITIONING
C
82    M=1
      II=1
      J=NC
91    IF(II.GE.J) GO TO 98
92    K=II
      IJ=(J+II)/2
      TS=DATA(IT(IJ),IB)
      IF(DATA(IT(II),IB).LE.TS) GO TO 93
      ISAV=IT(IJ)
      IT(IJ)=IT(II)
      IT(II)=ISAV
      TS=DATA(IT(IJ),IB)
93    LL=J
      IF(DATA(IT(J),IB).GE.TS) GO TO 95
      ISAV=IT(IJ)
      IT(IJ)=IT(J)
      IT(J)=ISAV
      TS=DATA(IT(IJ),IB)
      IF(DATA(IT(II),IB).LE.TS) GO TO 95
      ISAV=IT(IJ)
      IT(IJ)=IT(II)
      IT(II)=ISAV
      TS=DATA(IT(IJ),IB)
      GO TO 95
94    ISAV=IT(LL)
      IT(LL)=IT(K)
      IT(K)=ISAV
95    LL=LL-1
      IF(DATA(IT(LL),IB).GT.TS) GO TO 95
      TT=DATA(IT(LL),IB)
96    K=K+1
      IF(DATA(IT(K),IB).LT.TS) GO TO 96
      IF(K.LE.LL) GO TO 94
      IF((LL-II).LE.(J-K)) GO TO 97
      IL(M)=II
      IU(M)=LL
      II=K
      M=M+1
      GO TO 99
97    IL(M)=K
      IU(M)=J
      J=LL
      M=M+1
      GO TO 99
98    M=M-1
      IF(M.EQ.0) GO TO 110
      II=IL(M)
      J=IU(M)
99    IF((J-II).GE.11) GO TO 92
      IF(II.EQ.1) GO TO 91
      II=II-1
100   II=II+1
      IF(II.EQ.J) GO TO 98
      NEXTRA=IT(II+1)
      TS=DATA(IT(II+1),IB)
      IF(DATA(IT(II),IB).LE.TS) GO TO 100
      K=II
101   IT(K+1)=IT(K)
      K=K-1
      IF(TS.LT.DATA(IT(K),IB)) GO TO 101
      IT(K+1)=NEXTRA
      GO TO 100
C
C     END SORT PUT IN S BY TAGS
C
110   NK=1
      DO 111 I=1,NC
      IF(DISCR.EQ.1) GO TO 113
      DO 112 J=1,NN
      IF(DATA(IT(I),IB).LT.R(J,1)) GO TO 112
      IF(DATA(IT(I),IB).GT.R(J,2)) GO TO 112
      S(NK)=J
      GO TO 114
112   CONTINUE
      GO TO 111
113   S(NK)=DATA(IT(I),IB)
114   IT(NK)=IT(I)
      NK=NK+1
111   CONTINUE
      NK=NK-1
      IF(DISCR.NE.1) GO TO 120
      IF(RANGE.NE.1) GO TO 120
C
C     RANGES AND DISCR OR AUTO WERE USED
C
      X=S(1)
      WRITE(IDLG,115) NAMES(IB)
115   FORMAT(' RANGES FOR BREAKDOWN VARIABLE: ',A5)
      WRITE(IDLG,116) X,X
116   FORMAT(1X,G10.4,',',G10.4)
      DO 117 I=2,NC
      IF(X.EQ.S(I))GO TO 117
      X=S(I)
      WRITE(IDLG,116)X,X
117   CONTINUE
C
C     END TYPE OUT OF AUTOMATIC RANGES
C
C     TYPE OUT OF STDEV REPORT
C
120   DO 121 I=1,NZZ
      IF(ALL.EQ.1) GO TO 122
      N=ITS(I)
      GO TO 123
122   IF(I.EQ.IB) GO TO 121
      N=I
123   IF(IOUT.NE.21) WRITE(IOUT,5566) (HEDR(K),K=1,NSZ)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,83)
      WRITE(IOUT,143) NAMES(N),NAMES(IB)
143   FORMAT(' ANALYSIS ON VARIABLE: ',A5,' WITH TREATMENTS ',
     1'DETERMINED'/' BY A BREAKDOWN ON VARIABLE: ',A5)
      LINES=6
      IF(HEADR.EQ.1) GO TO 130
      WRITE(IOUT,43)
      LINES=LINES+2
      NX=0
      SUMX=0
      SUMXX=0
      B=S(1)
      IV1=1
      DO 124 J=1,NK
      IF(B.NE.S(J)) GO TO 125
119   X=DATA(IT(J),N)
      NX=NX+1
      SUMX=SUMX+X
      SUMXX=SUMXX+X**2
      GO TO 124
125   ENCODE (5,126,NAME1)IV1
126   FORMAT(I3,2X)
      XMN=SUMX/NX
      IF(NX.LT.2) XSTD=0
      IF(NX.GE.2) XSTD=SQRT((NX*SUMXX-SUMX**2)/(NX*(NX-1.)))
      IF(IOUT.NE.21) GO TO 127
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 127
      CALL PRNTHD
      WRITE(IOUT,43)
      LINES=5
127   WRITE(IOUT,42) NAME1,NX,XMN,XSTD
      SUMX=0
      SUMXX=0
      NX=0
      B=S(J)
      IV1=IV1+1
      GO TO 119
124   CONTINUE
      ENCODE(5,126,NAME1) IV1
      XMN=SUMX/NX
      XSTD=0
      IF(NX.GE.2) XSTD=SQRT((NX*SUMXX-SUMX**2)/(NX*(NX-1.)))
      IF(IOUT.NE.21)GO TO 128
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 128
      CALL PRNTHD
      WRITE(IOUT,43)
      LINES=5
128   WRITE(IOUT,42) NAME1,NX,XMN,XSTD
C
C     ACTUAL CALCULATION OF T-TESTS (BREAK)
C
130   M=1
      L=0
      IV1=1
131   Y=S(IV1)
      IS1=0
      IV2=1
      L=L+1
      IF(IOUT.NE.21) GO TO 132
      MM=(L+ISQ-1)/ISQ
      LINES=LINES+MM+1
      IF(PBO.EQ.1) LINES=LINES+MM
      IF(LINES.LE.(LINPP-MM-1)) GO TO 132
      WRITE(IOUT,151)
      DO 136 K=1,L-1,ISQ
      NEND=K+ISQ-1
      IF(NEND.GT.(L-1)) NEND=L-1
      DO 141 J=K,NEND
      MMM=J-K+1
141   ENCODE(5,126,T(MMM)) J
136   WRITE(IOUT,6) (T(J),J=1,NEND-K+1)
      CALL PRNTHD
      LINES=3+MM
      IF(PBO.EQ.1) LINES=LINES+MM
132   Z=S(IV2)
      SUMX1=0
      SUMX2=0
      NX1=0
      NX2=0
      SUMXX1=0
      SUMXX2=0
133   X1=DATA(IT(IV1),N)
      SUMX1=SUMX1+X1
      SUMXX1=SUMXX1+X1**2
      NX1=NX1+1
      IV1=IV1+1
      IF(IV1.GT.NK) GO TO 134
      IF(Y.EQ.S(IV1)) GO TO 133
134   X2=DATA(IT(IV2),N)
      SUMX2=SUMX2+X2
      SUMXX2=SUMXX2+X2**2
      NX2=NX2+1
      IV2=IV2+1
      IF(IV2.GE.IV1) GO TO 135
      IF(Z.EQ.S(IV2)) GO TO 134
135   T(M)=0
      IF(NX1.GT.1) SXX1=SQRT((NX1*SUMXX1-SUMX1**2)/(NX1*(NX1-1.)))
      IF(NX2.GT.1) SXX2=SQRT((NX2*SUMXX2-SUMX2**2)/(NX2*(NX2-1.)))
      IF((NX1.GT.1).AND.(NX2.GT.1)) BOT=(((NX1-1.)*SXX1**2+(NX2-1.)
     1*SXX2**2)/(NX1+NX2-2.))*(NX1+NX2)/(NX1*NX2)
      IF((NX1.GT.1).AND.(NX2.GT.1).AND.(BOT.GT.0))T(M)=((SUMX1/NX1)
     1-(SUMX2/NX2))/SQRT(BOT)
      PROB(M)=100.
      NDG=NX1+NX2-2
      TSQ=T(M)**2
      IF((PBO.EQ.1).AND.(NX1.GT.1).AND.(NX2.GT.1).AND.(BOT.GT.0))
     1PROB(M)=FISHER(1,NDG,TSQ)
      M=M+1
      IF(IV2.GE.IV1) GO TO 137
      Z=S(IV2)
      SUMX2=0
      SUMXX2=0
      NX2=0
      IF(M.LE.ISQ) GO TO 134
137   M=M-1
      ENCODE(5,126,NAME1) L
      IF(IS1.EQ.0) WRITE(IOUT,5)NAME1,(T(J),J=1,M)
      IF(IS1.EQ.1) WRITE(IOUT,44) (T(J),J=1,M)
      IF(PBO.EQ.1) WRITE(IOUT,170)(PROB(J),J=1,M)
170   FORMAT(9X,11(F5.3,'P',5X))
      IS1=1
      M=1
      IF(IV2.LT.IV1) GO TO 134
      IF(IV1.LE.NK) GO TO 131
138   WRITE(IOUT,151)
      DO 139 M1=1,L,ISQ
      NEND=M1+ISQ-1
      IF(NEND.GT.L) NEND=L
      DO 140 J=M1,NEND
      M=J-M1+1
140   ENCODE(5,126,T(M)) J
139   WRITE(IOUT,6)(T(J),J=1,NEND-M1+1)
121   CONTINUE
      RETURN
      END