File: MCANO.FT of Tape: Various/ETH/eth11-1

(Source file text) 

---

C	SAMPLE MAIN PROGRAM FOR CANONICAL CORRELATION - MCANO
C	USES  CORRE,CANOR,MINV,NROOT,EIGEN
C		AND DATA (ATTACHED)
C	THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE
C	TOTAL NUMBER OF VARIABLES M (M=MP+MQ, WHERE MP IS THE NUMBER
C	OF LEFT HAND VARIABLES AND MQ IS THE NUMBER OF RIGHT HAND 
C	VARIABLES).
	DIMENSION XBAR(9),STD(9),CANR(9),CHISQ(9),NDF(9)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF M*M
	DIMENSION RX(81)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	(M+1)*M/2
	DIMENSION R(45)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF MQ*MQ
	DIMENSION COEFL(81)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF MQ*MQ
	DIMENSION COEFR(25)
C
	COMMON IOUT,IN
C.......................................................................
1	FORMAT(A4,A2,I5,2I2)
2	FORMAT(//'CANONICAL CORRELATION.....'A4,A2//'   NO. OF OBSER
	1VATIONS'8X,I4/'   NO. OF LEFT HAND VARIABLES'I5/'   NO. OF
	2 RIGHT HAND VARIABLES'I4/)
3	FORMAT(/' MEANS'/(5F16.5))
4	FORMAT(/' STANDARD DEVIATIONS'/(5F16.5))
5	FORMAT(/' CORRELATION COEFFICIENTS')
6	FORMAT(/' ROW'I3/(5F16.5))
7	FORMAT(//'   NUMBER OF'7X'LARGEST'7X'CORRESPONDING'27X'DEGREES'
	1/'  EIGENVALUES'5X'EIGENVALUE'7X'CANONICAL'7X'LAMBDA'
	25X'CHI-SQUARE'4X'OF'/4X'REMOVED'7X'REMAINING'7X'CORRELATION'
	328X'FREEDOM'/)
8	FORMAT(I7,F19.5,F16.5,2F14.5,3X,I5)
9	FORMAT(/' CANONICAL CORRELATION'F12.5)
10	FORMAT(/'  COEFFICIENTS FOR LEFT HAND VARIABLES'/(5F16.5))
11	FORMAT(/'  COEFFICIENTS FOR RIGHT HAND VARIABLES'/(5F16.5))
C.......................................................................
C	OUTPUT CHANNEL = IOUT, INPUT CHANNEL = IN
	IOUT=2
	IN=1
C
C	READ PROBLEM PARAMETER CARD
100	READ(IN,1) PR,PR1,N,MP,MQ
C	PR=PROBLEM NUMBER (MAY BE ALPHAMERIC)
C	PR1=PROBLEM NUMBER (CONTINUED)
C	N=NUMBER OF OBSERVATIONS
C	MP=NUMBER OF LEFT HAND VARIABLES
C	MQ=NUMBER OF RIGHT HAND VARIABLES
	IF(N.EQ.0) STOP
	WRITE(IOUT,2) PR,PR1,N,MP,MQ
	M=MP+MQ
	IO=0
	X=0.0
	CALL CORRE(N,M,IO,X,XBAR,STD,RX,R,CANR,CHISQ,COEFL)
C	PRINT MEANS, STANDARD DEVIATIONS, AND CORRELATION
C	COEFFICIENTS OF ALL VARIABLES
	WRITE(IOUT,3) (XBAR(I),I=1,M)
	WRITE(IOUT,4) (STD(I),I=1,M)
	WRITE(IOUT,5)
	DO 160 I=1,M
	DO 150 J=1,M
	IF(I-J) 120,130,130
120	L=I+(J*J-J)/2
	GO TO 140
130	L=J+(I*I-I)/2
140	CANR(J)=R(L)
150	CONTINUE
160	WRITE(IOUT,6) I,(CANR(J),J=1,M)
	CALL CANOR(N,MP,MQ,R,XBAR,STD,CANR,CHISQ,NDF,COEFR,COEFL,RX)
C	PRINT EIGENVALUES, CANONICAL CORRELATIONS, LAMBDA, CHI-SQUARES
C	DEGREES OF FREEDOMS
	WRITE(IOUT,7)
	DO 170 I=1,MQ
	N1=I-1
C	TEST WHETHER EIGEN VALUE IS GREATER THAN ZERO
	IF(XBAR(I))165,165,170
165	MM=N1
	GO TO 175
170	WRITE(IOUT,8) N1,XBAR(I),CANR(I),STD(I),CHISQ(I),NDF(I)
	MM=MQ
C	PRINT CANONICAL COEFFICIENTS
175	N1=0
	N2=0
	DO 200 I=1,MM
	WRITE(IOUT,9) CANR(I)
	DO 180 J=1,MP
	N1=N1+1
180	XBAR(J)=COEFL(N1)
	WRITE(IOUT,10) (XBAR(J),J=1,MP)
	DO 190 J=1,MQ
	N2=N2+1
190	XBAR(J)=COEFR(N2)
	WRITE(IOUT,11) (XBAR(J),J=1,MQ)
200	CONTINUE
	GO TO 100
	END
C.......................................................................
C	SAMPLE INPUT SUBROUTINE - DATA
C
C	PURPOSE
C	  READ AN OBSERVATION (N DATA VALUES) FROM THE INPUT DEVICE.
C	  THIS SUBROUTINE IS CALLED BY CORRE AND MUST BE PROVIDED BY THE USER
C	  IF SIZE AND LOCATION OF DATA FIELDS ARE DIFFERENT FROM PROBLEM
C	  TO PROBLEM, THIS SUBROUTINE MUST BE RECOMPILED WITH A PROPER
C	  FORMAT STATEMENT.
C
C	USAGE
C	  CALL DATA(M,D)
C
C	DESCRIPTION OF PARAMETERS
C	  M - THE NUMBER OF VARIABLES IN AN OBSERVATION
C	  D - OUTPUT VECTOR OF LENGTH M CONTAINING THE OBSERVATION DATA.
C
C	REMARKS
C	  THE TYPE OF CONVERSION SPECIFIED IN THE FORMAT MUST BE EITHER 
C	  F OR E.
C
C	SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C	  NONE
C.......................................................................
	SUBROUTINE DATA(M,D)
	DIMENSION D(1)
	COMMON IOUT,IN
1	FORMAT(12F6.0)
C	READ AN OBSERVATION FORM INPUT DEVICE.
	READ(IN,1) (D(I),I=1,M)
	RETURN
	END

---