C REGR 10
C ..................................................................REGR 20
C REGR 30
C SAMPLE MAIN PROGRAM FOR MULTIPLE REGRESSION - REGRE REGR 40
C REGR 50
C PURPOSE REGR 60
C (1) READ THE PROBLEM PARAMETER CARD FOR A MULTIPLE REGRES- REGR 70
C SION, (2) READ SUBSET SELECTION CARDS, (3) CALL THE SUB- REGR 80
C ROUTINES TO CALCULATE MEANS, STANDARD DEVIATIONS, SIMPLE REGR 90
C AND MULTIPLE CORRELATION COEFFICIENTS, REGRESSION COEFFI- REGR 100
C CIENTS, T-VALUES, AND ANALYSIS OF VARIANCE FOR MULTIPLE REGR 110
C REGRESSION, AND (4) PRINT THE RESULTS. REGR 120
C REGR 130
C REMARKS REGR 140
C THE NUMBER OF OBSERVATIONS, N, MUST BE GREATER THAN M+1, REGR 150
C WHERE M IS THE NUMBER OF VARIABLES. IF SUBSET SELECTION REGR 160
C CARDS ARE NOT PRESENT, THE PROGRAM CAN NOT PERFORM MULTIPLE REGR 170
C REGRESSION. REGR 180
C AFTER RETURNING FROM SUBROUTINE MINV, THE VALUE OF DETER- REGR 190
C MINANT (DET) IS TESTED TO CHECK WHETHER THE CORRELATION REGR 200
C MATRIX IS SINGULAR. IF DET IS COMPARED AGAINST A SMALL REGR 210
C CONSTANT, THIS TEST MAY ALSO BE USED TO CHECK NEAR- REGR 220
C SINGULARITY. REGR 230
C REGR 240
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED REGR 250
C CORRE (WHICH, IN TURN, CALLS THE SUBROUTINE NAMED DATA) REGR 260
C ORDER REGR 270
C MINV REGR 280
C MULTR REGR 290
C REGR 300
C METHOD REGR 310
C REFER TO B. OSTLE, 'STATISTICS IN RESEARCH', THE IOWA STATE REGR 320
C COLLEGE PRESS', 1954, CHAPTER 8. REGR 330
C REGR 340
C ..................................................................REGR 350
C REGR 360
C THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE REGR 370
C NUMBER OF VARIABLES, M.. REGR 380
C REGR 390
DIMENSION XBAR(40),STD(40),D(40),RY(40),ISAVE(40),B(40), REGR 400
1 SB(40),T(40),W(40) REGR 410
C REGR 420
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE REGR 430
C PRODUCT OF M*M.. REGR 440
C REGR 450
DIMENSION RX(1600) REGR 460
C REGR 470
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO REGR 480
C (M+1)*M/2.. REGR 490
C REGR 500
DIMENSION R(820) REGR 510
C REGR 520
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO 10.. REGR 530
C REGR 540
DIMENSION ANS(10) REGR 550
C REGR 560
C ..................................................................REGR 570
C REGR 580
C IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE REGR 590
C C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION REGR 600
C STATEMENT WHICH FOLLOWS. REGR 610
C REGR 620
C DOUBLE PRECISION XBAR,STD,RX,R,D,B,T,RY,DET,SB,ANS,SUM REGR 630
C REGR 640
C THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS REGR 650
C APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS REGR 660
C ROUTINE. REGR 670
C REGR 680
C ...............................................................REGR 690
C REGR 700
1 FORMAT(A4,A2,I5,2I2) REGR 710
2 FORMAT(25H1MULTIPLE REGRESSION.....A4,A2//6X,14HSELECTION.....I2//REGR 720
1) REGR 730
3 FORMAT(9H0VARIABLE,5X,4HMEAN,6X,8HSTANDARD,6X,11HCORRELATION,4X, REGR 740
110HREGRESSION,4X,10HSTD. ERROR,5X,8HCOMPUTED/6H NO.,18X,9HDEVIATREGR 750
2ION,7X,6HX VS Y,7X,11HCOEFFICIENT,3X,12HOF REG.COEF.,3X,7HT VALUE)REGR 760
4 FORMAT(1H ,I4,6F14.5) REGR 770
5 FORMAT(10H DEPENDENT) REGR 780
6 FORMAT(1H0/10H INTERCEPT,10X,F16.5//23H MULTIPLE CORRELATION ,F13REGR 790
1.5//23H STD. ERROR OF ESTIMATE,F13.5//) REGR 800
7 FORMAT(1H0,21X,39HANALYSIS OF VARIANCE FOR THE REGRESSION//5X,19HSREGR 810
1OURCE OF VARIATION,7X,7HDEGREES,7X,6HSUM OF,10X,4HMEAN,12X,7HF VALREGR 820
2UE/30X,10HOF FREEDOM,4X,7HSQUARES,9X,7HSQUARES) REGR 830
8 FORMAT(30H ATTRIBUTABLE TO REGRESSION ,I6,3F16.5/30H DEVIATION FREGR 840
1ROM REGRESSION ,I6,2F16.5) REGR 850
9 FORMAT(1H ,5X,5HTOTAL,19X,I6,F16.5) REGR 860
10 FORMAT(36I2) REGR 870
11 FORMAT(1H ,15X,18HTABLE OF RESIDUALS//9H CASE NO.,5X,7HY VALUE,5X,REGR 880
110HY ESTIMATE,6X,8HRESIDUAL) REGR 890
12 FORMAT(1H ,I6,F15.5,2F14.5) REGR 900
13 FORMAT(53H1NUMBER OF SELECTIONS NOT SPECIFIED. JOB TERMINATED.) REGR 910
14 FORMAT(52H0THE MATRIX IS SINGULAR. THIS SELECTION IS SKIPPED.) REGR 920
C REGR 930
C ..................................................................REGR 940
C REGR 950
C READ PROBLEM PARAMETER CARD REGR 960
C REGR 970
100 READ (5,1,END=999) PR,PR1,N,M,NS REGR 980
C PR........PROBLEM NUMBER (MAY BE ALPHAMERIC) REGR 990
C PR1.......PROBLEM NUMBER (CONTINUED) REGR1000
C N.........NUMBER OF OBSERVATIONS REGR1010
C M.........NUMBER OF VARIABLES REGR1020
C NS........NUMBER OF SELECTIONS REGR1030
C REGR1040
C LOGICAL TAPE 13 IS USED AS INTERMEDIATE STORAGE TO HOLD INPUT REGR1050
C DATA. THE INPUT DATA ARE WRITTEN ON LOGICAL TAPE 13 BY THE REGR1060
C SPECIAL INPUT SUBROUTINE NAMED DATA. THE STORED DATA MAY BE USED REGR1070
C FOR RESIDUAL ANALYSIS. REGR1080
C REGR1090
REWIND 13 REGR1100
C REGR1110
IO=0 REGR1120
X=0.0 REGR1130
C REGR1140
CALL CORRE (N,M,IO,X,XBAR,STD,RX,R,D,B,T) REGR1150
C REGR1160
REWIND 13 REGR1170
C REGR1180
C TEST NUMBER OF SELECTIONS REGR1190
C REGR1200
IF(NS) 108, 108, 109 REGR1210
108 WRITE (6,13) REGR1220
GO TO 300 REGR1230
C REGR1240
109 DO 200 I=1,NS REGR1250
WRITE (6,2) PR,PR1,I REGR1260
C REGR1270
C READ SUBSET SELECTION CARD REGR1280
C REGR1290
READ (5,10) NRESI,NDEP,K,(ISAVE(J),J=1,K) REGR1300
C NRESI.....OPTION CODE FOR TABLE OF RESIDUALS REGR1310
C 0 IF IT IS NOT DESIRED. REGR1320
C 1 IF IT IS DESIRED. REGR1330
C NDEP......DEPENDENT VARIABLE REGR1340
C K.........NUMBER OF INDEPENDENT VARIABLES INCLUDED REGR1350
C ISAVE.....A VECTOR CONTAINING THE INDEPENDENT VARIABLES REGR1360
C INCLUDED REGR1370
C REGR1380
CALL ORDER (M,R,NDEP,K,ISAVE,RX,RY) REGR1390
C REGR1400
CALL MINV (RX,K,DET,B,T) REGR1410
C REGR1420
C TEST SINGULARITY OF THE MATRIX INVERTED REGR1430
C REGR1440
IF(DET) 112, 110, 112 REGR1450
110 WRITE (6,14) REGR1460
GO TO 200 REGR1470
C REGR1480
112 CALL MULTR (N,K,XBAR,STD,D,RX,RY,ISAVE,B,SB,T,ANS) REGR1490
C REGR1500
C PRINT MEANS, STANDARD DEVIATIONS, INTERCORRELATIONS BETWEEN REGR1510
C X AND Y, REGRESSION COEFFICIENTS, STANDARD DEVIATIONS OF REGR1520
C REGRESSION COEFFICIENTS, AND COMPUTED T-VALUES REGR1530
C REGR1540
MM=K+1 REGR1550
WRITE (6,3) REGR1560
DO 115 J=1,K REGR1570
L=ISAVE(J) REGR1580
115 WRITE (6,4) L,XBAR(L),STD(L),RY(J),B(J),SB(J),T(J) REGR1590
WRITE (6,5) REGR1600
L=ISAVE(MM) REGR1610
WRITE (6,4) L,XBAR(L),STD(L) REGR1620
C REGR1630
C PRINT INTERCEPT, MULTIPLE CORRELATION COEFFICIENT, AND STANDARD REGR1640
C ERROR OF ESTIMATE REGR1650
C REGR1660
WRITE (6,6) ANS(1),ANS(2),ANS(3) REGR1670
C REGR1680
C PRINT ANALYSIS OF VARIANCE FOR THE REGRESSION REGR1690
C REGR1700
WRITE (6,7) REGR1710
L=ANS(8) REGR1720
WRITE (6,8) K,ANS(4),ANS(6),ANS(10),L,ANS(7),ANS(9) REGR1730
L=N-1 REGR1740
SUM=ANS(4)+ANS(7) REGR1750
WRITE (6,9) L,SUM REGR1760
IF(NRESI) 200, 200, 120 REGR1770
C REGR1780
C PRINT TABLE OF RESIDUALS REGR1790
C REGR1800
120 WRITE (6,2) PR,PR1,I REGR1810
WRITE (6,11) REGR1820
MM=ISAVE(K+1) REGR1830
DO 140 II=1,N REGR1840
READ (13) (W(J),J=1,M) REGR1850
SUM=ANS(1) REGR1860
DO 130 J=1,K REGR1870
L=ISAVE(J) REGR1880
130 SUM=SUM+W(L)*B(J) REGR1890
RESI=W(MM)-SUM REGR1900
140 WRITE (6,12) II,W(MM),SUM,RESI REGR1910
REWIND 13 REGR1920
200 CONTINUE REGR1930
GO TO 100 REGR1940
300 CONTINUE REGR1950
999 STOP
END REGR1960