Google
 

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