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