Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50145/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