Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/regre.cdk
There are 2 other files named regre.cdk in the archive. Click here to see a list.
$JOB REGRE[30,30]
$FORTRAN REGRE
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
$FORTRAN DATA
C                                                                       DATA  10
C     ..................................................................DATA  20
C                                                                       DATA  30
C        SAMPLE INPUT SUBROUTINE - DATA                                 DATA  40
C                                                                       DATA  50
C        PURPOSE                                                        DATA  60
C           READ AN OBSERVATION (M DATA VALUES) FROM INPUT DEVICE.      DATA  70
C           THIS SUBROUTINE IS CALLED BY THE SUBROUTINE CORRE AND MUST  DATA  80
C           BE PROVIDED BY THE USER.  IF SIZE AND LOCATION OF DATA      DATA  90
C           FIELDS ARE DIFFERENT FROM PROBLEM TO PROBLEM, THIS SUB-     DATA 100
C           ROUTINE MUST BE RECOMPILED WITH A PROPER FORMAT STATEMENT.  DATA 110
C                                                                       DATA 120
C        USAGE                                                          DATA 130
C           CALL DATA (M,D)                                             DATA 140
C                                                                       DATA 150
C        DESCRIPTION OF PARAMETERS                                      DATA 160
C           M - THE NUMBER OF VARIABLES IN AN OBSERVATION.              DATA 170
C           D - OUTPUT VECTOR OF LENGTH M CONTAINING THE OBSERVATION    DATA 180
C               DATA.                                                   DATA 190
C                                                                       DATA 200
C        REMARKS                                                        DATA 210
C           THE TYPE OF CONVERSION SPECIFIED IN THE FORMAT MUST BE      DATA 220
C           EITHER F OR E.                                              DATA 230
C                                                                       DATA 240
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  DATA 250
C           NONE                                                        DATA 260
C     ..................................................................DATA 270
C                                                                       DATA 280
      SUBROUTINE DATA (M,D)                                             DATA 290
C                                                                       DATA 300
      DIMENSION D(1)                                                    DATA 310
C                                                                       DATA 320
    1 FORMAT(12F6.0)                                                    DATA 330
C                                                                       DATA 340
C     READ AN OBSERVATION FROM INPUT DEVICE.                            DATA 350
C                                                                       DATA 360
      READ (5,1) (D(I),I=1,M)                                           DATA 370
C                                                                       DATA 380
C     INPUT DATA ARE WRITTEN ON LOGICAL TAPE 13 FOR THE RESIDUAL ANALY- DATA 390
C     SIS PERFORMED IN THE SAMPLE MULTIPLE REGRESSION PROGRAM.          DATA 400
C                                                                       DATA 410
      WRITE (13) (D(I),I=1,M)                                           DATA 420
      RETURN                                                            DATA 430
      END                                                               DATA 440
$DECK REG.CDR
SAMPLE000300602                                                               20
    29   289   216    85    14     1                                          30
    30   391   244    92    16     2                                          40
    30   424   246    90    18     2                                          50
    30   313   239    91    10     0                                          60
    35   243   275    95    30     2                                          70
    35   365   219    95    21     2                                          80
    43   396   267   100    39     3                                          90
    43   356   274    79    19     2                                         100
    44   346   255   126    56     3                                         110
    44   156   258    95    28     0                                         120
    44   278   249   110    42     4                                         130
    44   349   252    88    21     1                                         140
    44   141   236   129    56     1                                         150
    44   245   236    97    24     1                                         160
    45   297   256   111    45     3                                         170
    45   310   262    94    20     2                                         180
    45   151   339    96    35     3                                         190
    45   370   357    88    15     4                                         200
    45   379   198   147    64     4                                         210
    45   463   206   105    31     3                                         220
    45   316   245   132    60     4                                         230
    45   280   225   108    36     4                                         240
    44   395   215   101    27     1                                         250
    49   139   220   136    59     0                                         260
    49   245   205   113    37     4                                         270
    49   373   215    88    25     1                                         280
    51   224   215   118    54     3                                         290
    51   677   210   116    33     4                                         300
    51   424   210   140    59     4                                         310
    51   150   210   105    30     0                                         320
0106050102030405                                                             330
010603020305                                                                 340
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.ASSIGN DSK 13
.SET CDR REG
.EXECUTE/REL REGRE,DATA,WES:SSP/LIB
%FIN::
.DELETE REG.CDR,FOR13.DAT