Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/ilano/ilano.for
There is 1 other file named ilano.for in the archive. Click here to see a list.
00100 C
00200 C WESTERN MICHIGAN UNIVERSITY
00300 C
00400 C
00500 C ANALYSIS OF VARIANCE
00600 C
00700 C ADAPTED BY BERENICE GAN
00800 C COMPUTER CENTER, WMU
00900 C SEPTEMBER, 1972
01000 C
01100 C
01200 C THIS PROGRAM IS ADAPTED FROM THE WAYNE STATE UNIVERSITY
01300 C VERSION OF ANALYSIS OF VARIANCE (BALANOVA) ORIGINALLY WRITTEN AT
01400 C UNIVERSITY OF ILLINOIS. THE WMU COMPUTER CENTER DISCLAIM ANY
01500 C RESPONSIBILITY IN THE DESIGN, EFFICIENCY AND ACCURACY OF
01600 C THIS PROGRAM.
01700 C
01800 C
01900 C ASIDE FROM REDUCING THE DIMENSION STATEMENTS AND COMPACTING
02000 C THE COMMON STATEMENTS, THIS PROGRAM IS DIVIDED INTO 3 PARTS:
02100 C ILANO.ANO THE RESIDENT PROGRAM
02200 C ILANO1.ANO THE PROGRAM CALLED BY CHAIN 1
02300 C ILANO2.ANO THE PROGRAM CALLED BY CHAIN 2
02400 C
02500 C
02600 C
02700 C SUBROUTINES CONTAINED IN ANO.ANO:
02800 C
02900 C BOOBOO
03000 C CHLOOP
03100 C PRTSN
03200 C C***********************************************************************
03300 C
03400 C
03500 DIMENSION QFNAME(5),QFR(5),ITEMPS(5),NLEV(5),ISIG(100),
03600 1 LDEN1(100),LDEN2(100),LEMST1(100),LT1D(100),LT1S(100),LT2D(100),
03700 2 LT2S(100),LT3S(100),QP1(133),QP2(133),TIT(16)
03800 DIMENSION FNLEV(5),IFIN(5),IND2(5),ISTART(5),ISUB(5),
03900 1 ISUB1(5),ISUB2(5),NALL1(5),NALPHA(5),NALPHR(5),
04000 2 PNAME(5),QFN(5),SSM(32),DF(100),FRAT(100),SIGDIG(100),
04100 3 SMS(100),SS(100),ENTOT(200),XBAR1(200),XTOT(200),X1(200),
04200 4 X(5000),FMT(16)
04300 DIMENSION ISUBSC(5,100),LAUX(5,100),LEMST3(10,100),
04400 1 JSUBSC(5,5),QNEST(5,19)
04500 DIMENSION QCOEFX(5,10,100)
04600 COMMON/BLOCK1/IIID,IIIS,ILAST,IR,IYES,LOOPF,LOOPH,LOOPMX,MICON,
04700 1 MNS,ND,NF,NF1,NIN,NOTS,NOUT,NS,NSCR1,
04800 2 NS1,NS2,NS3,NT1D,NT1S,NT2D,NT2S,NT3S,QB,QBLANK,QC,
04900 3 QN,QP,QREP,QRRR,QX,Q0,QFNAME,QFR,ITEMPS,ISIG,LDEN1,
05000 4 LDEN2,LEMST1,LT1D,LT1S,LT2D,LT2S,LT3S,ISUBSC,LAUX,
05100 5 LEMST3,JSUBSC,QP1,QP2,TIT,QNEST,NLEV,NDEP,NINX,ND1OR2
05200 COMMON/BLOCK3/QCOEFX
05300 COMMON/BLOCK2/COUN,COUNT,EQUN,INITA,INITB,INITC,INITD,INITE,ISUBX,
05400 1 LOOPA,LOOPB,LOOPC,LOOPD,LOOPE,MAXDEP,MNX,NA,NABS,
05500 2 NA1,NN,NNX,NN1,NN2,NN3,NOWDEP,NSTAR,NSTAR1,NSTAR2,
05600 3 NSTAR3,NTYPE1,NTYPE2,NXCDS,NZERO,PILEV,SSC,SSM1,
05700 4 SUMN,SUMX,SUMX2,XNEW,XSUM,FNLEV,IFIN,IND2,ISTART,
05800 5 ISUB,ISUB1,ISUB2,NALL1,NALPHA,NALPHR,SSM,DF,FRAT,
05900 6 SMS,SS,ENTOT,XBAR1,XTOT,X1,FMT,PNAME,PROVER,QFN,
06000 7 SIGDIG
06100 EQUIVALENCE (QCOEFX,X)
06200 DATA FCP016/1H0/,FCP017/1HN/,FCP018/1H /,FCP019/1H /,FCP020/1H&/,
06300 1 FCP021/1HR/,FCP022/1HX/,B/'FINIS'/
06400 C CALL USAGE('ILANO')
06500 NIN=2
06600 NOUT=20
06700 NSCR1=21
06800 C MAXIMUM NUMBER OF FACTORS
06900 MNF=5
07000 C MAXIMUM NUMBER OF LEGAL SOURCES
07100 MNS=100
07200 C MAXIMUM NUMBER OF SIGMA-SQUARED TERMS IN ONE E(MS)
07300 MICON=10
07400 C HOLLERITH LITERAL CONSTANTS
07500 Q0=FCP016
07600 QN=FCP017
07700 QB=FCP018
07800 QBLANK=FCP019
07900 QP=FCP020
08000 QRRR=FCP021
08100 QX=FCP022
08200 29 READ (NIN,30)(TIT(I),I=1,16)
08300 IF (TIT(1).EQ.B) CALL EXIT
08400 30 FORMAT(16A5)
08500 WRITE (NOUT,31)(TIT(I),I=1,16)
08600 31 FORMAT(//'1',54X,'WESTERN MICHIGAN UNIVERSITY'//62X,'VERSION OF'//
08700 1 56X,'UNIVERSITY OF ILLINOIS'///61X,'BALANOVA 5'/61X,10(1H-)//
08800 2 53X,'ANALYSIS OF VARIANCE PROGRAM'////20X,'TITLE, PARAMETER AND
08900 3 FACTOR SPECIFICATION CARDS'/20X,47(1H-)///1X,16A5)
09000 C READ PARAMETER CARD
09100 C NF = NUMBER OF FACTORS
09200 C NDEP = NUMBER OF DEPENDENT VARIABLES
09300 C NINX = NUMBER OF INPUT TAPE FOR DATA CARDS (IF = NIN MAY BE
09400 C BE LEFT BLANK)
09500 C ND1OR2 = 1, DEPENDENT VARIABLES ARE FIRST ON DATA CARDS, FOL-
09600 C LOWED BY SUBSCRIPT SET
09700 C = 2 OR BLANK, DEPENDENT VARIABLES ARE LAST ON DATA CARDS,
09800 C PRECEDED BY SUBSCRIPT SET.
09900 C NCDF = NUMBER OF DATA CARDS PER FORMAT (I.E. PER READ STATEMENT
10000 C OR PER SUBJECT) - NOT NECESSARY TO INCLUDE IF
10100 C NINX = BLANK OR 7
10200 C THE FOLLOWING TWO PARAMETERS ARE NORMALLY BLANK - USED PRINC-
10300 C IPALLY FOR DEBUGGING.
10400 C LOOPMX = OPTIONAL SPECIFICATION OF LOOPMX - USED TO CONTROL
10500 C MAXIMUM NUMBER OF CYCLES IN CERTAIN NESTED LOOPS
10600 C - IF LEFT BLANK, LOOPMX IS SET = 5000 BY PROGRAM
10700 C ILAST = 0, NO DEBUG PRINTING.
10800 C = 1, DEBUG PRINTING.
10900 READ (NIN,9)NF,NDEP,NINX,ND1OR2,NCDF,LOOPMX,ILAST,MISDAT
11000 9 FORMAT (13I6)
11100 WRITE (NOUT,20)NF,NDEP
11200 20 FORMAT(/1X,'THE NUMBER OF FACTORS IS',I6/1X,'THE NUMBER OF DEPENDE
11300 1NT VARIABLES IS',I6/)
11400 IF (NF-MNF)820,820,14
11500 820 IF (NF-1)14,14,840
11600 14 WRITE (NOUT,16)NF
11700 16 FORMAT ('0NUMBER OF FACTORS IS',I10,' WHICH IS ILLEGAL')
11800 CALL BOOBOO(1)
11900 840 NF1=NF-1
12000 C RESET LOOPMX IF READ IN AS 0
12100 IF (LOOPMX.LE.0) LOOPMX=5000
12200 C INPUT DESIGN AND COMPUTE ALL LEGAL SOURCES
12400 730 CALL INPUTD
12500 CALL LEGALS
12600 CALL AUXIL
12700 DO 600 IS=1,NS
12800 600 CALL EMS(IS,ISUBSC(1,IS),ISIG(IS),LEMST3(1,IS),QCOEFX(1,1,IS))
12900 WRITE(NOUT,21)
13000 21 FORMAT(1H0,20X,'TABLE OF EXPECTED VALUES (USED TO DETERMINE COR
13100 1RECT DENOMINATORS)'/21X,67(1H-))
13200 CALL PRTEMS
13300 DO 601 IS=1,NS
13400 601 CALL FINDEN(IS,ISUBSC(1,IS),LEMST3(1,IS),QCOEFX(1,1,IS),
13500 1 ISIG(IS),LDEN1(IS))
13600 CALL SORTAN
13700 IIID=NCDF
13900 CALL SEQPGM
14000 DO 72 NOWDEP=1,NDEP
14100 WRITE (NOUT,90) (TIT(I),I=1,16),NOWDEP
14200 90 FORMAT(1H1,16A5,2X,'DEPENDENT VARIABLE NUMBER ',I5)
14300 IF (IR) 87,87,88
14400 88 NPRINT=0
14500 DO 84 JJ=1,NF
14600 IF (NALPHA(JJ)-1) 84,85,84
14700 85 NPRINT=NPRINT+1
14800 PNAME(NPRINT)=QFNAME(JJ)
14900 84 CONTINUE
15000 WRITE(NOUT,86)(PNAME(NP),NP=1,NPRINT)
15100 86 FORMAT (1H0,20X,'NUMBER OF REPLICATIONS IN EACH CELL'/21X,36(1H-)
15200 1 /1H0,20X,'NUMBER',4X,'CELL'/1H0,30X,10A5)
15300 WRITE(NOUT, 80)
15400 80 FORMAT(1X)
15500 87 CALL READX
15600 IF (NTYPE2.EQ.4) GO TO 72
15700 WRITE(NOUT,76) (QFNAME(IF),IF=1,NF)
15800 76 FORMAT(1H0,20X,'CELL AND MARGINAL MEANS OF THE DEPENDENT VARIABLE'
15900 1 /21X,49(1H-)//' EACH MEAN CORRESPONDS TO THE SUBSCRIPT (LEVEL)
16000 2 SET PRINTED ON THE RIGHT.'/' A ZERO INDICATES THAT THE SUBSCRIPT
16100 3 IS DOTTED (SUMMED OVER)'//16X,'MEAN',6X,'SUBSCRIPT SET'/1H0,30X,
16200 4 10A5)
16300 IF (NTYPE2-2) 73,74,73
16400 73 CALL SSEQU
16500 GO TO 75
16600 74 CALL SSPROP
16700 75 IF (NTYPE1-1) 91,92,91
16800 91 IF (IR) 92,92,104
16900 104 WRITE(NOUT,93)
17000 93 FORMAT('0IN SOME LINES IN THE TABLE THE REPLICATION FACTOR MAY
17100 1 NOT BE DOTTED. IN ANY LINE IN WHICH THIS IS THE CASE, THE INPUT
17200 2 REP-'/' LICATION NUMBER WILL APPEAR AS THE SUBSCRIPT. NOTE
17300 3 THAT IF THE INPUT REPLICATION SUBSCRIPT NUMBER IS EVER ZERO IT
17400 4 WILL NOT'/' BE DISTINGUISHED FROM A DOTTED SUBSCRIPT IN THE
17500 5 TABLE. INTERNALLY IN BALANOVA, HOWEVER, NO CONFUSION WILL HAVE
17600 6 ARISEN.'/'0IF THE REPLICATION FACTOR IS ALWAYS DOTTED IN THE
17700 7 TABLE, IGNORE THIS MESSAGE.')
17800 92 CALL FISH
17900 CALL FPRINT
18000 72 CONTINUE
18100 GO TO 29
18200 END
18300 SUBROUTINE BOOBOO(KK)
18400 NOUT=20
18500 IF (KK.NE.1) GO TO 40
18600 WRITE (NOUT,21)
18700 21 FORMAT ('-THE ABOVE ERROR IS DUE TO ONE OF THE PROGRAM RESTRIC
18800 1TIONS BEING EXCEEDED. THIS ERROR IS POSSIBLY DUE TO AN ERROR ON
18900 2 THE'/' PARAMETER OR FACTOR SPECIFICATION CARDS. IF THESE CARDS
19000 3 ARE CORRECT THEN THE ANALYSIS IS TOO LARGE TO BE RUN WITH THE
19100 4 PRESENT'/' PROGRAM. THE DIMENSIONS IN THE PROGRAM CAN BE INCREA
19200 5SED,HOWEVER, BY FOLLOWING THE INSTRUCTIONS IN THE FORTRAN LISTINGS
19300 6 OF'/' THE TWO MAIN PROGRAMS, ONE FOR EACH CORE LOAD.')
19400 CALL EXIT
19500 40 IF (KK.NE.2) GO TO 41
19600 WRITE (NOUT,22)
19700 22 FORMAT ('0THIS ERROR IS DUE TO AN INCONSISTENCY ON ONE OR MORE
19800 1 FACTOR SPECIFICATION CARDS. CORRECT THE ERROR AND RERUN.')
19900 CALL EXIT
20000 41 IF (KK.NE.3) GO TO 42
20100 13 WRITE(NOUT,23)
20200 23 FORMAT(' THIS ERROR CONDITION WAS INSERTED IN THE PROGRAM PRIMARIL
20300 1Y FOR PROGRAM DEBUGGING. THIS CONDITION SHOULD NOT HAVE OCCURED'
20400 2 /' SINCE THE DESIGN HAS ALREADY BEEN CHECKED TO BE A LEGAL DESIGN
20500 3. HENCE THE OCCURENCE OF THIS ERROR PROBABLY INDICATES A'/' REM
20600 4AMINING ERROR IN THE PROGRAM. IN SOME CASES THIS ERROR IS
20700 5 CONSIDERED NON-FATAL AND THE PROGRAM HAS CONTINUED'/' HOWEVER THE
20800 6 RESULTS SHOULD BE INTERPRETED WITH EXTREME CAUTION IN ANY CASE.')
20900 IF (KK.EQ.6) RETURN
21000 CALL EXIT
21100 42 IF (KK.NE.4)GO TO 45
21200 WRITE (NOUT,24)
21300 24 FORMAT ('-BALANOVA, OF COURSE CONTAINS MANY LOOPS WITHIN LOOPS.
21400 1 THE PRESENT PROGRAM, AS A HEDGE AGAINST INFINITE LOOPING DURING
21500 2 DEBUGGING,'/' CONTAINS AN UPPER LIMIT OF 10,000 ON THE NUMBER
21600 3 OF LOOPS IN ANY ONE NEST OF LOOPS. THIS NUMBER HAS NOW BEEN
21700 4 EXCEEDED.'/' IF THIS IS NOT DUE TO MACHINE ERROR THIS SUPER LIMIT
21800 5 (LOOPMX) MAYBE ALTERED IN THE MAIN PROGRAM OF CORE LOAD 1'/)
21900 CALL EXIT
22000 45 IF (KK.NE.5) GO TO 46
22100 IF (NSWIT.NE.7) GO TO 13
22200 WRITE (NOUT,25)
22300 25 FORMAT ('-THIS ERROR IS DUE TO THE SUBSCRIPT SET GIVEN ABOVE A
22400 1PPEARING ON A DATA CARD. THE SUBSCRIPT SET FALLS OUTSIDE THE MAX
22500 2IMUM NUMBER'/' OF LEVELS STATED ON THE FACTOR SPECIFICATION CARDS.
22600 3 CORRECT EITHER THE FACTOR SPECIFICATION CARDS OR THE DATA CARD
22700 4 AND RERUN')
22800 WRITE(NOUT,52)
22900 52 FORMAT(' IF THIS IS A CLASS B DESIGN (REPLICATION FACTOR BUT NOT
23000 1COMPLETELY CROSSED), IGNORE THE SUBSCRIPT PRINTED FOR THE REPLICA
23100 2TION'/' FACTOR SINCE THIS SUBSCRIPT IS AN INTERNAL NUMBER RATHER
23200 3 THAN THE NUMBER ON THE DATA CARD. THIS SUBSCRIPT IS NOT THE ONE
23300 4 IN'/' ERROR ANYWAY. ONE OF THE OTHERS IS IN ERROR. FOR CLASS A
23400 5 OR C DESIGNS, ALL SUBSCRIPTS PRINTED ARE AS THEY APPEARED ON THE
23500 6 '/' DATA CARD AND ONE OF THEM IS IN ERROR')
23600 CALL EXIT
23700 46 IF (KK.EQ.6) GO TO 13
23800 IF (KK-7)49,17,49
23900 17 NSWIT=17
24000 RETURN
24100 49 IF (KK.NE.8) CALL EXIT
24200 51 NSWIT=8
24300 RETURN
24400 END
24500 SUBROUTINE CHLOOP(LOOP,MAX,LOOPNM,SUBNAM)
24600 NOUT=20
24700 LOOP=LOOP+1
24800 IF (LOOP.LE.MAX) RETURN
24900 11 WRITE (NOUT,12) LOOPNM,LOOP,SUBNAM
25000 12 FORMAT (1H0,A6,' =',I10,' EXCEEDING MAX IN SUBROUTINE ',A6)
25100 CALL BOOBOO(4)
25200 10 RETURN
25300 END
25400 C
25500 C THIS IS A COMBINATION OF THE ORIGINAL SUBROUTINES PRTN AND
25600 C PRTS. PRTN AND PRTS ONLY DIFFER BY ONE STATEMENT AND HENCE
25700 C PRTSN HAS AN EXTRA ARGUMENT TO COMPENSATE THE DIFFERENCE.
25800 C
25900 C
26000 C
26100 SUBROUTINE PRTSN(QQ,I,ISUBS,IDUM)
26200 DIMENSION QFNAME(5),QFR(5),ITEMPS(5),NLEV(5),ISIG(100),
26300 1 LDEN1(100),LDEN2(100),LEMST1(100),LT1D(100),LT1S(100),LT2D(100),
26400 2 LT2S(100),LT3S(100),QP1(133),QP2(133),TIT(16)
26500 DIMENSION ISUBSC(5,100),LAUX(5,100),LEMST3(10,100),
26600 1 JSUBSC(5,5),QNEST(5,19)
26700 DIMENSION ISUBS(5),QQ(133)
26800 COMMON/BLOCK1/IIID,IIIS,ILAST,IR,IYES,LOOPF,LOOPH,LOOPMX,MICON,
26900 1 MNS,ND,NF,NF1,NIN,NOTS,NOUT,NS,NSCR1,
27000 2 NS1,NS2,NS3,NT1D,NT1S,NT2D,NT2S,NT3S,QB,QBLANK,QC,
27100 3 QN,QP,QREP,QRRR,QX,Q0,QFNAME,QFR,ITEMPS,ISIG,LDEN1,
27200 4 LDEN2,LEMST1,LT1D,LT1S,LT2D,LT2S,LT3S,ISUBSC,LAUX,
27300 5 LEMST3,JSUBSC,QP1,QP2,TIT,QNEST,NLEV,NDEP,NINX,ND1OR2
27400 COMMON/BLOCK3/QCOEFX
27500 C STORE SOURCE IN FORM FOR PRINTING IN QQ(I) ONWARDS.
27600 C EXIT WITH I = SUBSCRIPT OF FIRST BLANK COLUMN.
27700 C ONLY LIVE SUBSCRIPTS ARE PRINTED.
27800 C ISUBS(IF),IF=1,NF IS SOURCE SPECIFICATION
27900 DO 12 IF=1,NF
28000 IF (ISUBS(IF)-IDUM)12,13,12
28100 13 QQ(I)=QFNAME(IF)
28200 I=I+1
28300 IF (IDUM.EQ.1) QQ(I)=QC
28400 IF (IDUM.EQ.2) QQ(I)=QX
28500 I=I+1
28600 12 CONTINUE
28700 I=I-1
28800 QQ(I)=QB
28900 RETURN
29000 END