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