Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/bmd/bmdx64.for
There is 1 other file named bmdx64.for in the archive. Click here to see a list.
00100 C PROGRAM WAS CONVERTED FROM FORTRAN 2 TO 7090 FORTRAN IV
00200 C IT WAS THEN CONVERTED TO 360 FORTRAN IV (H-LEVEL)
00300 COMMON JFA(9100)
00400 COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
00500 100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
00600 2 ,FA1(100),DAN1(100)
00700 C
00800 DOUBLE PRECISION P,PQ,PP,PO
00900 DATA RE/2HNO/
01000 DATA PQ,PP/'FINISH','PROBLM'/
01100 C
01200 30 FORMAT('1BMDX64 - GENERAL LINEAR HYPOTHESIS - REVISED ',
01300 1'JANUARY 20, 1969'/
01400 241H HEALTH SCIENCES COMPUTING FACILITY, UCLA//
01500 X14H PROBLEM CODE ,9(1H.,1X),A6/22H NUMBER OF COVARIATES ,5(1H.,1X)
01600 X,I6/32H NUMBER OF DUMMY VARIABLE CARDS ,I6/24H NUMBER OF OBSERVATI
01700 XONS ,4(1H.,1X),I6/18H NUMBER OF INDICES,7(1H.,1X),I6)
01800 C
01900 CALL USAGEB('BMDX64')
02000 5 READ(5,1) P,PO,NIV,NFA,NH,LH,MT,NF,NCELLS,NI,(NN(I),I=1,10),MMRT
02100 1,REW
02200 C
02300 1 FORMAT(A6,A6,5I2,I1,I5,12I2,A2)
02400 LPT=0
02500 IF(P .EQ. PP) GO TO 7
02600 6 IF(P .EQ. PQ) GO TO 8
02700 9 WRITE (6,10)
02800 10 FORMAT(30H0ILLEGAL FINISH OR PROBLM CARD )
02900 8 CALL EXIT
03000 7 NGV=0
03100 WRITE (6,30) PO,NIV,NFA,NCELLS,NI
03200 L2=0
03300 IF(MT.EQ.0) MT=5
03400 IF(REW.EQ.RE .OR.MT.EQ.5) GO TO 454
03500 REWIND MT
03600 454 DO 2 I=1,NFA
03700 L1=L2+1
03800 L2=L2+NI
03900 READ(5,3) PO, FA(I),FA1(I),(JFA(L),L=L1,L2)
04000 3 FORMAT(A6, A4,A2,10I2)
04100 N=1
04200 LF1(I)=NGV+1
04300 DO 4 L=L1,L2
04400 4 N=N*MAX0(JFA(L),1)
04500 NGV=NGV+N
04600 2 LF2(I)=NGV
04700 LL=NGV+NIV+MAX0(LH,10)+1
04800 L21=L2+MOD(L2,2)+3
04900 A=4500-L21/2-1
05000 B=LL*LL
05100 IF(A-B)21,21,20
05200 21 II=SQRT(A)
05300 II=LL-II
05400 WRITE (6,22) II
05500 22 FORMAT(17H THIS PROBLEM HAS I4,22H TOO MANY VARIABLES )
05600 STOP
05700 20 LLL=L21+LL*LL*2+2
05800 LXL=(9900-LLL)/2
05900 CALL DOIT(JFA,NI,NFA,JFA(L21),LL,JFA(LLL),LXL,MMRT)
06000 GO TO 5
06100 END
06200 SUBROUTINE DOIT(JFA,NU,NV,A,LL,X,LXL,MMRT)
06300 COMMON LFB(9100)
06400 COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
06500 100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
06600 2 ,FA1(100),DAN1(100)
06700 DIMENSION A(LL,LL),JFA(NU,NV),F(180),II(10),X(200),IX(200),
06800 1DA(100),SS(100),DF(100),DN(100),BV(100),DR(32),DS1(18),FP(10)
06900 DIMENSION FI(10)
07000 DOUBLE PRECISION JOR,IAR
07100 DOUBLE PRECISION A,U,X,DA,SS,Y,TN,XX,RSS,TOL,AM,BV
07200 DATA HYP/'HYPO'/
07300 DATA BBB,ANON,COV,ERR/4H ,4HNONE,4HCOVS,4HERRO/,
07400 1 DR/'(// ',' ',' ','X,7H ','CELL ',' ',' ','X,10H
07500 2','PREDI','CTED,','8X,9H','GENER','ATED/',' ',' ',' ',
07600 3' ',' ','X,7HI','NDICE','S ',' ','X,10H',' VA','L
07700 4UE ',',8X,9','HVARI','ABLES',') ',' ',' ',' '/,
07800 5DS1/'( ',' ',' ','I3, ',' ',' ','X,F11','.5,5X
07900 6',', ',' ','I2/( ',' ',' ','X, ',' ',' '
08000 7,'I2)) ',' '/
08100 DATA ERR1/4HR /
08200 DATA DN /2H 1,2H 2,2H 3,2H 4,2H 5,2H 6,2H 7,2H 8,2H 9,
08300 12H10,2H11,2H12,2H13,2H14,2H15,2H16,2H17,2H18,2H19,2H20,2H21,2H22,2
08400 2H23,2H24,2H25,2H26,2H27,2H28,2H29,2H30,2H31,2H32,2H33,2H34,2H35,2H
08500 336,2H37,2H38,2H39,2H40,2H41,2H42,2H43,2H44,2H45,2H46,2H47,2H48,2H4
08600 49,2H50,2H51,2H52,2H53,2H54,2H55,2H56,2H57,2H58,2H59,2H60,2H61,2H62
08700 5,2H63,2H64,2H65,2H66,2H67,2H68,2H69,2H70,2H71,2H72,2H73,2H74,2H75,
08800 62H76,2H77,2H78,2H79,2H80,2H81,2H82,2H83,2H84,2H85,2H86,2H87,2H88,2
08900 7H89,2H90,2H91,2H92,2H93,2H94,2H95,2H96,2H97,2H98,2H99,3H100/
09000 DATA JOR/'DESIGN '/
09100 REWIND 1
09200 ID=1
09300 NVR=NIV+1
09400 MN=0
09500 DO 400 I=1,NFA
09600 MN=MN+1
09700 IF(FA(I)-BBB)402,401,402
09800 402 DAN(MN)=FA(I)
09900 DAN1(MN) = FA1(I)
10000 GO TO 400
10100 401 DAN(MN)=DN(MN)
10200 DAN1(MN) = BBB
10300 400 CONTINUE
10400 DO 32 I=1,LL
10500 DO 32 J=1,I
10600 32 A(J,I)=0.0
10700 K=MAX0(1,3*(NI/2)-2)
10800 L=MAX0(2,3*((NI+1)/2)-4)
10900 M=1+(9-3*NI)*(3/(NI+1))
11000 J=16+M+3*NI
11100 I=(131-J)/2
11200 DS1(3)=DN(NI)
11300 DS1(6)=DN(M)
11400 DS1(10)=DN(I)
11500 DS1(13)=DN(J)
11600 DS1(16)=DN(I)
11700 DR(3)=DN(K)
11800 DR(7)=DN(L)
11900 DR(18)=DN(K)
12000 DR(22)=DN(L)
12100 FP(1)=0.
12200 NF=18*MAX0(1,NF)
12300 READ ( 5,23) (F(I),I=1,NF)
12400 WRITE (6,7849) (F(I),I=1,NF)
12500 7849 FORMAT(16H0VARIABLE FORMAT 1X,18A4/(17X,18A4))
12600 23 FORMAT(18A4)
12700 NIVT=NIV+NGV
12800 NVT=NIVT+1
12900 27 M6=NGV+1
13000 DO 800 I=1,NVT
13100 800 DA(I)=0.
13200 FNC=0.
13300 IAR=BBB
13400 NBV=0
13500 IF(MMRT.LE.0)GO TO 5001
13600 DO 5000 I=1,NI
13700 5000 NBV=NBV+NN(I)-1
13800 NCRD=MMRT
13900 GO TO 5002
14000 5001 NCRD=1
14100 FNC=NCELLS
14200 5002 DO 5011 ICRD=1,NCRD
14300 IF(MMRT)5006,5006,5003
14400 5003 READ(5,5004)IAR,NCELLS,(BV(I),I=1,14)
14500 5004 FORMAT(A6,I3,14F5.0)
14600 IF(IAR.EQ.JOR.AND.NBV.GT.14)READ(5,5005)(BV(I),I=15,NBV)
14700 5005 FORMAT(9X,14F5.0)
14800 FNC=FNC+NCELLS
14900 DO 5056 I=1,10
15000 5056 FI(I)=BV(I)
15100 5006 DO 4 LQ=1,NCELLS
15200 IF(MMRT)5007,5007,5008
15300 5007 READ(MT,F)(FI(I),I=1,NI),(X(I),I=M6,NVT)
15400 GO TO 5009
15500 5008 READ(MT,F)(X(I),I=M6,NVT)
15600 WRITE(1)(BV(I),I=1,NBV)
15700 5009 DO 801 I=M6,NVT
15800 801 DA(I)=DA(I)+X(I)
15900 IF(IAR.EQ.JOR)GO TO 5010
16000 NBV=0
16100 DO 1 I=1,NI
16200 IF(FI(I)-FP(I))2,1,2
16300 1 CONTINUE
16400 GO TO 901
16500 2 DO 5 I=1,NI
16600 FP(I)=FI(I)
16700 5 II(I)=FI(I)
16800 5010 CALL GENVAR(X,JFA,NU,II,NBV,BV)
16900 901 DO 4 I=1,NVT
17000 DO 4 J=1,I
17100 4 A(J,I)=A(J,I)+X(J)*X(I)
17200 5011 CONTINUE
17300 NCELLS=FNC
17400 NCL=NCELLS
17500 664 DO 44 I=1,NVT
17600 X(I)=DA(I)/FNC
17700 44 DA(I)=A(I,I)
17800 REWIND 1
17900 LPT=0
18000 WRITE (6,89)
18100 89 FORMAT(//24H REGRESSION COEFFICIENTS //)
18200 IND(NVT)=1
18300 LLH=0
18400 TOL=1.E-13
18500 DO 57 I=1,NFA
18600 L1=LF1(I)
18700 L2=LF2(I)
18800 DO 58 J=1,NIVT
18900 58 IND(J)=0
19000 DO 59 J=L1,L2
19100 59 IND(J)=-1
19200 DO 60 J=2,NVT
19300 J1=J-1
19400 DO 61 K=1,J1
19500 61 A(J,K)=A(K,J)
19600 60 A(J,J)=DA(J)
19700 A(1,1) = DA(1)
19800 CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
19900 CALL PT(A,LL,DAN(I),DAN1(I))
20000 SS(I)=A(NVT,NVT)
20100 57 DF(I)=ID
20200 IF(NH)63,63,62
20300 62 READ ( 5,23) (F(J),J=1,18)
20400 WRITE(6,666)
20500 666 FORMAT(39H0D-TYPE VARIABLE FORMAT CARD FOR HYPOTH)
20600 WRITE(6,6666)(F(J),J=1,18)
20700 6666 FORMAT(1X,18A4)
20800 DO 65 I=1,NH
20900 READ (5,66) PM,PM1,HLL,HLL1,LLH
21000 66 FORMAT(A4,A2,A4,A2,I2)
21100 IF(PM.NE.HYP) GO TO 719
21200 L1=NVT+1
21300 L2=NVT+LLH
21400 DO 67 K=L1,L2
21500 DO 667 J=1,K
21600 667 A(K,J)=0.
21700 67 READ ( 5,F) (A(K,J),J=1,NVT)
21800 DO 68 J=1,L2
21900 68 IND(J)=0
22000 IND(NVT)=1
22100 DO 80 J=2,NVT
22200 J1=J-1
22300 DO 81 K=1,J1
22400 81 A(J,K)=A(K,J)
22500 80 A(J,J)=DA(J)
22600 A(1,1) = DA(1)
22700 CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
22800 MN=MN+1
22900 IF(HLL-BBB)303,304,303
23000 304 DAN(MN)=DN(MN)
23100 DAN1(MN) = BBB
23200 GO TO 305
23300 303 DAN(MN)=HLL
23400 DAN1(MN)=HLL1
23500 305 CALL PT(A,LL,DAN(MN),DAN1(MN))
23600 SS(MN)=A(NVT,NVT)
23700 65 DF(MN)=ID
23800 63 IF(NIV)306,306,307
23900 307 NGV1=NGV+1
24000 LLH=0
24100 DO 310 I=NGV1,NIVT
24200 310 IND(I)=-1
24300 DO 311 I=1,NGV
24400 311 IND(I)=0
24500 DO 55 I=2,NVT
24600 K1=I-1
24700 DO 56 J=1,K1
24800 56 A(I,J)=A(J,I)
24900 55 A(I,I)=DA(I)
25000 A(1,1) = DA(1)
25100 CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
25200 MN=MN+1
25300 SS(MN)=A(NVT,NVT)
25400 DF(MN)=ID
25500 DAN(MN)=COV
25600 DAN1(MN) = BBB
25700 CALL PT(A,LL,DAN(MN),DAN1(MN))
25800 306 DO 312 I=1,NIVT
25900 312 IND(I)=0
26000 DO 308 I=2,NVT
26100 I1=I-1
26200 DO 309 J=1,I1
26300 309 A(I,J)=A(J,I)
26400 308 A(I,I)=DA(I)
26500 A(1,1) = DA(1)
26600 LLH=0
26700 CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
26800 FID=ID
26900 RSS=A(NVT,NVT)
27000 CALL PT(A,LL,ANON,BBB)
27100 CALL PT(A,LL,-1,0)
27200 WRITE (6,314)
27300 314 FORMAT(///15X,27H ANALYSIS OF VARIANCE TABLE //57H SOURCE SU
27400 1M OF SQUARES D.F. MEAN SQUARE F//)
27500 FDR=FLOAT(NCELLS)-FID
27600 RMS=0.
27700 IF(FDR.NE.0.)RMS=SNGL(RSS)/FDR
27800 DO 315 I=1,MN
27900 313 SS(I)=SS(I)-RSS
28000 DF(I)=FID-DF(I)
28100 ID=DF(I)
28200 IF(ID)860,860,850
28300 860 SS(I)=0.
28400 SM=0.
28500 FF=0.
28600 GO TO 315
28700 850 SM=SNGL(SS(I))/DF(I)
28800 FF=0.
28900 IF(RMS.NE.0.)FF=SM/RMS
29000 315 WRITE(6,316) DAN(I),DAN1(I),SS(I),ID,SM,FF
29100 316 FORMAT(1X,A4,A2,F17.5,I7,F14.5,F14.5)
29200 IF(NIV)326,326,317
29300 317 DO 318 I=NGV1,NIVT
29400 ID=-I
29500 CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
29600 J=I-NGV
29700 IF(ID)807,807,808
29800 807 ST=0.
29900 FF=0.
30000 GO TO 318
30100 808 ST=-A(NVT,I)*A(NVT,I)/A(I,I)
30200 FF=ST/RMS
30300 318 WRITE (6,319) J,ST,ID,ST,FF
30400 319 FORMAT(5H COV.I2,F17.5,I7,F14.5,F14.5)
30500 326 ID=FDR
30600 WRITE (6,316)ERR,ERR1,RSS,ID,RMS
30700 DO 729 I=1,NI
30800 729 II(I)=1
30900 1234 FORMAT(//)
31000 IF(NBV) 783,783,751
31100 751 WRITE (6,758)
31200 758 FORMAT(35 H- CELL PREDICTED GENERATED/36H NUMBER VALU
31300 1E VARIABLES //)
31400 DO 752 J=1,NCL
31500 READ(1)(BV(I),I=1,NBV)
31600 CALL GENVAR(X,JFA,NU,II,NBV,BV)
31700 TN=0.0
31800 DO 753 I=1,NIVT
31900 IX(I)=X(I)
32000 753 TN=TN+A(NVT,I)*X(I)
32100 752 WRITE (6,755) J,TN,(IX(I),I=1,NGV)
32200 755 FORMAT(I4,F14.5,22I5/(18X,22I5))
32300 RETURN
32400 783 WRITE (6,DR)
32500 WRITE (6,1234)
32600 NBV=0
32700 702 CALL GENVAR(X,JFA,NU,II,NBV,BV)
32800 TN=0.
32900 DO 703 I=1,NIVT
33000 IX(I)=X(I)
33100 703 TN=TN+A(NVT,I)*X(I)
33200 WRITE (6,DS1) (II(I),I=1,NI),TN,(IX(I),I=1,NGV)
33300 I=NI
33400 717 II(I)=II(I)+1
33500 IF(II(I)-NN(I))702,702,704
33600 704 II(I)=1
33700 I=I-1
33800 IF(I)718,718,717
33900 719 WRITE(6,720)
34000 720 FORMAT(55H0HYPOTH IS PUNCHED WRONG OR HYPOTH CARD OUT OF SEQUENCE)
34100 9876 FORMAT(10A8)
34200 STOP
34300 718 RETURN
34400 END
34500 SUBROUTINE SOLVIT(A,LL,N1,N2,T,IDF,IND)
34600 DIMENSION A(LL,LL),U(100),V(100),IN(100),IND(2)
34700 DOUBLE PRECISION A,U,V,G,H,X,T,T1
34800 IF(IDF)20,30,30
34900 20 I=-IDF
35000 IF(IN(I))21,21,22
35100 22 DO 23 J=1,N1
35200 IF(IN(J))24,24,23
35300 24 IF(I-J)26,26,25
35400 25 T1=A(I,J)
35500 GO TO 27
35600 26 T1=A(J,I)
35700 27 IF((A(J,J)-T1*T1/A(I,I))/V(I)-T)23,23,21
35800 23 CONTINUE
35900 IDF=1
36000 RETURN
36100 21 IDF=0
36200 RETURN
36300 30 MR=0
36400 MI=0
36500 N=N1+N2+1
36600 L=N1+1
36700 DO 1 I=1,N
36800 V(I)=A(I,I)
36900 1 IN(I)=IND(I)
37000 2 L=L+1
37100 IF(L-N)3,3,4
37200 3 G=0.
37300 DO 5 I=1,N1
37400 IF(IN(I))5,6,5
37500 6 H=DABS(A(I,I)/V(I)*A(L,I))
37600 IF(H-G)5,5,7
37700 7 G=H
37800 K=I
37900 5 CONTINUE
38000 IF(G)2,2,9
38100 9 NN=1
38200 19 T1=G
38300 MI=MI+1
38400 IN(K)=1
38500 10 DO 11 I=1,K
38600 U(I)=A(K,I)
38700 11 A(K,I)=0.
38800 X=U(K)
38900 DO 12 I=K,N
39000 U(I)=A(I,K)
39100 12 A(I,K)=0.
39200 U(K)=-1.
39300 DO 8 I=1,N
39400 DO 8 J=1,I
39500 8 A(I,J)=A(I,J)-U(I)*U(J)/X
39600 IF(NN)14,2,13
39700 13 NN=0
39800 MR=MR+1
39900 K=L
40000 GO TO 10
40100 4 NN=-1
40200 14 G=T
40300 DO 15 I=1,N1
40400 IF(IN(I))15,16,15
40500 16 H=A(I,I)/V(I)
40600 IF(H-G)15,15,17
40700 17 G=H
40800 K=I
40900 15 CONTINUE
41000 IF(G-T)18,18,19
41100 18 A(LL,LL)=T1
41200 IDF=MI-MR
41300 N11=N1+1
41400 DO 31 I=1,N1
41500 IF(IN(I))31,32,31
41600 32 A(N11,I)=0.
41700 31 CONTINUE
41800 RETURN
41900 END
42000 SUBROUTINE PT(A,LL,MM,MM1)
42100 COMMON LFB(9100)
42200 COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
42300 100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
42400 2 ,FA1(100),DAN1(100)
42500 DIMENSION A(LL,LL),MMM(10),MMM1(10)
42600 DOUBLE PRECISION A
42700 IF(MM+1)2,1,2
42800 2 LPT=LPT+1
42900 L=LPT+NVT
43000 MMM(LPT)=MM
43100 MMM1(LPT) = MM1
43200 DO 3 I=1,NIVT
43300 IF(IND(I))11,10,11
43400 11 A(I,L)=0.0
43500 GO TO 3
43600 10 A(I,L)= A(NVT,I)
43700 3 CONTINUE
43800 A(NVT,L)=A(LL,LL)
43900 IF(LPT-10)4,1,1
44000 1 WRITE(6,8) (MMM(I),MMM1(I),I=1,LPT)
44100 8 FORMAT(/20X,10HHYPOTHESIS//5X,10(5X,A4,A2))
44200 WRITE (6,9)
44300 9 FORMAT(6H VAR.)
44400 L1=NVT+1
44500 L2=NVT+LPT
44600 DO 5 I=1,NIVT
44700 5 WRITE (6,6) I,(A(I,J),J=L1,L2)
44800 6 FORMAT(I5,10F11.5)
44900 WRITE (6,7) (A(NVT,J),J=L1,L2)
45000 7 FORMAT(10H0TOLERANCE/(5X,10F11.5))
45100 LPT=0
45200 4 RETURN
45300 END
45400 SUBROUTINE GENVAR(X,JFA,NU,II,NBV,BV)
45500 DIMENSION X(200),JFA(NU,NU),II(2),U(100),BV(2)
45600 DOUBLE PRECISION X,U,Y,BV
45700 COMMON LFB(9100)
45800 COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
45900 100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
46000 M=0
46100 DO 30 L=1,NFA
46200 LLL=0
46300 M=M+1
46400 X(M)=1.0
46500 M0=M
46600 DO 30 K=1,NI
46700 LL=LLL
46800 NNK=NN(K)
46900 NNK1=NNK-1
47000 IF(JFA(K,L))30,30,34
47100 34 IF(NBV)1,1,2
47200 2 DO 3 J=1,NNK1
47300 LL=LL+1
47400 3 U(J)=BV(LL)
47500 GO TO 19
47600 1 IF(II(K)-NN(K))16,15,222
47700 222 WRITE (6,1111)
47800 1111 FORMAT(19H0INDEX OUT OF RANGE)
47900 CALL EXIT
48000 22 FORMAT(11I3)
48100 15 DO 17 J=1,NNK
48200 17 U(J)=-1.0
48300 GO TO 19
48400 16 DO 18 J=1,NNK
48500 18 U(J)=0.0
48600 IIK=II(K)
48700 U(IIK)=1.0
48800 19 U(NNK)=1.0
48900 JFAN=JFA(K,L)
49000 MM=M-M0+1
49100 DO 20 I=M0,M
49200 N=I
49300 Y=X(I)
49400 DO 20 J=1,JFAN
49500 X(N)=Y*U(J)
49600 20 N=N+MM
49700 M=N-MM
49800 30 LLL=LLL+NNK1
49900 RETURN
50000 END
50100