Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/mcano.smp
There are 2 other files named mcano.smp in the archive. Click here to see a list.
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