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