Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0026/stepr.smp
There are 2 other files named stepr.smp in the archive. Click here to see a list.
C STEP 10
C ..................................................................STEP 20
C STEP 30
C SAMPLE MAIN PROGRAM FOR STEP-WISE MULTIPLE REGRESSION - STEPR STEP 40
C STEP 50
C PURPOSE STEP 60
C (1) READ THE PROBLEM PARAMETER CARD FOR A STEP-WISE MULTIPLESTEP 70
C REGRESSION, (2) READ SUBSET SELECTION CARDS, (3) CALL THE STEP 80
C SUBROUTINE TO CALCULATE MEANS, STANDARD DEVIATIONS, SIMPLE STEP 90
C CORRELATION COEFFICIENTS, AND (4) CALL THE SUBROUTINE TO STEP 100
C PERFORM EACH STEP OF REGRESSION ANALYSIS. STEP 110
C STEP 120
C REMARKS STEP 130
C THE NUMBER OF OBSERVATIONS, N, MUST BE GREATER THAN M+2, STEP 140
C WHERE M IS THE NUMBER OF VARIABLES. IF SELECTION CARDS ARE STEP 150
C NOT PRESENT, THIS PROGRAM CAN NOT PERFORM STEP-WISE MULTIPLESTEP 160
C REGRESSION. STEP 170
C STEP 180
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED STEP 190
C CORRE (WHICH, IN TURN, CALLS THE SUBROUTINE DATA) STEP 200
C MSTR (WHICH, IN TURN, CALLS THE SUBROUTINE LOC) STEP 210
C STPRG (WHICH, IN TURN, CALLS THE SUBROUTINE STOUT) STEP 220
C STEP 230
C METHOD STEP 240
C REFER TO C. A. BENNETT AND N. L. FRANKLIN, 'STATISTICAL STEP 250
C ANALYSIS IN CHEMISTRY AND THE CHEMICAL INDUSTRY', JOHN WILEYSTEP 260
C AND SONS, 1954, APPENDIX 6A. STEP 270
C STEP 280
C ..................................................................STEP 290
C STEP 300
C THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE STEP 310
C NUMBER OF VARIABLES, M.. STEP 320
C STEP 330
DIMENSION XBAR(35),STD(35),D(35),B(35),T(35),IDX(35),L(35) STEP 340
C STEP 350
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE STEP 360
C PRODUCT OF M*M.. STEP 370
C STEP 380
DIMENSION RX(1225) STEP 390
C STEP 400
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE STEP 410
C (M+1)*M/2.. STEP 420
C STEP 430
DIMENSION R(630) STEP 440
C STEP 450
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO 5.. STEP 460
C STEP 470
DIMENSION NSTEP(5) STEP 480
C STEP 490
C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO 11.. STEP 500
C STEP 510
DIMENSION ANS(11) STEP 520
C STEP 530
C ..................................................................STEP 540
C STEP 550
C IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE STEP 560
C C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION STEP 570
C STATEMENT WHICH FOLLOWS. STEP 580
C STEP 590
C DOUBLE PRECISION XBAR,STD,RX,R,B,T,ANS,YEST STEP 600
C STEP 610
C THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS STEP 620
C APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS STEP 630
C ROUTINE. STEP 640
C STEP 650
C ..................................................................STEP 660
C STEP 670
1 FORMAT(A4,A2,I5,2I2,F6.0,I1) STEP 680
2 FORMAT(53H0NUMBER OF SELECTIONS NOT SPECIFIED. JOB TERMINATED.) STEP 690
3 FORMAT(35H1STEP-WISE MULTIPLE REGRESSION.....A4,A2) STEP 700
4 FORMAT(31H0VARIABLE MEAN STANDARD/4X,3HN0.16X,9HDEVIATION)STEP 710
5 FORMAT(4X,I2,F14.5,F12.5) STEP 720
6 FORMAT(19H1CORRELATION MATRIX) STEP 730
7 FORMAT(4H0ROWI3/(10F12.5)) STEP 740
8 FORMAT(72I1) STEP 750
9 FORMAT(23H0NUMBER OF OBSERVATIONSI5) STEP 760
10 FORMAT(20H NUMBER OF VARIABLES3X,I5) STEP 770
11 FORMAT(21H NUMBER OF SELECTIONS2X,I5) STEP 780
12 FORMAT(28H0CONSTANT TO LIMIT VARIABLESF9.5) STEP 790
13 FORMAT(/15H1SELECTION.....I2) STEP 800
14 FORMAT(16X,18HTABLE OF RESIDUALS//9H CASE NO.5X,7HY VALUE5X,10HY ESTEP 810
1STIMATE6X,8HRESIDUAL) STEP 820
15 FORMAT(I7,F15.5,2F14.5) STEP 830
16 FORMAT(1H ) STEP 840
17 FORMAT(1H1) STEP 850
18 FORMAT(1H0,'****COLUMN',I4,' OF SELECTION CARD',I5,' IS IN ERROR. STEP 860
1 IT IS POSSIBLE THAT COLUMNS SUCCEEDING THAT COLUMN ARE ALSO' STEP 870
2/' INCORRECT. THE SELECTION IS IGNORED.****') STEP 880
19 FORMAT(1H0,'****SELECTION CARD',I5,' DOES NOT NAME ONE AND ONLY ONSTEP 890
1E DEPENDENT VARIABLE. SELECTION IGNORED.****') STEP 900
20 FORMAT(1H0,'****EITHER THE MATRIX IS SINGULAR, OR THE RESIDUAL SUMSTEP 910
1 OF SQUARES IS NEGATIVE IMPLYING EXTREME ILL CONDITION.',/,' SELECSTEP 920
2TION IGNORED.****') STEP 930
21 FORMAT(1H0,'****',I6,' OBSERVATIONS ARE TOO FEW TO ALLOW PARAMETERSTEP 940
1 ESTIMATION FOR',I5,' VARIABLES. JOB TERMINATED.****') STEP 950
C STEP 960
C READ PROBLEM PARAMETER CARD STEP 970
C STEP 980
100 READ (5,1,END=999) PR1,PR2,N,M,NS,PCT,NR STEP 990
C PR1.....PROBLEM CODE (MAY BE ALPHAMERIC) STEP1000
C PR2.....PROBLEM CODE (CONTINUED) STEP1010
C N ......NUMBER OF OBSERVATIONS STEP1020
C M ......NUMBER OF VARIABLES STEP1030
C NS......NUMBER OF SELECTIONS STEP1040
C PCT.....A CONSTANT VALUE OF PROPORTION OF SUM OF SQUARES THAT STEP1050
C WILL BE USED TO LIMIT VARIABLES ENTERING IN THE REGRES-STEP1060
C SION STEP1070
C NR......OPTION CODE FOR TABLE OF RESIDUALS STEP1080
C 0 - IF IT IS NOT DESIRED STEP1090
C 1 - IF IT IS DESIRED STEP1100
C STEP1110
WRITE (6,3) PR1,PR2 STEP1120
WRITE (6,9) N STEP1130
WRITE (6,10) M STEP1140
IF(N-M-2) 101,101,102 STEP1150
101 WRITE(6,21) N,M STEP1160
STOP STEP1170
102 WRITE (6,11) NS STEP1180
WRITE (6,12) PCT STEP1190
C STEP1200
C LOGICAL TAPE 13 IS USED AS INTERMEDIATE STORAGE TO HOLD INPUT STEP1210
C DATA. THE INPUT DATA ARE WRITTEN ON LOGICAL TAPE 13 BY THE STEP1220
C SPECIAL INPUT SUBROUTINE NAMED DATA. THE STORED DATA MAY BE USED STEP1230
C FOR RESIDUAL ANALYSIS. STEP1240
C STEP1250
REWIND 13 STEP1260
C STEP1270
IO=0 STEP1280
X=0.0 STEP1290
C STEP1300
CALL CORRE (N,M,IO,X,XBAR,STD,RX,R,B,D,T) STEP1310
C STEP1320
REWIND 13 STEP1330
C STEP1340
C PRINT MEANS AND STANDARD DEVIATION STEP1350
C STEP1360
WRITE (6,4) STEP1370
DO 105 I=1,M STEP1380
105 WRITE (6,5) I,XBAR(I),STD(I) STEP1390
C STEP1400
C PRINT CORRELATION MATRIX STEP1410
C STEP1420
WRITE (6,6) STEP1430
DO 130 I=1,M STEP1440
DO 125 J=1,M STEP1450
IF(I-J) 110, 120, 120 STEP1460
110 K=I+(J*J-J)/2 STEP1470
GO TO 125 STEP1480
120 K=J+(I*I-I)/2 STEP1490
125 T(J)=R(K) STEP1500
130 WRITE (6,7) I,(T(J),J=1,M) STEP1510
C STEP1520
C TEST NUMBER OF SELECTIONS STEP1530
C STEP1540
IF(NS) 135, 135, 140 STEP1550
135 WRITE (6,2) STEP1560
GO TO 200 STEP1570
C STEP1580
C SAVE THE MATRIX OF SUMS OF CROSS-PRODUCTS OF DEVIATIONS STEP1590
C STEP1600
140 CALL MSTR (RX,R,M,0,1) STEP1610
C STEP1620
NSEL=1 STEP1630
GO TO 150 STEP1640
C STEP1650
C COPY THE MATRIX OF SUMS OF CROSS-PRODUCTS OF DEVIATIONS STEP1660
C STEP1670
145 CALL MSTR (R,RX,M,1,0) STEP1680
C STEP1690
C READ A SELECTION CARD STEP1700
C STEP1710
150 WRITE (6,13) NSEL STEP1720
READ (5,8) (IDX(J),J=1,M) STEP1730
C STEP1740
C IN EACH POSITION OF IDX, ONE OF THE FOLLOWING CODES MUST BE STEP1750
C SPECIFIED.. STEP1760
C 0 OR BLANK - INDEPENDENT VARIABLE AVAILABLE FOR SELECTION STEP1770
C 1 - INDEPENDENT VARIABLE TO BE FORCED IN REGRESSION STEP1780
C 2 - VARIABLE TO BE DELETED STEP1790
C 3 - DEPENDENT VARIABLE STEP1800
C STEP1810
N35=0 STEP1820
DO 155 K=1,M STEP1830
IF (IDX(K)) 152,153,153 STEP1840
152 WRITE (6,18) K,NSEL STEP1850
GO TO 185 STEP1860
153 IF (IDX(K)-3) 155,154,152 STEP1870
154 N35=N35+1 STEP1880
155 CONTINUE STEP1890
IF (N35-1) 156,157,156 STEP1900
156 WRITE (6,19) NSEL STEP1910
GO TO 185 STEP1920
C CALL THE SUBROUTINE TO PERFORM A STEP-WISE REGRESSION ANALYSIS STEP1930
C STEP1940
157 CALL STPRG (M,N,RX,XBAR,IDX,PCT,NSTEP,ANS,L,B,STD,T,D,IER) STEP1950
IF (IER) 158,159,158 STEP1960
158 WRITE (6,20) STEP1970
GO TO 185 STEP1980
C STEP1990
C FIND WHETHER TO PRINT THE TABLE OF RESIDUALS STEP2000
C STEP2010
159 IF(NR) 185, 185, 160 STEP2020
C STEP2030
C PRINT THE TABLE OF RESIDUALS STEP2040
C STEP2050
C STEP2060
160 WRITE (6,13) NSEL STEP2070
WRITE (6,16) STEP2080
WRITE (6,14) STEP2090
MM=NSTEP(1) STEP2100
DO 180 I=1,N STEP2110
READ (13) (D(J),J=1,M) STEP2120
YEST=ANS(9) STEP2130
K=NSTEP(4) STEP2140
DO 170 J=1,K STEP2150
KK=L(J) STEP2160
170 YEST=YEST+B(J)*D(KK) STEP2170
RESI=D(MM)-YEST STEP2180
180 WRITE (6,15) I,D(MM),YEST,RESI STEP2190
REWIND 13 STEP2200
C STEP2210
C TEST TO SEE WHETHER ALL SELECTIONS ARE COMPLETED STEP2220
C STEP2230
185 IF(NSEL-NS) 190, 100, 100 STEP2240
190 NSEL=NSEL+1 STEP2250
WRITE (6,17) STEP2260
GO TO 145 STEP2270
C STEP2280
200 CONTINUE STEP2290
999 STOP
END STEP2300