Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/mcano.cdk
There are 2 other files named mcano.cdk in the archive. Click here to see a list.
$JOB MCANO[30,30]
$FORTRAN MCANO
C                                                                       MCAN  10
C     ..................................................................MCAN  20
C                                                                       MCAN  30
C        SAMPLE MAIN PROGRAM FOR CANONICAL CORRELATION - MCANO          MCAN  40
C                                                                       MCAN  50
C        PURPOSE                                                        MCAN  60
C           (1) READ THE PROBLEM PARAMETER CARD FOR A CANONICAL         MCAN  70
C           CORRELATION, (2) CALL TWO SUBROUTINES TO CALCULATE SIMPLE   MCAN  80
C           CORRELATIONS, CANONICAL CORRELATIONS, CHI-SQUARES, DEGREES  MCAN  90
C           OF FREEDOM FOR CHI-SQUARES, AND COEFFICIENTS FOR LEFT AND   MCAN 100
C           RIGHT HAND VARIABLES, NAMELY CANONICAL VARIATES, AND (3)    MCAN 110
C           PRINT THE RESULTS.                                          MCAN 120
C                                                                       MCAN 130
C        REMARKS                                                        MCAN 140
C           THE NUMBER OF LEFT HAND VARIABLES MUST BE GREATER THAN      MCAN 150
C           OR EQUAL TO THE NUMBER OF RIGHT HAND VARIABLES.             MCAN 160
C                                                                       MCAN 170
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  MCAN 180
C           CORRE  (WHICH, IN TURN, CALLS THE INPUT SUBROUTINE NAMED    MCAN 190
C                  DATA.)                                               MCAN 200
C           CANOR  (WHICH, IN TURN, CALLS THE SUBROUTINES MINV AND      MCAN 210
C                  NROOT.  NROOT, IN TURN, CALLS THE SUBROUTINE EIGEN.) MCAN 220
C                                                                       MCAN 230
C        METHOD                                                         MCAN 240
C           REFER TO W. W. COOLEY AND P. R. LOHNES, 'MULTIVARIATE PRO-  MCAN 250
C           CEDURES FOR THE BEHAVIORAL SCIENCES', JOHN WILEY AND SONS,  MCAN 260
C           1962, CHAPTER 3.                                            MCAN 270
C                                                                       MCAN 280
C     ..................................................................MCAN 290
C                                                                       MCAN 300
C     THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE     MCAN 310
C     TOTAL NUMBER OF VARIABLES M (M=MP+MQ, WHERE MP IS THE NUMBER OF   MCAN 320
C     LEFT HAND VARIABLES, AND MQ IS THE NUMBER OF RIGHT HAND VARI-     MCAN 330
C     ABLES)..                                                          MCAN 340
C                                                                       MCAN 350
         DIMENSION XBAR(20),STD(20),CANR(20),CHISQ(20),NDF(20)          MCAN 360
C                                                                       MCAN 370
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MCAN 380
C     PRODUCT OF M*M..                                                  MCAN 390
C                                                                       MCAN 400
         DIMENSION RX(400)                                              MCAN 410
C                                                                       MCAN 420
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO          MCAN 430
C     (M+1)*M/2..                                                       MCAN 440
C                                                                       MCAN 450
         DIMENSION R(210)                                               MCAN 460
C                                                                       MCAN 470
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MCAN 480
C     PRODUCT OF MP*MQ..                                                MCAN 490
C                                                                       MCAN 500
         DIMENSION COEFL(400)                                           MCAN 510
C                                                                       MCAN 520
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MCAN 530
C     PRODUCT OF MQ*MQ..                                                MCAN 540
C                                                                       MCAN 550
         DIMENSION COEFR(400)                                           MCAN 560
C                                                                       MCAN 570
C     ..................................................................MCAN 580
C                                                                       MCAN 590
C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE  MCAN 600
C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION      MCAN 610
C        STATEMENT WHICH FOLLOWS.                                       MCAN 620
C                                                                       MCAN 630
C     DOUBLE PRECISION XBAR,STD,RX,R,CANR,CHISQ,COEFL,COEFR             MCAN 640
C                                                                       MCAN 650
C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS    MCAN 660
C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS      MCAN 670
C        ROUTINE.                                                       MCAN 680
C                                                                       MCAN 690
C        ...............................................................MCAN 700
C                                                                       MCAN 710
    1 FORMAT(A4,A2,I5,2I2)                                              MCAN 720
    2 FORMAT(27H1CANONICAL CORRELATION.....,A4,A2//22H   NO. OF OBSERVATMCAN 730
     1IONS,8X,I4/29H   NO. OF LEFT HAND VARIABLES,I5/30H   NO. OF RIGHT MCAN 740
     3HAND VARIABLES,I4/)                                               MCAN 750
    3 FORMAT(6H0MEANS/(8F15.5))                                         MCAN 760
    4 FORMAT(20H0STANDARD DEVIATIONS/(8F15.5))                          MCAN 770
    5 FORMAT(25H0CORRELATION COEFFICIENTS)                              MCAN 780
    6 FORMAT(4H0ROW,I3/(10F12.5))                                       MCAN 790
    7 FORMAT(1H0//12H   NUMBER OF, 7X,7HLARGEST,7X,13HCORRESPONDING,31X,MCAN 800
     17HDEGREES/13H  EIGENVALUES,5X,10HEIGENVALUE,7X,9HCANONICAL,7X,    MCAN 810
     26HLAMBDA,5X,10HCHI-SQUARE,7X,2H0F/4X,7HREMOVED,7X,9HREMAINING,7X, MCAN 820
     311HCORRELATION,32X,7HFREEDOM/)                                    MCAN 830
    8 FORMAT(1H ,I7,F19.5,F16.5,2F14.5,5X,I5)                           MCAN 840
    9 FORMAT(1H0/22H CANONICAL CORRELATION,F12.5)                       MCAN 850
   10 FORMAT(39H0  COEFFICIENTS FOR LEFT HAND VARIABLES/(8F15.5))       MCAN 860
   11 FORMAT(40H0  COEFFICIENTS FOR RIGHT HAND VARIABLES/(8F15.5))      MCAN 870
C                                                                       MCAN 880
C     ..................................................................MCAN 890
C                                                                       MCAN 900
C     READ PROBLEM PARAMETER CARD                                       MCAN 910
C                                                                       MCAN 920
  100 READ (5,1,END=999) PR,PR1,N,MP,MQ                                 MCAN 930
C        PR.......PROBLEM NUMBER (MAY BE ALPHAMERIC)                    MCAN 940
C        PR1......PROBLEM NUMBER (CONTINUED)                            MCAN 950
C        N........NUMBER OF OBSERVATIONS                                MCAN 960
C        MP.......NUMBER OF LEFT HAND VARIABLES                         MCAN 970
C        MQ.......NUMBER OF RIGHT HAND VARIABLES                        MCAN 980
C                                                                       MCAN 990
      WRITE (6,2) PR,PR1,N,MP,MQ                                        MCAN1000
C                                                                       MCAN1010
      M=MP+MQ                                                           MCAN1020
      IO=0                                                              MCAN1030
      X=0.0                                                             MCAN1040
C                                                                       MCAN1050
      CALL CORRE (N,M,IO,X,XBAR,STD,RX,R,CANR,CHISQ,COEFL)              MCAN1060
C                                                                       MCAN1070
C     PRINT MEANS, STANDARD DEVIATIONS, AND CORRELATION                 MCAN1080
C     COEFFICIENTS OF ALL VARIABLES                                     MCAN1090
C                                                                       MCAN1100
      WRITE (6,3) (XBAR(I),I=1,M)                                       MCAN1110
      WRITE (6,4) (STD(I),I=1,M)                                        MCAN1120
      WRITE (6,5)                                                       MCAN1130
      DO 160 I=1,M                                                      MCAN1140
      DO 150 J=1,M                                                      MCAN1150
      IF(I-J) 120, 130, 130                                             MCAN1160
  120 L=I+(J*J-J)/2                                                     MCAN1170
      GO TO 140                                                         MCAN1180
  130 L=J+(I*I-I)/2                                                     MCAN1190
  140 CANR(J)=R(L)                                                      MCAN1200
  150 CONTINUE                                                          MCAN1210
  160 WRITE (6,6) I,(CANR(J),J=1,M)                                     MCAN1220
C                                                                       MCAN1230
      CALL CANOR (N,MP,MQ,R,XBAR,STD,CANR,CHISQ,NDF,COEFR,COEFL,RX)     MCAN1240
C                                                                       MCAN1250
C     PRINT EIGENVALUES, CANONICAL CORRELATIONS, LAMBDA, CHI-SQUARES,   MCAN1260
C     DEGREES OF FREEDOMS                                               MCAN1270
C                                                                       MCAN1280
      WRITE (6,7)                                                       MCAN1290
      DO 170 I=1,MQ                                                     MCAN1300
      N1=I-1                                                            MCAN1310
C                                                                       MCAN1320
C        TEST WHETHER EIGENVALUE IS GREATER THAN ZERO                   MCAN1330
C                                                                       MCAN1340
      IF(XBAR(I)) 165, 165, 170                                         MCAN1350
  165 MM=N1                                                             MCAN1360
      GO TO 175                                                         MCAN1370
  170 WRITE (6,8) N1,XBAR(I),CANR(I),STD(I),CHISQ(I),NDF(I)             MCAN1380
      MM=MQ                                                             MCAN1390
C                                                                       MCAN1400
C     PRINT CANONICAL COEFFICIENTS                                      MCAN1410
C                                                                       MCAN1420
  175 N1=0                                                              MCAN1430
      N2=0                                                              MCAN1440
      DO 200 I=1,MM                                                     MCAN1450
      WRITE (6,9) CANR(I)                                               MCAN1460
      DO 180 J=1,MP                                                     MCAN1470
      N1=N1+1                                                           MCAN1480
  180 XBAR(J)=COEFL(N1)                                                 MCAN1490
      WRITE (6,10) (XBAR(J),J=1,MP)                                     MCAN1500
      DO 190 J=1,MQ                                                     MCAN1510
      N2=N2+1                                                           MCAN1520
  190 XBAR(J)=COEFR(N2)                                                 MCAN1530
      WRITE (6,11) (XBAR(J),J=1,MQ)                                     MCAN1540
  200 CONTINUE                                                          MCAN1550
      GO TO 100                                                         MCAN1560
999	STOP
      END                                                               MCAN1570
$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 MCA.CDR
SAMPLE000230403                                                               20
   191   155    65    19   179   145    70                                    30
   195   149    70    20   201   152    69                                    40
   181   148    71    19   185   149    75                                    50
   183   153    82    18   188   149    86                                    60
   176   144    67    18   171   142    71                                    70
   208   157    81    22   192   152    77                                    80
   189   150    75    21   190   149    72                                    90
   197   159    90    20   189   152    82                                   100
   188   152    76    19   197   159    84                                   110
   192   150    78    20   187   151    72                                   120
   179   158    99    18   186   148    89                                   130
   183   147    65    18   174   147    70                                   140
   174   150    71    19   185   152    65                                   150
   190   159    91    19   195   157    99                                   160
   188   151    98    20   187   158    87                                   170
   163   137    59    18   161   130    63                                   180
   195   155    85    20   183   158    81                                   190
   196   153    80    21   173   148    74                                   200
   181   145    77    20   182   146    70                                   210
   175   140    70    19   165   137    81                                   220
   192   154    69    20   185   152    63                                   230
   174   143    79    20   178   147    73                                   240
   176   139    70    20   176   143    69                                   250
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.ASSIGN DSK 13
.SET CDR MCA
.EXECUTE/REL MCANO,DATA,WES:SSP/LIB
%FIN::
.DELETE MCA.CDR,FOR13.DAT