<div id='wikitext'>
<pre><b> File: FACTO.FT of Tape: Various/ETH/eth11-1</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
C	SAMPLE MAIN PROGRAM FOR FACTOR ANALYSIS
C	USES THE FOLLOWING SUBROUTINES:
C  CORRE	- MEANS,STANDARD DEVIATIONS, AND CORRELATIONS
C  EIGEN	- EIGENVALUES AND EIGENVECTORS OF A REAL,SYMM. MATRIX
C  TRACE	- CUMULATIVE PERCENTAGE OF EIGENVALUES
C  LOAD		- FACTOR LOADING
C  VARMX	- VARIMAX ROTATION
C
C  DATA - A ROUTINE SUPPLIED WITH THIS PROGRAM
C
C	THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE
C	NUMBER OF VARIABLES, M...
	DIMENSION B(29),D(29),S(29),T(29),XBAR(29)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF M*M..
	DIMENSION V(841)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO
C	(M+1)*M/2..
	DIMENSION R(435)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO 51..
	DIMENSION TV(51)
	COMMON IOUT,IN
C	INPUT CHANNEL = IN, OUTPUT CHANNEL = IOUT
	IOUT = 2
	IN = 1
C
1	FORMAT(////21H FACTOR ANALYSIS.....A4,A2//3X,12HNO. OF CASES,4X,
	1I6/3X,16HNO. OF VARIABLES,I6/)
2	FORMAT(//6H MEANS/(5F15.5))
3	FORMAT(//20H STANDARD DEVIATIONS/(5F15.5))
4	FORMAT(//25H CORRELATION COEFFICIENTS)
5	FORMAT(//4H ROW,I3/(5F15.5))
6	FORMAT(///12H EIGENVALUES/(5F15.5))
7	FORMAT(//37H CUMULATIVE PERCENTAGE OF EIGENVALUES/(5F15.5))
8	FORMAT(///13H EIGENVECTORS)
9	FORMAT(//7H VECTOR,I3/(5F15.5))
10	FORMAT(///16H FACTOR MATRIX (,I3,9H FACTORS))
11	FORMAT(//9H VARIABLE,I3/(5F15.5))
12	FORMAT(///10H ITERATION,7X,9HVARIANCES/8H   CYCLE)
13	FORMAT(I6,F20.6)
14	FORMAT(///24H ROTATED FACTOR MATRIX (,I3,9H FACTORS))
15	FORMAT(//9H VARIABLE,I3/(5F15.5))
16	FORMAT(///23H CHECK ON COMMUNALITIES//9H VARIABLE,7X,8HORIGINAL,
	112X,5HFINAL,10X,10HDIFFERENCE)
17	FORMAT(I6,3F18.5)
18	FORMAT(A4,A2,I5,I2,F6.0)
19	FORMAT(//5H ONLY,I2,30H FACTOR RETAINED. NO ROTATION )
C	READ PROBLEM PARAMETER CARD
100	READ(IN,18) PR,PR1,N,M,CON
C  PR     PROBLEM NUMBER (MAY BE ALPHAMERIC)
C  PR1    PROBLEM NUMBER (CONTINUED)
C  N      NUMBER OF CASES
C  M      NUMBER OF VARIABLES
C  CON    CONSTANT USED TO DECIDE HOW MANY EIGENVALUES TO RETAIN
C
	IF(N.EQ.0) STOP
	WRITE(IOUT,1)PR,PR1,N,M
	IO=0
	X=0.0
	CALL CORRE(N,M,IO,X,XBAR,S,V,R,D,B,T)
C	PRINT MEANS
	WRITE(IOUT,2)( XBAR(J),J=1,M)
C	PRINT STANDARD DEVIATIONS
	WRITE(IOUT,3) (S(J),J=1,M)
C	PRINT CORRELATION COEFFICIENTS
	WRITE(IOUT,4)
	DO 120 I=1,M
	DO 110 J=1,M
	IF(I-J) 102,104,104
102	L=I+(J*J-J)/2
	GO TO 110
104	L=J+(I*I-I)/2
110	D(J)=R(L)
120	WRITE(IOUT,5) I,(D(J),J=1,M)
	MV=0
	CALL EIGEN (R,V,M,MV)
	CALL TRACE(M,R,CON,K,D)
C	PRINT EIGENVALUES
	DO 130 I=1,K
	L=I+(I*I-I)/2
130	S(I)=R(L)
	WRITE(IOUT,6) (S(J),J=1,K)
C	PRINT CUMULATIVE PERCENTAGE OF EIGENVALUES
	WRITE(IOUT,7) (D(J),J=1,K)
C	PRINT EIGENVECTORS
	WRITE(IOUT,8)
	L=0
	DO 150 J=1,K
	DO 140 I=1,M
	L=L+1
140	D(I) = V(L)
150	WRITE(IOUT,9) J,(D(I),I=1,M)
	CALL LOAD(M,K,R,V)
C	PRINT FACTOR MATRIX
	WRITE(IOUT,10) K
	DO 180 I=1,M
	DO 170 J=1,K
	L=M*(J-1)+I
170	D(J)=V(L)
180	WRITE(IOUT,11) I,(D(J),J=1,K)
	IF(K-1) 185,185,188
185	WRITE(IOUT,19)K
	GO TO 100
188	CALL VARMX(M,K,V,NC,TV,B,T,D,IER)
C	PRINT VARIANCES
	NV=NC+1
	WRITE(IOUT,12)
	DO 190 I=1,NV
	NC=I-1
190	WRITE(IOUT,13) NC,TV(I)
C	PRINT ROTATED FACTOR MATRIX
	WRITE(IOUT,14) K
	DO 220 I=1,M
	DO 210 J=1,K
	L=M*(J-1)+I
210	S(J)=V(L)
220	WRITE(IOUT,15) I,(S(J),J=1,K)
C	PRINT COMMUNALITIES
	WRITE(IOUT,16)
	DO 230 I=1,M
230	WRITE(IOUT,17) I,B(I),T(I),D(I)
	GO TO 100
	END
C	SAMPLE INPUT SUBROUTINE - DATA.FTN
C
C	PURPOSE
C	  READ AN OBSERVATION (N DATA VALUES) FROM INPUT DEVICE.
C	  THIS SUBROUTINE IS CALLED BY THE SUBROUTINE CORRE AND MUST
C	  BE PROVIDED BY THE USER.  IF SIZE AND LOCATION OF DATA
C	  FIELDS ARE DIFFERENT FROM PROBLEM TO PROBLEM, THIS SUBROUTINE
C	  MUST BE RECOMPILED WITH A PROPRE 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
C	  EITHER 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 FROM INPUT DEVICE.
	READ(IN,1) (D(I),I=1,M)
	RETURN
	END</pre>
<hr/>
</div>