Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
C PROGRAM WAS CONVERTED FROM FORTRAN 2 TO 7090 FORTRAN IV
C IT WAS THEN CONVERTED TO 360 FORTRAN IV (H-LEVEL)
COMMON JFA(9100)
COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
2 ,FA1(100),DAN1(100)
C
DOUBLE PRECISION P,PQ,PP,PO
DATA RE/2HNO/
DATA PQ,PP/'FINISH','PROBLM'/
C
30 FORMAT('1BMDX64 - GENERAL LINEAR HYPOTHESIS - REVISED ',
1'JANUARY 20, 1969'/
241H HEALTH SCIENCES COMPUTING FACILITY, UCLA//
X14H PROBLEM CODE ,9(1H.,1X),A6/22H NUMBER OF COVARIATES ,5(1H.,1X)
X,I6/32H NUMBER OF DUMMY VARIABLE CARDS ,I6/24H NUMBER OF OBSERVATI
XONS ,4(1H.,1X),I6/18H NUMBER OF INDICES,7(1H.,1X),I6)
C
CALL USAGEB('BMDX64')
5 READ(5,1) P,PO,NIV,NFA,NH,LH,MT,NF,NCELLS,NI,(NN(I),I=1,10),MMRT
1,REW
C
1 FORMAT(A6,A6,5I2,I1,I5,12I2,A2)
LPT=0
IF(P .EQ. PP) GO TO 7
6 IF(P .EQ. PQ) GO TO 8
9 WRITE (6,10)
10 FORMAT(30H0ILLEGAL FINISH OR PROBLM CARD )
8 CALL EXIT
7 NGV=0
WRITE (6,30) PO,NIV,NFA,NCELLS,NI
L2=0
IF(MT.EQ.0) MT=5
IF(REW.EQ.RE .OR.MT.EQ.5) GO TO 454
REWIND MT
454 DO 2 I=1,NFA
L1=L2+1
L2=L2+NI
READ(5,3) PO, FA(I),FA1(I),(JFA(L),L=L1,L2)
3 FORMAT(A6, A4,A2,10I2)
N=1
LF1(I)=NGV+1
DO 4 L=L1,L2
4 N=N*MAX0(JFA(L),1)
NGV=NGV+N
2 LF2(I)=NGV
LL=NGV+NIV+MAX0(LH,10)+1
L21=L2+MOD(L2,2)+3
A=4500-L21/2-1
B=LL*LL
IF(A-B)21,21,20
21 II=SQRT(A)
II=LL-II
WRITE (6,22) II
22 FORMAT(17H THIS PROBLEM HAS I4,22H TOO MANY VARIABLES )
STOP
20 LLL=L21+LL*LL*2+2
LXL=(9900-LLL)/2
CALL DOIT(JFA,NI,NFA,JFA(L21),LL,JFA(LLL),LXL,MMRT)
GO TO 5
END
SUBROUTINE DOIT(JFA,NU,NV,A,LL,X,LXL,MMRT)
COMMON LFB(9100)
COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
2 ,FA1(100),DAN1(100)
DIMENSION A(LL,LL),JFA(NU,NV),F(180),II(10),X(200),IX(200),
1DA(100),SS(100),DF(100),DN(100),BV(100),DR(32),DS1(18),FP(10)
DIMENSION FI(10)
DOUBLE PRECISION JOR,IAR
DOUBLE PRECISION A,U,X,DA,SS,Y,TN,XX,RSS,TOL,AM,BV
DATA HYP/'HYPO'/
DATA BBB,ANON,COV,ERR/4H ,4HNONE,4HCOVS,4HERRO/
1,DR/'(// ',' ',' ','X,7H ','CELL ',' ',' ','X,10H
2','PREDI','CTED,','8X,9H','GENER','ATED/',' ',' ',' ',
3' ',' ','X,7HI','NDICE','S ',' ','X,10H',' VA','L
4UE ',',8X,9','HVARI','ABLES',') ',' ',' ',' '/,
5DS1/'( ',' ',' ','I3, ',' ',' ','X,F11','.5,5X
6',', ',' ','I2/( ',' ',' ','X, ',' ',' '
7,'I2)) ',' '/
DATA ERR1/4HR /
DATA DN /2H 1,2H 2,2H 3,2H 4,2H 5,2H 6,2H 7,2H 8,2H 9,
12H10,2H11,2H12,2H13,2H14,2H15,2H16,2H17,2H18,2H19,2H20,2H21,2H22,2
2H23,2H24,2H25,2H26,2H27,2H28,2H29,2H30,2H31,2H32,2H33,2H34,2H35,2H
336,2H37,2H38,2H39,2H40,2H41,2H42,2H43,2H44,2H45,2H46,2H47,2H48,2H4
49,2H50,2H51,2H52,2H53,2H54,2H55,2H56,2H57,2H58,2H59,2H60,2H61,2H62
5,2H63,2H64,2H65,2H66,2H67,2H68,2H69,2H70,2H71,2H72,2H73,2H74,2H75,
62H76,2H77,2H78,2H79,2H80,2H81,2H82,2H83,2H84,2H85,2H86,2H87,2H88,2
7H89,2H90,2H91,2H92,2H93,2H94,2H95,2H96,2H97,2H98,2H99,3H100/
DATA JOR/'DESIGN '/
REWIND 1
ID=1
NVR=NIV+1
MN=0
DO 400 I=1,NFA
MN=MN+1
IF(FA(I)-BBB)402,401,402
402 DAN(MN)=FA(I)
DAN1(MN) = FA1(I)
GO TO 400
401 DAN(MN)=DN(MN)
DAN1(MN) = BBB
400 CONTINUE
DO 32 I=1,LL
DO 32 J=1,I
32 A(J,I)=0.0
K=MAX0(1,3*(NI/2)-2)
L=MAX0(2,3*((NI+1)/2)-4)
M=1+(9-3*NI)*(3/(NI+1))
J=16+M+3*NI
I=(131-J)/2
DS1(3)=DN(NI)
DS1(6)=DN(M)
DS1(10)=DN(I)
DS1(13)=DN(J)
DS1(16)=DN(I)
DR(3)=DN(K)
DR(7)=DN(L)
DR(18)=DN(K)
DR(22)=DN(L)
FP(1)=0.
NF=18*MAX0(1,NF)
READ ( 5,23) (F(I),I=1,NF)
WRITE (6,7849) (F(I),I=1,NF)
7849 FORMAT(16H0VARIABLE FORMAT 1X,18A4/(17X,18A4))
23 FORMAT(18A4)
NIVT=NIV+NGV
NVT=NIVT+1
27 M6=NGV+1
DO 800 I=1,NVT
800 DA(I)=0.
FNC=0.
IAR=BBB
NBV=0
IF(MMRT.LE.0)GO TO 5001
DO 5000 I=1,NI
5000 NBV=NBV+NN(I)-1
NCRD=MMRT
GO TO 5002
5001 NCRD=1
FNC=NCELLS
5002 DO 5011 ICRD=1,NCRD
IF(MMRT)5006,5006,5003
5003 READ(5,5004)IAR,NCELLS,(BV(I),I=1,14)
5004 FORMAT(A6,I3,14F5.0)
IF(IAR.EQ.JOR.AND.NBV.GT.14)READ(5,5005)(BV(I),I=15,NBV)
5005 FORMAT(9X,14F5.0)
FNC=FNC+NCELLS
DO 5056 I=1,10
5056 FI(I)=BV(I)
5006 DO 4 LQ=1,NCELLS
IF(MMRT)5007,5007,5008
5007 READ(MT,F)(FI(I),I=1,NI),(X(I),I=M6,NVT)
GO TO 5009
5008 READ(MT,F)(X(I),I=M6,NVT)
WRITE(1)(BV(I),I=1,NBV)
5009 DO 801 I=M6,NVT
801 DA(I)=DA(I)+X(I)
IF(IAR.EQ.JOR)GO TO 5010
NBV=0
DO 1 I=1,NI
IF(FI(I)-FP(I))2,1,2
1 CONTINUE
GO TO 901
2 DO 5 I=1,NI
FP(I)=FI(I)
5 II(I)=FI(I)
5010 CALL GENVAR(X,JFA,NU,II,NBV,BV)
901 DO 4 I=1,NVT
DO 4 J=1,I
4 A(J,I)=A(J,I)+X(J)*X(I)
5011 CONTINUE
NCELLS=FNC
NCL=NCELLS
664 DO 44 I=1,NVT
X(I)=DA(I)/FNC
44 DA(I)=A(I,I)
REWIND 1
LPT=0
WRITE (6,89)
89 FORMAT(//24H REGRESSION COEFFICIENTS //)
IND(NVT)=1
LLH=0
TOL=1.E-13
DO 57 I=1,NFA
L1=LF1(I)
L2=LF2(I)
DO 58 J=1,NIVT
58 IND(J)=0
DO 59 J=L1,L2
59 IND(J)=-1
DO 60 J=2,NVT
J1=J-1
DO 61 K=1,J1
61 A(J,K)=A(K,J)
60 A(J,J)=DA(J)
A(1,1) = DA(1)
CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
CALL PT(A,LL,DAN(I),DAN1(I))
SS(I)=A(NVT,NVT)
57 DF(I)=ID
IF(NH)63,63,62
62 READ ( 5,23) (F(J),J=1,18)
WRITE(6,666)
666 FORMAT(39H0D-TYPE VARIABLE FORMAT CARD FOR HYPOTH)
WRITE(6,6666)(F(J),J=1,18)
6666 FORMAT(1X,18A4)
DO 65 I=1,NH
READ (5,66) PM,PM1,HLL,HLL1,LLH
66 FORMAT(A4,A2,A4,A2,I2)
IF(PM.NE.HYP) GO TO 719
L1=NVT+1
L2=NVT+LLH
DO 67 K=L1,L2
DO 667 J=1,K
667 A(K,J)=0.
67 READ ( 5,F) (A(K,J),J=1,NVT)
DO 68 J=1,L2
68 IND(J)=0
IND(NVT)=1
DO 80 J=2,NVT
J1=J-1
DO 81 K=1,J1
81 A(J,K)=A(K,J)
80 A(J,J)=DA(J)
A(1,1) = DA(1)
CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
MN=MN+1
IF(HLL-BBB)303,304,303
304 DAN(MN)=DN(MN)
DAN1(MN) = BBB
GO TO 305
303 DAN(MN)=HLL
DAN1(MN)=HLL1
305 CALL PT(A,LL,DAN(MN),DAN1(MN))
SS(MN)=A(NVT,NVT)
65 DF(MN)=ID
63 IF(NIV)306,306,307
307 NGV1=NGV+1
LLH=0
DO 310 I=NGV1,NIVT
310 IND(I)=-1
DO 311 I=1,NGV
311 IND(I)=0
DO 55 I=2,NVT
K1=I-1
DO 56 J=1,K1
56 A(I,J)=A(J,I)
55 A(I,I)=DA(I)
A(1,1) = DA(1)
CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
MN=MN+1
SS(MN)=A(NVT,NVT)
DF(MN)=ID
DAN(MN)=COV
DAN1(MN) = BBB
CALL PT(A,LL,DAN(MN),DAN1(MN))
306 DO 312 I=1,NIVT
312 IND(I)=0
DO 308 I=2,NVT
I1=I-1
DO 309 J=1,I1
309 A(I,J)=A(J,I)
308 A(I,I)=DA(I)
A(1,1) = DA(1)
LLH=0
CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
FID=ID
RSS=A(NVT,NVT)
CALL PT(A,LL,ANON,BBB)
CALL PT(A,LL,-1,0)
WRITE (6,314)
314 FORMAT(///15X,27H ANALYSIS OF VARIANCE TABLE //57H SOURCE SU
1M OF SQUARES D.F. MEAN SQUARE F//)
FDR=FLOAT(NCELLS)-FID
RMS=0.
IF(FDR.NE.0.)RMS=SNGL(RSS)/FDR
DO 315 I=1,MN
313 SS(I)=SS(I)-RSS
DF(I)=FID-DF(I)
ID=DF(I)
IF(ID)860,860,850
860 SS(I)=0.
SM=0.
FF=0.
GO TO 315
850 SM=SNGL(SS(I))/DF(I)
FF=0.
IF(RMS.NE.0.)FF=SM/RMS
315 WRITE(6,316) DAN(I),DAN1(I),SS(I),ID,SM,FF
316 FORMAT(1X,A4,A2,F17.5,I7,F14.5,F14.5)
IF(NIV)326,326,317
317 DO 318 I=NGV1,NIVT
ID=-I
CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
J=I-NGV
IF(ID)807,807,808
807 ST=0.
FF=0.
GO TO 318
808 ST=-A(NVT,I)*A(NVT,I)/A(I,I)
FF=ST/RMS
318 WRITE (6,319) J,ST,ID,ST,FF
319 FORMAT(5H COV.I2,F17.5,I7,F14.5,F14.5)
326 ID=FDR
WRITE (6,316)ERR,ERR1,RSS,ID,RMS
DO 729 I=1,NI
729 II(I)=1
1234 FORMAT(//)
IF(NBV) 783,783,751
751 WRITE (6,758)
758 FORMAT(35 H- CELL PREDICTED GENERATED/36H NUMBER VALU
1E VARIABLES //)
DO 752 J=1,NCL
READ(1)(BV(I),I=1,NBV)
CALL GENVAR(X,JFA,NU,II,NBV,BV)
TN=0.0
DO 753 I=1,NIVT
IX(I)=X(I)
753 TN=TN+A(NVT,I)*X(I)
752 WRITE (6,755) J,TN,(IX(I),I=1,NGV)
755 FORMAT(I4,F14.5,22I5/(18X,22I5))
RETURN
783 WRITE (6,DR)
WRITE (6,1234)
NBV=0
702 CALL GENVAR(X,JFA,NU,II,NBV,BV)
TN=0.
DO 703 I=1,NIVT
IX(I)=X(I)
703 TN=TN+A(NVT,I)*X(I)
WRITE (6,DS1) (II(I),I=1,NI),TN,(IX(I),I=1,NGV)
I=NI
717 II(I)=II(I)+1
IF(II(I)-NN(I))702,702,704
704 II(I)=1
I=I-1
IF(I)718,718,717
719 WRITE(6,720)
720 FORMAT(55H0HYPOTH IS PUNCHED WRONG OR HYPOTH CARD OUT OF SEQUENCE)
9876 FORMAT(10A8)
STOP
718 RETURN
END
SUBROUTINE SOLVIT(A,LL,N1,N2,T,IDF,IND)
DIMENSION A(LL,LL),U(100),V(100),IN(100),IND(2)
DOUBLE PRECISION A,U,V,G,H,X,T,T1
IF(IDF)20,30,30
20 I=-IDF
IF(IN(I))21,21,22
22 DO 23 J=1,N1
IF(IN(J))24,24,23
24 IF(I-J)26,26,25
25 T1=A(I,J)
GO TO 27
26 T1=A(J,I)
27 IF((A(J,J)-T1*T1/A(I,I))/V(I)-T)23,23,21
23 CONTINUE
IDF=1
RETURN
21 IDF=0
RETURN
30 MR=0
MI=0
N=N1+N2+1
L=N1+1
DO 1 I=1,N
V(I)=A(I,I)
1 IN(I)=IND(I)
2 L=L+1
IF(L-N)3,3,4
3 G=0.
DO 5 I=1,N1
IF(IN(I))5,6,5
6 H=DABS(A(I,I)/V(I)*A(L,I))
IF(H-G)5,5,7
7 G=H
K=I
5 CONTINUE
IF(G)2,2,9
9 NN=1
19 T1=G
MI=MI+1
IN(K)=1
10 DO 11 I=1,K
U(I)=A(K,I)
11 A(K,I)=0.
X=U(K)
DO 12 I=K,N
U(I)=A(I,K)
12 A(I,K)=0.
U(K)=-1.
DO 8 I=1,N
DO 8 J=1,I
8 A(I,J)=A(I,J)-U(I)*U(J)/X
IF(NN)14,2,13
13 NN=0
MR=MR+1
K=L
GO TO 10
4 NN=-1
14 G=T
DO 15 I=1,N1
IF(IN(I))15,16,15
16 H=A(I,I)/V(I)
IF(H-G)15,15,17
17 G=H
K=I
15 CONTINUE
IF(G-T)18,18,19
18 A(LL,LL)=T1
IDF=MI-MR
N11=N1+1
DO 31 I=1,N1
IF(IN(I))31,32,31
32 A(N11,I)=0.
31 CONTINUE
RETURN
END
SUBROUTINE PT(A,LL,MM,MM1)
COMMON LFB(9100)
COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
2 ,FA1(100),DAN1(100)
DIMENSION A(LL,LL),MMM(10),MMM1(10)
DOUBLE PRECISION A
IF(MM+1)2,1,2
2 LPT=LPT+1
L=LPT+NVT
MMM(LPT)=MM
MMM1(LPT) = MM1
DO 3 I=1,NIVT
IF(IND(I))11,10,11
11 A(I,L)=0.0
GO TO 3
10 A(I,L)= A(NVT,I)
3 CONTINUE
A(NVT,L)=A(LL,LL)
IF(LPT-10)4,1,1
1 WRITE(6,8) (MMM(I),MMM1(I),I=1,LPT)
8 FORMAT(/20X,10HHYPOTHESIS//5X,10(5X,A4,A2))
WRITE (6,9)
9 FORMAT(6H VAR.)
L1=NVT+1
L2=NVT+LPT
DO 5 I=1,NIVT
5 WRITE (6,6) I,(A(I,J),J=L1,L2)
6 FORMAT(I5,10F11.5)
WRITE (6,7) (A(NVT,J),J=L1,L2)
7 FORMAT(10H0TOLERANCE/(5X,10F11.5))
LPT=0
4 RETURN
END
SUBROUTINE GENVAR(X,JFA,NU,II,NBV,BV)
DIMENSION X(200),JFA(NU,NU),II(2),U(100),BV(2)
DOUBLE PRECISION X,U,Y,BV
COMMON LFB(9100)
COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
M=0
DO 30 L=1,NFA
LLL=0
M=M+1
X(M)=1.0
M0=M
DO 30 K=1,NI
LL=LLL
NNK=NN(K)
NNK1=NNK-1
IF(JFA(K,L))30,30,34
34 IF(NBV)1,1,2
2 DO 3 J=1,NNK1
LL=LL+1
3 U(J)=BV(LL)
GO TO 19
1 IF(II(K)-NN(K))16,15,222
222 WRITE (6,1111)
1111 FORMAT(19H0INDEX OUT OF RANGE)
CALL EXIT
22 FORMAT(11I3)
15 DO 17 J=1,NNK
17 U(J)=-1.0
GO TO 19
16 DO 18 J=1,NNK
18 U(J)=0.0
IIK=II(K)
U(IIK)=1.0
19 U(NNK)=1.0
JFAN=JFA(K,L)
MM=M-M0+1
DO 20 I=M0,M
N=I
Y=X(I)
DO 20 J=1,JFAN
X(N)=Y*U(J)
20 N=N+MM
M=N-MM
30 LLL=LLL+NNK1
RETURN
END