$EXECU IBJOB $IBJOB GO,MAP $IBFTC REGT REGT000! C REGRESSION ANALYSIS WITH TESTS REGT0010 C WRITTEN BY DR. F. GEBHARDT, DEUTSCHES RECHENZENTRUM REGT0020 C F.A.GRAYBILL, AN INTRODUCTION TO LINEAR STATISTICAL MODELS, REGT0030 C VOL. I, CHAPTER 6 REGT0040 REGT0050 COMMON A(100,100),C(100),CON(100),NUN(31),TX1(4), REGT0060 1 BEOB,FQS,IUNE,IV,LTAPE,MAX,MIN,NBEOB,NHYP,NORT,NV,SSERR,TMIN REGT0070 1 FORMAT(I2,I5,2I1,2I2,I1,4A6) REGT0080 2 FORMAT (13H0VARIBLE NO.,I3,20H WILL BE ELIMINATED. ) REGT0090 CALL DATV REGT0100 KTAPE = 3 REGT0110 C REGT0120 C READ PARAMETER CARD REGT0130 C REGT0140 100 READ (5, 1)NVAR,NBEOB,NORT,NFMT,MTAPE,NAUS,IBIN,TX1 REGT0150 BEOB = NBEOB REGT0160 LTAPE=0 REGT0170 IF(NORT.NE.0) LTAPE=KTAPE REGT0180 IF (NORT.NE.0) REWIND LTAPE REGT0190 102 NV = NVAR + 1 REGT0200 C REGT0210 C READ DATA REGT0220 C REGT0230 DO 103 I=1,NV REGT0240 DO 103 J=1,NV REGT0250 103 A(I,J) = 0.0 REGT0260 CALL KOVA (NVAR,NBEOB,C,A(1,NV),A,100,NFMT,MTAPE,IBIN,LTAPE,CON) REGT0270 DO 110 I=1,NVAR REGT0280 A(I,NV)=A(I,NV)*BEOB REGT0290 A(NV,I)=A(I,NV) REGT0300 DO 110 J=1,I REGT0310 A(I,J)=A(I,J)*(BEOB-1.) + A(I,NV)*A(J,NV)/BEOB REGT0320 110 A(J,I)=A(I,J) REGT0330 A(NV,NV)=BEOB REGT0340 IF (NORT.NE.0) REWIND LTAPE REGT0350 C REGT0360 DO 200 K=1,NAUS REGT0370 C REGT0380 C UNRESTRICTED HYPOTHESIS REGT0390 C REGT0400 CALL REGR (1,0,0) REGT0410 IF (NHYP) 170,200,120 REGT0420 C REGT0430 C RESTRICTED HYPOTHESIS REGT0440 C REGT0450 120 KHYP=NHYP REGT0460 DO 130 I=1,KHYP REGT0470 130 CALL REGR(2,I,0) REGT0480 GO TO 200 REGT0490 C REGT0500 C STEPWISE REGRESSION REGT0510 C REGT0520 170 IF (NORT.EQ.0 .OR. ABS( SSERR/FQS-1. ).LE..01) GO TO 180 REGT0530 IEL=NUN(MAX) REGT0540 IF (MAX.EQ.IV) GO TO 175 REGT0550 MAXP=MAX+1 REGT0560 DO 173 J=MAXP,IV REGT0570 173 NUN(J-1)=NUN(J) REGT0580 175 WRITE (6,2) IEL REGT0590 CALL REGR (4,0,0) REGT0600 IF (IUNE-1) 200,200,170 REGT0610 180 DO 190 J=2,IUNE REGT0620 IF( NHYP.EQ.-2.AND.TMIN.GT.2. .OR. NHYP.EQ.-3.AND.TMIN.GT.3.) REGT0630 1 GO TO 200 REGT0640 IEL=NUN(MIN) REGT0650 190 CALL REGR (3,J-1,IEL) REGT0660 200 CONTINUE REGT0670 GO TO 100 REGT0680 END REGT0690 $IBFTC DATV7 REGT0700 SUBROUTINE DATV REGT0710 C *** THIS SUBROUTINE MAY BE REPLACED BY THE USER BY A SUBROUTINE REGT0720 C *** TO MANIPULATE THE DATA ENTERING COMPUTATION. REGT0730 RETURN REGT0740 END REGT0750 $IBFTC ELIMI REGT0760 SUBROUTINE ELIM(NV,MIN,D,BETA,NUN) REGT0770 C SUBROUTINE TO ELIMINATE ONE ROW AND COLUMN FROM A MATRIX. REGT0780 C REGT0790 DIMENSION D(31,31),BETA(1),NUN(1) REGT0800 DO 10 I=1,NV REGT0810 10 BETA(I)=D(I,MIN) REGT0820 B=BETA(MIN) REGT0830 IF (NV.EQ.MIN) RETURN REGT0840 MINM=MIN-1 REGT0850 MINP=MIN+1 REGT0860 DO 30 I=MINP,NV REGT0870 NUN(I-1)=NUN(I) REGT0880 BETA(I-1)=BETA(I) REGT0890 DO 20 J=1,MINM REGT0900 D(I-1,J)=D(I,J) REGT0910 20 D(J,I-1)=D(J,I) REGT0920 DO 30 J=MINP,I REGT0930 D(I-1,J-1)=D(I,J) REGT0940 30 D(J-1,I-1)=D(J,I) REGT0950 BETA(NV)=B REGT0960 RETURN REGT0970 END REGT0980 $IBFTC 7KOVA REGT0990 SUBROUTINE KOVA (NV,NP,X,S,C,M,IFT,IT,IB,IZ,Y) REGT1000 C SUBROUTINE TO COMPUTE A COVARIANCE MATRIX. REGT1010 C THE FIRST PART OF THE DATA IS READ INTO THE MATRIX C TO COMPUTE REGT1020 C TEMPORARY MEANS,Y(I). USING THESE TEMPORARY MEANS IN COMPUTING REGT1030 C THE COVARIANCE MATRIX REDUCES ROUNDING ERRORS. REGT1040 C MEANING OF ARGUMENTS REGT1050 C NV = NUMBER OF VARIABLES REGT1060 C NP = NUMBER OF PROBANDS IFT = NUMBER OF FORMAT-CARDS REGT1070 C X = ERASABLE ARRAY, SIZE NV IT = TAPE NUMBER REGT1080 C S = MEAN VALUE IB BINARY DATA IF UNEQUAL 0 REGT1090 C C = COVARIANCE MATRIX IZ IF IZ.GT.0 WRITE DATA ON TAPE REGT1100 C M = DIMENSION OF C Y = ERASABLE ARRAY, SIZE NV REGT1110 C REGT1120 DIMENSION X(1),S(1),C(M,M),FT(108),Y(1) REGT1130 IF(IFT.EQ.0 .AND. IB.EQ.0) JFT=12 REGT1140 IF(IFT.GT.0 .AND. IB.EQ.0) JFT=12*IFT REGT1150 JT=5 REGT1160 IF(IT.GT.0) JT=IT REGT1170 IF(JFT.GT.0) READ (5,1) (FT(I),I=1,JFT) REGT1180 DO 20 I=1,NV REGT1190 20 S(I)=0. REGT1200 L=MIN0(M,NP) REGT1210 C REGT1220 C ** PROVISIONAL MEAN VALUES REGT1230 C REGT1240 DO 30 K=1,L REGT1250 IF(IB.EQ.0) READ (JT,FT) (C(K ,I),I=1,NV) REGT1260 IF(IB.NE.0) READ (JT) (C(K,I),I=1,NV) REGT1270 IF(IZ.GT.0) WRITE (IZ) (C(K,I),I=1,NV) REGT1280 DO 30 I=1,NV REGT1290 30 S(I)=S(I)+ C(K,I) REGT1300 AL=L REGT1310 DO 40 I=1,NV REGT1320 Y(I)=S(I)/AL REGT1330 40 S(I)=0 REGT1340 C REGT1350 C ** CROSS PRODUCTS FROM THE DATA STORED IN C REGT1360 C REGT1370 DO 70 I=1,NV REGT1380 DO 50 J=1,NV REGT1390 50 X(J)=0. REGT1400 DO 60 K=1,L REGT1410 S(I)=S(I) + (C(K,I)-Y(I)) REGT1420 DO 60 J=I,NV REGT1430 60 X(J)=X(J) + (C(K,I)-Y(I))*(C(K,J)-Y(J)) REGT1440 DO 70 J=1,NV REGT1450 70 C(J,I)=X(J) REGT1460 IF(L.EQ.NP) GO TO 85 REGT1470 MP=M+1 REGT1480 C REGT1490 C ** CROSS PRODUCT FROM REMAINING DATA REGT1500 C REGT1510 DO 80 K=MP,NP REGT1520 IF(IB.EQ.0) READ (JT,FT) (X(I),I=1,NV) REGT1530 IF(IB.NE.0) READ (JT) (X(I),I=1,NV) REGT1540 IF(IZ.GT.0) WRITE (IZ) (X(I),I=1,NV) REGT1550 DO 80 I=1,NV REGT1560 S(I)=S(I) + (X(I)-Y(I)) REGT1570 DO 80 J=I,NV REGT1580 80 C(J,I)=C(J,I) + (X(I)-Y(I))*(X(J)-Y(J)) REGT1590 C REGT1600 C ** COMPUTATION OF COVARIANCES REGT1610 C REGT1620 85 P=NP REGT1630 DO 90 I=1,NV REGT1640 S(I)=S(I)/P REGT1650 DO 90 J=1,I REGT1660 C(I,J)=(C(I,J)- P*S(I)*S(J))/(P-1.) REGT1670 90 C(J,I)=C(I,J) REGT1680 DO 100 I=1,NV REGT1690 100 S(I)=S(I)+Y(I) REGT1700 RETURN REGT1710 1 FORMAT (12A6) REGT1720 END REGT1730 $IBFTC 7MATIN REGT1740 SUBROUTINE MATIN (A,N,IN,V,U,M) REGT1750 C SUBROUTINE MATIN SEPTEMBER 1, 1967 REGT1760 C PROGRAM WRITTEN BY HEALTH SCIENCES REGT1770 C COMPUTING FACILITY, UCLA (BMD 04 V) REGT1780 C ALTERED (VARIABLE DIMENSION) BY DR. F. GEBHARDT REGT1790 C MATIN INVERTS AN N*N SYMETRIC MATRIX. REGT1800 C DETERMINANT WILL BE WRITTEN INTO V(1). REGT1810 C MEANING OF ARGUMENTS REGT1820 C A = MATRIX REGT1830 C N = NUMBER OF LINES OF THE MATRIX REGT1840 C IN,V,U = STORAGES ,SIZE N REGT1850 C M = DIMENSION OF A REGT1860 C REGT1870 DIMENSION A(M,M),IN(1),V(1),U(1) REGT1880 DO 1 I=1,N REGT1890 V(I)=A(I,I) REGT1900 1 IN(I)=0 REGT1910 D=1.0 REGT1920 K=1 REGT1930 DO 7 L=1,N REGT1940 DO 2 I=1,K REGT1950 U(I)=A(K,I) REGT1960 2 A(K,I)=0.0 REGT1970 P=U(K) REGT1980 DO 3 I=K,N REGT1990 U(I)=A(I,K) REGT2000 3 A(I,K)=0.0 REGT2010 T=H REGT2020 H=-1.E20 REGT2030 IN(K)=1 REGT2040 U(K)=-1.0 REGT2050 D=D*P REGT2060 DO 7 I=1,N REGT2070 Y=U(I)/P REGT2080 DO 4 J=1,I REGT2090 4 A(I,J)=A(I,J)-Y*U(J) REGT2100 IF(IN(I))5,5,7 REGT2110 5 IF(H-A(I,I)/V(I))6,7,7 REGT2120 6 H=A(I,I)/V(I) REGT2130 K=I REGT2140 7 CONTINUE REGT2150 DO 8 I=1,N REGT2160 DO 8 J=1,I REGT2170 A(I,J)=-A(I,J) REGT2180 8 A(J,I)=A(I,J) REGT2190 V(1)=D REGT2200 RETURN REGT2210 END REGT2220 $IBFTC NORMT REGT2230 SUBROUTINE NRMT(NV,NA,A,NRA,NB,B,NRB,NBEOB,C,NABH,KTAPE,S2) REGT2240 C TEST ON NORMALITY REGT2250 C WRITTEN BY DR. F. GEBHARDT, DEUTSCHES RECHENZENTRUM REGT2260 C F. GEBHARDT, VERTEILUNG UND SIGNIFIKANZ-SCHRANKEN DES REGT2270 C 3. UND 4. STICHPROBENMOMENTES BEI NORMALVERTEILTEN VARIABLEN, REGT2280 C BIOMETRISCHE ZEITSCHRIFT (1966) 8,219-241 REGT2290 C REGT2300 DIMENSION A(1),B(1),C(1),NRA(1),NRB(1) REGT2310 DIMENSION ZW(6),ZR(6), II(6),Q(4) REGT2320 DATA Q /1H ,6H NOT,6HWEAKLY,6HHIGHLY / REGT2330 C REGT2340 C * SUMS OF POWERS REGT2350 C REGT2360 S1 = 0.0 REGT2370 S2 = 0.0 REGT2380 S3 = 0.0 REGT2390 S4 = .0 REGT2400 NVAR=NV-1 REGT2410 C(NV)=1. REGT2420 DO 40 IJ =1,NBEOB REGT2430 READ (KTAPE) (C(I),I=1,NVAR) REGT2440 Y = C(NABH) REGT2450 IF(NA) 12,20,12 REGT2460 12 DO 15 I=1,NA REGT2470 IA = NRA(I) REGT2480 15 Y = Y - C(IA)*A(I) REGT2490 20 IF(NB) 25,30,25 REGT2500 25 DO 28 I =1,NB REGT2510 IA = NRB(I) REGT2520 28 Y = Y - C(IA)*B(I) REGT2530 30 S1 = S1 + Y REGT2540 S2 = S2 + Y**2 REGT2550 S3 = S3 + Y**3 REGT2560 40 S4 = S4 + Y**4 REGT2570 REWIND KTAPE REGT2580 C REGT2590 C * TEST STATISTICS REGT2600 C REGT2610 FN = NBEOB REGT2620 SM1 = S1 / FN REGT2630 SM2 = S2 / FN - SM1**2 REGT2640 SM3 = S3/FN - 3.0*S2*SM1/FN + 2.0*SM1**3 REGT2650 SM4 = S4/FN - 4.0*S3*SM1/FN + 6.0*S2*SM1**2/FN - 3.0*SM1**4 REGT2660 WRITE (6,2) S2 REGT2670 ST3 = SM3/SM2**1.5 * SQRT( ((FN + 4.0)*FN + 3.0)/(6.0*FN - 12.0) )REGT2680 ST4 = (SM4/SM2**2 -3.0+6.0/(FN + 1.0) ) * SQRT( ((FN + 8.0)*FN + 1REGT2690 15.0) / (((24.0*FN - 120.0)*FN + 144.0)*FN) ) * (FN + 1.0) REGT2700 U = ABS(ST3) REGT2710 Y=SQRT(1.0/FN) REGT2720 TX=Q(2) REGT2730 IF( AMIN1( ((-3.3646*Y+1.7309)*Y-.0797)*Y+1.9628 - U, ((-6.1463*Y-REGT2740 16.9178)*Y+4.4435)*Y+2.0056 - ST4, ((-12.6973*Y+17.6666)*Y-6.3611)*REGT2750 2Y+1.9508 + ST4) ) 53,60,60 REGT2760 53 TX=Q(3) REGT2770 IF (AMIN1( ((-11.5468*Y+3.6195)*Y+ .3909)*Y+2.3158 - U, ((-2.7158*REGT2780 1Y-21.4460)*Y+9.9154)*Y+2.3735 - ST4, ((-24.7735*Y+27.5382)*Y-9.029REGT2790 24)*Y+2.3133 + ST4) ) 54,60,60 REGT2800 54 TX=Q(1) REGT2810 IF (AMIN1( ((-26.8301*Y+6.6524)*Y+1.3764)*Y+2.7708 - U, ((8.4573*YREGT2820 1-53.6171)*Y+21.3461)*Y+2.7977 - ST4, ((-39.7062*Y+39.9197)*Y-12.52REGT2830 208)*Y+2.7815 + ST4) ) 55,60,60 REGT2840 55 TX=Q(4) REGT2850 60 WRITE (6,1) ST3,ST4,TX REGT2860 RETURN REGT2870 1 FORMAT (1H0/40H0TEST OF RESIDUES ON NORMAL DISTRIBUTION / REGT2880 2 49H TEST STATISTIC DERIVED FROM 4TH SAMPLE MOMENT = F8.3/ REGT2890 1 49H TEST STATISTIC DERIVED FROM 3RD SAMPLE MOMENT = F8.3/ REGT2900 2 10H0DEVIATION REGT2910 3 40H OF RESIDUES FROM NORMAL DISTRIBUTION IS ,A6,12H SIGNIFICANT )REGT2920 2 FORMAT (1H0//44H0SUM OF SQUARES ERROR + DIFFERENCE, CHECKSUM, REGT2930 1 1PE15.5) REGT2940 END REGT2950 $IBFTC REDU REGT2960 SUBROUTINE REDUX(D,B,M,N) REGT2970 C SUBROUTINE TO COMPUTE THE INVERSE OF A MATIX IF THE INVERSE OF REGT2980 C THE MATRIX BORDERED BY AN ADDITIONAL ROW AND COLUMN IS GIVEN. REGT2990 C REGT3000 DIMENSION D(M,M),B(1) REGT3010 R=1./B(N) REGT3020 L=N-1 REGT3030 DO 10 I=1,L REGT3040 DO 10 J=1,L REGT3050 10 D(I,J)= D(I,J) - B(I)*R*B(J) REGT3060 RETURN REGT3070 END REGT3080 $IBFTC REGRE REGT3090 SUBROUTINE REGR(ITYPE,K1,IEL) REGT3100 C REGRESSION SUBROUTINE FOR REGT. REGT3110 C WRITTEN BY DR. F. GEBHARDT, DEUTSCHES RECHENZENTRUM. REGT3120 COMMON A(100,100),C(100),CON(100),NUN(31),TX1(4), REGT3130 1 BEOB,FQS,IUNE,IV,LTAPE,MAX,MIN,NBEOB,NHYP,NORT,NV,SSERR,TMIN REGT3140 DIMENSION BETA(31),D(31,31),KONV(100),M(100),TX(4,2),Z(31) REGT3150 2 FORMAT(12A6) REGT3160 3 FORMAT(I2,3I1,34I2) REGT3170 4 FORMAT( 7(I2,F8.0) ) REGT3180 5 FORMAT(1H1,50X,19HREGRESSION ANALYSIS// REGT3190 1 24H DEUTSCHES RECHENZENTRUM,84X, 4A6/ REGT3200 2 10H DARMSTADT, 98X, 4A6 // REGT3210 3 24H UNRESTRICTED HYPOTHESIS / REGT3220 4 10X,18HDEPENDENT VARIABLE , I11/ REGT3230 5 10X,21HINDEPENDENT VARIABLES,4X,24I4/35X,6I4) REGT3240 6 FORMAT (30H0REGRESSION THROUGH THE ORIGIN ) REGT3250 7 FORMAT (41H0ABSOLUTE TERM IS SPECIFIED (VAR. NO. 0) ) REGT3260 8 FORMAT (37H0COEFFICIENTS SPECIFIED IN HYPOTHESIS / REGT3270 1 6(12H NO VALUE, 8X) / 6(I3, 1PE13.5, 4X) ) REGT3280 9 FORMAT (1H0/1H0/40X,31HINVERSE OF CROSS PRODUCT MATRIX //) REGT3290 10 FORMAT(I4, 1P 7E16.6 / (4X 7E16.6) ) REGT3300 11 FORMAT (1H0/ 23H0NUMBER OF OBSERVATIONS ,13X,I6/ REGT3310 1 21H TOTAL SUM OF SQUARES ,17X,1PE14.5,I8,5H D.F. ) REGT3320 12 FORMAT (21H ERROR SUM OF SQUARES, 17X,1PE14.5,I8,5H D.F. / REGT3330 1 18H MEAN SQUARE ERROR,15X E19.5 //) REGT3340 13 FORMAT (1H0/63H0VAR.NO. MEAN STAND.DEV. REGRESS. REGT3350 1STAND.DEV.OF6X,1HT,5X,4HD.F.,4X,25HPART. ERROR PROB. MULT. REGT3360 2 5X,5HCORR./25X,7HOF MEAN,8X,6HCOEFF.6X10HREG.COEFF.,21X, REGT3370 3 5HCORR., 3X, 9H(2-SIDED),3X,5HCORR.,5X,6HWITH Y //) REGT3380 14 FORMAT (I6,2F13.5,2F14.5, F12.3,I6,4F10.4 ) REGT3390 15 FORMAT ( 68H0SUBSTANTIAL DEVIATION OF THE ERROR SUM OF SQUARES FROREGT3400 1M THE CHECKSUM /70H PRESUMABLY INDICATES THAT THE COVARIANCE MATRIREGT3410 2X IS (NEARLY) SINGULAR. ) REGT3420 16 FORMAT(1H1,107X,4A6/ REGT3430 1 I5,24H. RESTRICTED HYPOTHESIS ,79X,4A6/ REGT3440 2 10X,18HDEPENDENT VARIABLE,I11,69X,4A6/ REGT3450 3 10X,21HINDEPENDENT VARIABLES,4X,24I4/35X,6I4) REGT3460 17 FORMAT (1H0/1H0/47H ANALYSIS OF VARIANCE FOR TESTING THE RESTRICTEREGT3470 113HD HYPOTHESIS // REGT3480 2 7H SOURCE,20X,10HSUM OF SQ.,4X,4HD.F.,4X,8HMEAN SQ.,6X,1HF// REGT3490 3 6H TOTAL,1PE32.5,I7,E14.5/ REGT3500 4 20H UNRESTR. HYPOTHESIS,1PE18.5, I7,E14.5/ REGT3510 5 20H RESTR. HYPOTHESIS 1PE18.5, I7,E14.5/ REGT3520 6 11H DIFFERENCE ,1PE 27.5,I7,E14.5,0PF10.3 / REGT3530 7 6H ERROR, 1PE32.5, I7, E14.5) REGT3540 18 FORMAT (14H NO REGRESSION ) REGT3550 19 FORMAT (1X,I5,26X,2F14.5,F12.3, I6,F20.4 ) REGT3560 20 FORMAT (38H MEAN VALUE OF THE DEPENDENT VARIABLE , 1PE14.5/ REGT3570 1 32H STANDARD-DEV. OF THE MEAN VALUE ,E20.5 ) REGT3580 21 FORMAT(1H0/1H0) REGT3590 22 FORMAT(21H MULTIPLE CORRELATION, 17X, F10.5/ REGT3600 1 36H SQUARE OF THE MULTIPLE CORRELATION F12.5,7X,2HF(,I2,1H,, REGT3610 2 I4,3H) =, F8.3) REGT3620 23 FORMAT (/72H THESE RESULTS REFER TO THE LINEAR COMBINATION OF THE REGT3630 1DEPENDENT VARIABLE/73H WITH THOSE VARIABLES WHOSE COEFFICIENTS AREREGT3640 2 SPECIFIED BY THE HYPOTHESIS. ) REGT3650 25 FORMAT (34H0STEPWISE REGRESSION. VARIABLE NO., I3, REGT3660 1 21H HAS BEEN ELIMINATED. ) REGT3670 26 FORMAT (54H0'MULT. CORR.' IS THE MULTIPLE CORRELATION BETWEEN THE/REGT3680 1 57H RESPECTIVE VARIABLE AND ALL OTHER INDEPENDENT VARIABLES.) REGT3690 DATA QHL /1H / REGT3700 ITYP=ITYPE REGT3710 DO 30 I=1,4 REGT3720 30 TX(I,2)=QHL REGT3730 ITP=0 REGT3740 IF (ITYP-3) 60,50,40 REGT3750 40 ITYP=1 REGT3760 IUNE=IUNE-1 REGT3770 ITP=1 REGT3780 ITY=2 REGT3790 GO TO 110 REGT3800 50 IUNE=IUNE-1 REGT3810 ITP=1 REGT3820 CALL ELIM (IV,MIN,D,BETA,NUN) REGT3830 ITY=2 REGT3840 IF( IUNE ) 123,122,123 REGT3850 C REGT3860 C * SELECTION CARD REGT3870 C REGT3880 60 READ (5,3) NHYP,ITX,INV,NULLP,KONS,KABH,IUNE,(NUN(I),I=1,IUNE) REGT3890 IF (ITYP-1) 90,70,90 REGT3900 70 NABH=KABH REGT3910 DO 80 I=1,4 REGT3920 80 TX(I,1)=QHL REGT3930 90 IF(ITX.NE.0) READ (5,2) (TX(I,ITYP), I=1,4) REGT3940 ITY=1 REGT3950 IF (ITYP.EQ.2) GO TO 123 REGT3960 110 WRITE (6,5) TX1,(TX(I,1),I=1,4),NABH,(NUN(I),I=1,IUNE) REGT3970 GO TO 125 REGT3980 122 WRITE (6,16) TX1,K1,(TX(I,1),I=1,4),NABH,(TX(I,2),I=1,4) REGT3990 GO TO 124 REGT4000 123 WRITE (6,16) TX1,K1,(TX(I,1),I=1,4),NABH,(TX(I,2),I=1,4), REGT4010 1 (NUN(I),I=1,IUNE) REGT4020 124 IF (ITYP.EQ.3) WRITE (6,25) IEL REGT4030 C REGT4040 C * SPECIFIED COEFFICIENTS REGT4050 C REGT4060 125 IF (KONS.EQ.0) GO TO 135 REGT4070 132 IF (ITP.EQ.0) READ (5,4) (KONV(I),CON(I), I=1,KONS) REGT4080 WRITE (6,8)(KONV(I),CON(I), I=1,KONS) REGT4090 IF(KONV(1)) 135,137,135 REGT4100 135 IF (NULLP) 136,145,136 REGT4110 136 WRITE (6,6) REGT4120 GO TO 140 REGT4130 137 WRITE (6,7) REGT4140 KONV(1) = NV REGT4150 140 IV = IUNE REGT4160 GO TO 150 REGT4170 145 IV = IUNE + 1 REGT4180 NUN(IV) = NV REGT4190 C REGT4200 C * CROSS PRODUCT MATRIX REGT4210 C REGT4220 150 IF(ITYP.EQ.3 .AND. NORT.NE.0 .AND. RUND.LT..001) GO TO 157 REGT4230 151 DO 155 I=1,IV REGT4240 IA = NUN(I) REGT4250 DO 155 J=1,IV REGT4260 JA = NUN(J) REGT4270 155 D(I,J) = A(IA,JA) REGT4280 CALL MATIN (D,IV,M,C,C(51),31) REGT4290 GO TO 160 REGT4300 157 CALL REDUX(D,BETA,31,IV+1) REGT4310 C REGT4320 C * WRITE INVERSE MATRIX REGT4330 C REGT4340 160 IF (INV) 1605,1615,1605 REGT4350 1605 WRITE (6,9) REGT4360 DO 161 I=1,IV REGT4370 NA = MOD(NUN(I),NV) REGT4380 161 WRITE (6,10)NA,(D(I,J), J=1,IV) REGT4390 C REGT4400 C * REGRESSION COEFFICIENTS REGT4410 C REGT4420 1615 DO 162 I=1,IV REGT4430 IA = NUN(I) REGT4440 162 Z(I) = A(IA,NABH) REGT4450 IF(KONS) 163,167,163 REGT4460 163 DO 165 I=1,IV REGT4470 IA = NUN(I) REGT4480 DO 165 J=1,KONS REGT4490 JA = KONV(J) REGT4500 165 Z(I) = Z(I) - A(IA,JA)*CON(J) REGT4510 167 DO 169 I=1,IV REGT4520 169 BETA(I) = 0.0 REGT4530 DO 170 J=1,IV REGT4540 DO 170 I=1,IV REGT4550 170 BETA(I) = BETA(I) + D(I,J)*Z(J) REGT4560 C REGT4570 C * SUM OF SQUARES REGT4580 C REGT4590 SS = A(NABH,NABH) REGT4600 IF(KONS) 175,182,175 REGT4610 175 DO 180 I=1,KONS REGT4620 IA = KONV(I) REGT4630 SS = SS - 2.0*A(NABH,IA)*CON(I) REGT4640 DO 180 J=1,KONS REGT4650 JA = KONV(J) REGT4660 180 SS = SS + CON(J)*A(JA,IA)*CON(I) REGT4670 182 SSERR = SS REGT4680 IF(IV) 184,192,184 REGT4690 184 DO 185 I=1,IV REGT4700 185 SSERR = SSERR - BETA(I)*Z(I) REGT4710 NFG = NBEOB - IV REGT4720 FG=NFG REGT4730 SSERRM = SSERR / FLOAT(NFG) REGT4740 C REGT4750 C * WRITE REGRESSION COEFFICIENTS REGT4760 C REGT4770 SSW = SQRT(SSERRM) REGT4780 WRITE (6,13) REGT4790 TMIN=1.E20 REGT4800 SMAX=0. REGT4810 CORY=A(NABH,NABH)*BEOB - A(NABH,NV)**2 REGT4820 DO 190 I=1,IV REGT4830 NA= MOD(NUN(I),NV) REGT4840 ERRB = SQRT( D(I,I) )*SSW REGT4850 T=BETA(I) / ERRB REGT4860 CALL TVRT(T,NFG,P) REGT4870 P=1.0- 2.0*ABS(.5-P) REGT4880 IF(NA) 186,189,186 REGT4890 186 XQ=A(NA,NV)/BEOB REGT4900 STXQ=SQRT((A(NA,NA)/BEOB-XQ**2)/(BEOB-1.0) ) REGT4910 RM=0. REGT4920 IF (IUNE.LE.1 .OR. IV.EQ.IUNE) GO TO 1865 REGT4930 RM= SQRT( 1. - 1./(D(I,I)*STXQ**2*(BEOB-1.)*BEOB) ) REGT4940 1865 RPART = T/SQRT(FG+T**2) REGT4950 CORR = (A(NA,NABH)*BEOB - A(NA,NV)*A(NABH,NV)) / REGT4960 1 SQRT( (A(NA,NA)*BEOB - A(NA,NV)**2) * CORY ) REGT4970 WRITE (6,14) NA,XQ,STXQ, BETA(I),ERRB,T,NFG, RPART,P,RM,CORR REGT4980 IF (IV.EQ.IUNE) RM=A(NA,NA)*D(I,I) REGT4990 IF (ABS(T).GE.TMIN) GO TO 187 REGT5000 TMIN=ABS(T) REGT5010 MIN=I REGT5020 187 IF (RM .LT. SMAX) GO TO 190 REGT5030 SMAX=RM REGT5040 MAX=I REGT5050 GO TO 190 REGT5060 189 WRITE (6,19)NA,BETA(I),ERRB,T,NFG,P REGT5070 190 CONTINUE REGT5080 WRITE (6,26) REGT5090 C REGT5100 C * WRITE SUMS OF SQUARES REGT5110 C REGT5120 192 SSM = SS/FLOAT(NBEOB) REGT5130 SSH=SS-SSERR REGT5140 SSHM=SSH / FLOAT(IV) REGT5150 IF (IV.EQ.0) SSHM=0. REGT5160 YQ=A(NABH,NV) REGT5170 IF(KONS) 1900,1902,1900 REGT5180 1900 DO 1901 I=1,KONS REGT5190 IA=KONV(I) REGT5200 1901 YQ=YQ-CON(I)*A(IA,NV) REGT5210 1902 YQ=YQ/BEOB REGT5220 SSY=(SS/BEOB-YQ**2)/(BEOB-1.0) REGT5230 SSYSQ=SQRT(SSY) REGT5240 IF(IV-IUNE) 1903,1904,1903 REGT5250 1903 CMULTQ=1.0-SSERR/(SS-YQ**2*BEOB) REGT5260 CMULT=SIGN(SQRT(ABS(CMULTQ)),CMULTQ) REGT5270 F=(SS-YQ**2*BEOB-SSERR)*FLOAT(NFG) / (SSERR*FLOAT(IUNE)) REGT5280 1904 IF (ITYP-2) 200,230,230 REGT5290 200 WRITE (6,11) NBEOB,SS,NBEOB REGT5300 WRITE (6,12) SSERR,NFG,SSERRM REGT5310 WRITE (6,20) YQ,SSYSQ REGT5320 IF(KONS.NE.0) WRITE (6,23) REGT5330 IF (IV.NE.IUNE) WRITE (6,22) CMULT,CMULTQ,IUNE,NFG,F REGT5340 SSERRU=SSERR REGT5350 SSERUM=SSERRM REGT5360 NFGU=NFG REGT5370 IVU=IV REGT5380 GO TO 250 REGT5390 230 SSU=SS-SSERRU REGT5400 SSUM = SSU / FLOAT(IVU) REGT5410 SSD = SSU - SSH REGT5420 NFGD= IVU - IV REGT5430 SSDM= SSD / FLOAT(NFGD) REGT5440 FD=SSDM / SSERUM REGT5450 WRITE (6,21) REGT5460 WRITE (6,20)YQ,SSYSQ REGT5470 IF (IV.NE.IUNE) WRITE (6,22) CMULT,CMULTQ,IUNE,NFG,F REGT5480 WRITE (6,17) SS,NBEOB,SSM, SSU,IVU,SSUM, SSH,IV,SSHM, REGT5490 1 SSD,NFGD,SSDM,FD, SSERRU,NFGU,SSERUM REGT5500 IF (KONS.NE.0) WRITE (6,23) REGT5510 250 IF (NORT.EQ.0) RETURN REGT5520 CALL NRMT(NV,IV,BETA,NUN,KONS,CON,KONV,NBEOB,C, REGT5530 1 NABH,LTAPE,FQS) REGT5540 RUND=ABS(1.-SSERR/FQS) REGT5550 IF(RUND.GE..01) WRITE (6,15) REGT5560 RETURN REGT5570 END REGT5580 $IBFTC 7TVRT REGT5590 SUBROUTINE TVRT(T,N,P) REGT5600 C TVRT COMPUTES THE PROBABILITY P THAT A RANDOM VARIABLE DISTRIBUTEDREGT5610 C LIKE STUDENT'S T WITH N DEGREES OF FREEDOM IS LESS THAN T. REGT5620 C WRITTEN BY DR. F. GEBHARDT, DEUTSCHES RECHENZENTRUM. REGT5630 C REGT5640 APROX(Q )=1.0+ 1.0/(12.0*Q ) + 1.0/(288.0*Q **2) - .00REGT5650 12681/Q **3 REGT5660 IF (N) 4,4,5 REGT5670 4 P=.5 REGT5680 GO TO 80 REGT5690 5 AN=N REGT5700 RN=1.0/AN REGT5710 QN=SQRT(AN) REGT5720 IF(N-15) 10,30,30 REGT5730 10 K=100 REGT5740 X=ABS(T)+10.0 REGT5750 IF(N-6) 15,15,20 REGT5760 15 P= (QN/X)**N /QN REGT5770 GO TO 40 REGT5780 30 X=ABS(T)+6.0 REGT5790 K=60 REGT5800 20 P=0.0 REGT5810 40 EN= -(AN+1.0)*.5 REGT5820 S = (1.0+X**2*RN)**EN*.5 REGT5830 DO 50 I=1,K REGT5840 S=S+ 2.0* (1.0+(X-.05)**2*RN)**EN REGT5850 X=X-.1 REGT5860 SN= (1.0+X**2*RN)**EN REGT5870 50 S=S+SN REGT5880 P= (S- SN*.5)/30.0+P REGT5890 IF(N-4) 55,65,65 REGT5900 55 IF(N-2) 60,61,62 REGT5910 60 PR=.31830989 REGT5920 GOTO 68 REGT5930 61 PR=.35355339 REGT5940 GO TO 68 REGT5950 62 PR=.36755260 REGT5960 GO TO 68 REGT5970 65 PR=.564190*((AN-1.0)/(AN-2.0))**((AN-1.0)*.5) * SQRT(RN*(AN-1.0) /REGT5980 15.4365637) * APROX((AN-1.0)*.5) / APROX(AN*.5-1.0) REGT5990 68 P=P*PR REGT6000 IF(T) 80,70,75 REGT6010 70 P=.5 REGT6020 GO TO 80 REGT6030 75 P=1.0-P REGT6040 80 RETURN REGT6050 END REGT6060 $DATA $BLOCK BCD,0084 9 101 2 TEST DATA FOR ZF REGT (9F5.1) 1 17 11 8 50 8 29 15 33 2 11 9 2 44 111 22 27 34 3 2 14 4 61 33 12 12 9 4 22 21 22 42 144 53 8 51 5 14 16 10 57 19 40 22 91 6 23 15 10 39 83 36 22 144 7 3 20 15 77 84 23 8 34 8 16 27 31 55 110 35 177 156 9 21 22 21 40 7 44 178 199 10 9 25 29 77 7 29 5 91 -31 2 6 4 7 9 1 5 8 STEPWISE REGRESSION 21 1 5 5 4 7 8 9 SECOND GROUP OF TESTS 111 1 2 7 8 FIRST RESTRICTED HYPOTH. 4 0.15 1 2 5 9 SECOND RESTR. HYPOTHESIS ~ $IBSYS $STOP