Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/ilano.ano
There are no other files named ilano.ano in the archive.
C
C WESTERN MICHIGAN UNIVERSITY
C
C
C ANALYSIS OF VARIANCE
C
C ADAPTED BY BERENICE GAN
C COMPUTER CENTER, WMU
C SEPTEMBER, 1972
C
C
C THIS PROGRAM IS ADAPTED FROM THE WAYNE STATE UNIVERSITY
C VERSION OF ANALYSIS OF VARIANCE (BALANOVA) ORIGINALLY WRITTEN AT
C UNIVERSITY OF ILLINOIS. THE WMU COMPUTER CENTER DISCLAIM ANY
C RESPONSIBILITY IN THE DESIGN, EFFICIENCY AND ACCURACY OF
C THIS PROGRAM.
C
C
C ASIDE FROM REDUCING THE DIMENSION STATEMENTS AND COMPACTING
C THE COMMON STATEMENTS, THIS PROGRAM IS DIVIDED INTO 3 PARTS:
C ILANO.ANO THE RESIDENT PROGRAM
C ILANO1.ANO THE PROGRAM CALLED BY CHAIN 1
C ILANO2.ANO THE PROGRAM CALLED BY CHAIN 2
C
C
C
C SUBROUTINES CONTAINED IN ANO.ANO:
C
C BOOBOO
C CHLOOP
C PRTSN
C C***********************************************************************
C
C
DIMENSION QFNAME(5),QFR(5),ITEMPS(5),NLEV(5),ISIG(100),
1 LDEN1(100),LDEN2(100),LEMST1(100),LT1D(100),LT1S(100),LT2D(100),
2 LT2S(100),LT3S(100),QP1(133),QP2(133),TIT(16)
DIMENSION FNLEV(5),IFIN(5),IND2(5),ISTART(5),ISUB(5),
1 ISUB1(5),ISUB2(5),NALL1(5),NALPHA(5),NALPHR(5),
2 PNAME(5),QFN(5),SSM(32),DF(100),FRAT(100),SIGDIG(100),
3 SMS(100),SS(100),ENTOT(200),XBAR1(200),XTOT(200),X1(200),
4 X(5000),FMT(16)
DIMENSION ISUBSC(5,100),LAUX(5,100),LEMST3(10,100),
1 JSUBSC(5,5),QNEST(5,19)
DIMENSION QCOEFX(5,10,100)
COMMON/BLOCK1/IIID,IIIS,ILAST,IR,IYES,LOOPF,LOOPH,LOOPMX,MICON,
1 MNS,ND,NF,NF1,NIN,NOTS,NOUT,NS,NSCR1,
2 NS1,NS2,NS3,NT1D,NT1S,NT2D,NT2S,NT3S,QB,QBLANK,QC,
3 QN,QP,QREP,QRRR,QX,Q0,QFNAME,QFR,ITEMPS,ISIG,LDEN1,
4 LDEN2,LEMST1,LT1D,LT1S,LT2D,LT2S,LT3S,ISUBSC,LAUX,
5 LEMST3,JSUBSC,QP1,QP2,TIT,QNEST,NLEV,NDEP,NINX,ND1OR2
COMMON/BLOCK3/QCOEFX
COMMON/BLOCK2/COUN,COUNT,EQUN,INITA,INITB,INITC,INITD,INITE,ISUBX,
1 LOOPA,LOOPB,LOOPC,LOOPD,LOOPE,MAXDEP,MNX,NA,NABS,
2 NA1,NN,NNX,NN1,NN2,NN3,NOWDEP,NSTAR,NSTAR1,NSTAR2,
3 NSTAR3,NTYPE1,NTYPE2,NXCDS,NZERO,PILEV,SSC,SSM1,
4 SUMN,SUMX,SUMX2,XNEW,XSUM,FNLEV,IFIN,IND2,ISTART,
5 ISUB,ISUB1,ISUB2,NALL1,NALPHA,NALPHR,SSM,DF,FRAT,
6 SMS,SS,ENTOT,XBAR1,XTOT,X1,FMT,PNAME,PROVER,QFN,
7 SIGDIG
EQUIVALENCE (QCOEFX,X)
DATA FCP016/1H0/,FCP017/1HN/,FCP018/1H /,FCP019/1H /,FCP020/1H&/,
1 FCP021/1HR/,FCP022/1HX/,B/'FINIS'/
C CALL USAGE('ILANO')
NIN=2
NOUT=20
NSCR1=21
C MAXIMUM NUMBER OF FACTORS
MNF=5
C MAXIMUM NUMBER OF LEGAL SOURCES
MNS=100
C MAXIMUM NUMBER OF SIGMA-SQUARED TERMS IN ONE E(MS)
MICON=10
C HOLLERITH LITERAL CONSTANTS
Q0=FCP016
QN=FCP017
QB=FCP018
QBLANK=FCP019
QP=FCP020
QRRR=FCP021
QX=FCP022
29 READ (NIN,30)(TIT(I),I=1,16)
IF (TIT(1).EQ.B) CALL EXIT
30 FORMAT(16A5)
WRITE (NOUT,31)(TIT(I),I=1,16)
31 FORMAT(//'1',54X,'WESTERN MICHIGAN UNIVERSITY'//62X,'VERSION OF'//
1 56X,'UNIVERSITY OF ILLINOIS'///61X,'BALANOVA 5'/61X,10(1H-)//
2 53X,'ANALYSIS OF VARIANCE PROGRAM'////20X,'TITLE, PARAMETER AND
3 FACTOR SPECIFICATION CARDS'/20X,47(1H-)///1X,16A5)
C READ PARAMETER CARD
C NF = NUMBER OF FACTORS
C NDEP = NUMBER OF DEPENDENT VARIABLES
C NINX = NUMBER OF INPUT TAPE FOR DATA CARDS (IF = NIN MAY BE
C BE LEFT BLANK)
C ND1OR2 = 1, DEPENDENT VARIABLES ARE FIRST ON DATA CARDS, FOL-
C LOWED BY SUBSCRIPT SET
C = 2 OR BLANK, DEPENDENT VARIABLES ARE LAST ON DATA CARDS,
C PRECEDED BY SUBSCRIPT SET.
C NCDF = NUMBER OF DATA CARDS PER FORMAT (I.E. PER READ STATEMENT
C OR PER SUBJECT) - NOT NECESSARY TO INCLUDE IF
C NINX = BLANK OR 7
C THE FOLLOWING TWO PARAMETERS ARE NORMALLY BLANK - USED PRINC-
C IPALLY FOR DEBUGGING.
C LOOPMX = OPTIONAL SPECIFICATION OF LOOPMX - USED TO CONTROL
C MAXIMUM NUMBER OF CYCLES IN CERTAIN NESTED LOOPS
C - IF LEFT BLANK, LOOPMX IS SET = 5000 BY PROGRAM
C ILAST = 0, NO DEBUG PRINTING.
C = 1, DEBUG PRINTING.
READ (NIN,9)NF,NDEP,NINX,ND1OR2,NCDF,LOOPMX,ILAST,MISDAT
9 FORMAT (13I6)
WRITE (NOUT,20)NF,NDEP
20 FORMAT(/1X,'THE NUMBER OF FACTORS IS',I6/1X,'THE NUMBER OF DEPENDE
1NT VARIABLES IS',I6/)
IF (NF-MNF)820,820,14
820 IF (NF-1)14,14,840
14 WRITE (NOUT,16)NF
16 FORMAT ('0NUMBER OF FACTORS IS',I10,' WHICH IS ILLEGAL')
CALL BOOBOO(1)
840 NF1=NF-1
C RESET LOOPMX IF READ IN AS 0
IF (LOOPMX.LE.0) LOOPMX=5000
C INPUT DESIGN AND COMPUTE ALL LEGAL SOURCES
730 CALL CHAINB(1,'ILANO')
CALL INPUTD
CALL LEGALS
CALL AUXIL
DO 600 IS=1,NS
600 CALL EMS(IS,ISUBSC(1,IS),ISIG(IS),LEMST3(1,IS),QCOEFX(1,1,IS))
WRITE(NOUT,21)
21 FORMAT(1H0,20X,'TABLE OF EXPECTED VALUES (USED TO DETERMINE COR
1RECT DENOMINATORS)'/21X,67(1H-))
CALL PRTEMS
DO 601 IS=1,NS
601 CALL FINDEN(IS,ISUBSC(1,IS),LEMST3(1,IS),QCOEFX(1,1,IS),
1 ISIG(IS),LDEN1(IS))
CALL SORTAN
IIID=NCDF
CALL CHAINB(2,'ILANO')
CALL SEQPGM
DO 72 NOWDEP=1,NDEP
WRITE (NOUT,90) (TIT(I),I=1,16),NOWDEP
90 FORMAT(1H1,16A5,2X,'DEPENDENT VARIABLE NUMBER ',I5)
IF (IR) 87,87,88
88 NPRINT=0
DO 84 JJ=1,NF
IF (NALPHA(JJ)-1) 84,85,84
85 NPRINT=NPRINT+1
PNAME(NPRINT)=QFNAME(JJ)
84 CONTINUE
WRITE(NOUT,86)(PNAME(NP),NP=1,NPRINT)
86 FORMAT (1H0,20X,'NUMBER OF REPLICATIONS IN EACH CELL'/21X,36(1H-)
1 /1H0,20X,'NUMBER',4X,'CELL'/1H0,30X,10A5)
WRITE(NOUT, 80)
80 FORMAT(1X)
87 CALL READX
IF (NTYPE2.EQ.4) GO TO 72
WRITE(NOUT,76) (QFNAME(IF),IF=1,NF)
76 FORMAT(1H0,20X,'CELL AND MARGINAL MEANS OF THE DEPENDENT VARIABLE'
1 /21X,49(1H-)//' EACH MEAN CORRESPONDS TO THE SUBSCRIPT (LEVEL)
2 SET PRINTED ON THE RIGHT.'/' A ZERO INDICATES THAT THE SUBSCRIPT
3 IS DOTTED (SUMMED OVER)'//16X,'MEAN',6X,'SUBSCRIPT SET'/1H0,30X,
4 10A5)
IF (NTYPE2-2) 73,74,73
73 CALL SSEQU
GO TO 75
74 CALL SSPROP
75 IF (NTYPE1-1) 91,92,91
91 IF (IR) 92,92,104
104 WRITE(NOUT,93)
93 FORMAT('0IN SOME LINES IN THE TABLE THE REPLICATION FACTOR MAY
1 NOT BE DOTTED. IN ANY LINE IN WHICH THIS IS THE CASE, THE INPUT
2 REP-'/' LICATION NUMBER WILL APPEAR AS THE SUBSCRIPT. NOTE
3 THAT IF THE INPUT REPLICATION SUBSCRIPT NUMBER IS EVER ZERO IT
4 WILL NOT'/' BE DISTINGUISHED FROM A DOTTED SUBSCRIPT IN THE
5 TABLE. INTERNALLY IN BALANOVA, HOWEVER, NO CONFUSION WILL HAVE
6 ARISEN.'/'0IF THE REPLICATION FACTOR IS ALWAYS DOTTED IN THE
7 TABLE, IGNORE THIS MESSAGE.')
92 CALL FISH
CALL FPRINT
72 CONTINUE
GO TO 29
END
SUBROUTINE BOOBOO(KK)
NOUT=20
IF (KK.NE.1) GO TO 40
WRITE (NOUT,21)
21 FORMAT ('-THE ABOVE ERROR IS DUE TO ONE OF THE PROGRAM RESTRIC
1TIONS BEING EXCEEDED. THIS ERROR IS POSSIBLY DUE TO AN ERROR ON
2 THE'/' PARAMETER OR FACTOR SPECIFICATION CARDS. IF THESE CARDS
3 ARE CORRECT THEN THE ANALYSIS IS TOO LARGE TO BE RUN WITH THE
4 PRESENT'/' PROGRAM. THE DIMENSIONS IN THE PROGRAM CAN BE INCREA
5SED,HOWEVER, BY FOLLOWING THE INSTRUCTIONS IN THE FORTRAN LISTINGS
6 OF'/' THE TWO MAIN PROGRAMS, ONE FOR EACH CORE LOAD.')
CALL EXIT
40 IF (KK.NE.2) GO TO 41
WRITE (NOUT,22)
22 FORMAT ('0THIS ERROR IS DUE TO AN INCONSISTENCY ON ONE OR MORE
1 FACTOR SPECIFICATION CARDS. CORRECT THE ERROR AND RERUN.')
CALL EXIT
41 IF (KK.NE.3) GO TO 42
13 WRITE(NOUT,23)
23 FORMAT(' THIS ERROR CONDITION WAS INSERTED IN THE PROGRAM PRIMARIL
1Y FOR PROGRAM DEBUGGING. THIS CONDITION SHOULD NOT HAVE OCCURED'
2 /' SINCE THE DESIGN HAS ALREADY BEEN CHECKED TO BE A LEGAL DESIGN
3. HENCE THE OCCURENCE OF THIS ERROR PROBABLY INDICATES A'/' REM
4AMINING ERROR IN THE PROGRAM. IN SOME CASES THIS ERROR IS
5 CONSIDERED NON-FATAL AND THE PROGRAM HAS CONTINUED'/' HOWEVER THE
6 RESULTS SHOULD BE INTERPRETED WITH EXTREME CAUTION IN ANY CASE.')
IF (KK.EQ.6) RETURN
CALL EXIT
42 IF (KK.NE.4)GO TO 45
WRITE (NOUT,24)
24 FORMAT ('-BALANOVA, OF COURSE CONTAINS MANY LOOPS WITHIN LOOPS.
1 THE PRESENT PROGRAM, AS A HEDGE AGAINST INFINITE LOOPING DURING
2 DEBUGGING,'/' CONTAINS AN UPPER LIMIT OF 10,000 ON THE NUMBER
3 OF LOOPS IN ANY ONE NEST OF LOOPS. THIS NUMBER HAS NOW BEEN
4 EXCEEDED.'/' IF THIS IS NOT DUE TO MACHINE ERROR THIS SUPER LIMIT
5 (LOOPMX) MAYBE ALTERED IN THE MAIN PROGRAM OF CORE LOAD 1'/)
CALL EXIT
45 IF (KK.NE.5) GO TO 46
IF (NSWIT.NE.7) GO TO 13
WRITE (NOUT,25)
25 FORMAT ('-THIS ERROR IS DUE TO THE SUBSCRIPT SET GIVEN ABOVE A
1PPEARING ON A DATA CARD. THE SUBSCRIPT SET FALLS OUTSIDE THE MAX
2IMUM NUMBER'/' OF LEVELS STATED ON THE FACTOR SPECIFICATION CARDS.
3 CORRECT EITHER THE FACTOR SPECIFICATION CARDS OR THE DATA CARD
4 AND RERUN')
WRITE(NOUT,52)
52 FORMAT(' IF THIS IS A CLASS B DESIGN (REPLICATION FACTOR BUT NOT
1COMPLETELY CROSSED), IGNORE THE SUBSCRIPT PRINTED FOR THE REPLICA
2TION'/' FACTOR SINCE THIS SUBSCRIPT IS AN INTERNAL NUMBER RATHER
3 THAN THE NUMBER ON THE DATA CARD. THIS SUBSCRIPT IS NOT THE ONE
4 IN'/' ERROR ANYWAY. ONE OF THE OTHERS IS IN ERROR. FOR CLASS A
5 OR C DESIGNS, ALL SUBSCRIPTS PRINTED ARE AS THEY APPEARED ON THE
6 '/' DATA CARD AND ONE OF THEM IS IN ERROR')
CALL EXIT
46 IF (KK.EQ.6) GO TO 13
IF (KK-7)49,17,49
17 NSWIT=17
RETURN
49 IF (KK.NE.8) CALL EXIT
51 NSWIT=8
RETURN
END
SUBROUTINE CHLOOP(LOOP,MAX,LOOPNM,SUBNAM)
NOUT=20
LOOP=LOOP+1
IF (LOOP.LE.MAX) RETURN
11 WRITE (NOUT,12) LOOPNM,LOOP,SUBNAM
12 FORMAT (1H0,A6,' =',I10,' EXCEEDING MAX IN SUBROUTINE ',A6)
CALL BOOBOO(4)
10 RETURN
END
C
C THIS IS A COMBINATION OF THE ORIGINAL SUBROUTINES PRTN AND
C PRTS. PRTN AND PRTS ONLY DIFFER BY ONE STATEMENT AND HENCE
C PRTSN HAS AN EXTRA ARGUMENT TO COMPENSATE THE DIFFERENCE.
C
C
C
SUBROUTINE PRTSN(QQ,I,ISUBS,IDUM)
DIMENSION QFNAME(5),QFR(5),ITEMPS(5),NLEV(5),ISIG(100),
1 LDEN1(100),LDEN2(100),LEMST1(100),LT1D(100),LT1S(100),LT2D(100),
2 LT2S(100),LT3S(100),QP1(133),QP2(133),TIT(16)
DIMENSION ISUBSC(5,100),LAUX(5,100),LEMST3(10,100),
1 JSUBSC(5,5),QNEST(5,19)
DIMENSION ISUBS(5),QQ(133)
COMMON/BLOCK1/IIID,IIIS,ILAST,IR,IYES,LOOPF,LOOPH,LOOPMX,MICON,
1 MNS,ND,NF,NF1,NIN,NOTS,NOUT,NS,NSCR1,
2 NS1,NS2,NS3,NT1D,NT1S,NT2D,NT2S,NT3S,QB,QBLANK,QC,
3 QN,QP,QREP,QRRR,QX,Q0,QFNAME,QFR,ITEMPS,ISIG,LDEN1,
4 LDEN2,LEMST1,LT1D,LT1S,LT2D,LT2S,LT3S,ISUBSC,LAUX,
5 LEMST3,JSUBSC,QP1,QP2,TIT,QNEST,NLEV,NDEP,NINX,ND1OR2
COMMON/BLOCK3/QCOEFX
C STORE SOURCE IN FORM FOR PRINTING IN QQ(I) ONWARDS.
C EXIT WITH I = SUBSCRIPT OF FIRST BLANK COLUMN.
C ONLY LIVE SUBSCRIPTS ARE PRINTED.
C ISUBS(IF),IF=1,NF IS SOURCE SPECIFICATION
DO 12 IF=1,NF
IF (ISUBS(IF)-IDUM)12,13,12
13 QQ(I)=QFNAME(IF)
I=I+1
IF (IDUM.EQ.1) QQ(I)=QC
IF (IDUM.EQ.2) QQ(I)=QX
I=I+1
12 CONTINUE
I=I-1
QQ(I)=QB
RETURN
END