C
C     .................................................................
C
C        SAMPLE MAIN PROGRAM FOR FACTOR ANALYSIS - FACTO
C
C        PURPOSE
C           (1) READ THE PROBLEM PARAMETER CARD, (2) CALL FIVE SUBROU-
C           TINES TO PERFORM A PRINCIPAL COMPONENT SOLUTION AND THE
C           VARIMAX ROTATION OF A FACTOR MATRIX, AND (3) PRINT THE
C           RESULTS.
C
C        REMARKS
C           NONE
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           CORRE  (WHICH, IN TURN, CALLS THE SUBROUTINE NAMED DATA.)
C           EIGEN
C           TRACE
C           LOAD
C           VARMX
C
C        METHOD
C           REFER TO 'BMD COMPUTER PROGRAMS MANUAL', EDITED BY W. J.
C           DIXON, UCLA, 1964.
C
C     ..................................................................
C
C     THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE
C     NUMBER OF VARIABLES, M..
C
         DIMENSION B(35),D(35),S(35),T(35),XBAR(35)
C
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C     PRODUCT OF M*M..
C
         DIMENSION V(1225)
C
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO
C     (M+1)*M/2..
C
         DIMENSION R(630)
C
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO 51..
C
         DIMENSION TV(51)
C
C     ..................................................................
C
C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE
C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION
C        STATEMENT WHICH FOLLOWS.
C
C     DOUBLE PRECISION XBAR,S,V,R,D,B,T,TV
C
C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS
C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS
C        ROUTINE.
C
C        ...............................................................
C
    1 FORMAT(21H1FACTOR ANALYSIS.....A4,A2//3X,12HNO. OF CASES,4X,I6/3X,
     116HNO. OF VARIABLES,I6/)
    2 FORMAT(6H0MEANS/(8F15.5))
    3 FORMAT(20H0STANDARD DEVIATIONS/(8F15.5))
    4 FORMAT(25H0CORRELATION COEFFICIENTS)
    5 FORMAT(4H0ROWI3/(10F12.5))
    6 FORMAT(1H0/12H EIGENVALUES/(10F12.5))
    7 FORMAT(37H0CUMULATIVE PERCENTAGE OF EIGENVALUES/(10F12.5))
    8 FORMAT(1H0/13H EIGENVECTORS)
    9 FORMAT(7H0VECTORI3/(10F12.5))
   10 FORMAT(1H0/16H FACTOR MATRIX (,I3,9H FACTORS))
   11 FORMAT(9H0VARIABLEI3/(10F12.5))
   12 FORMAT(1H0/10H ITERATION,7X,9HVARIANCES/8H   CYCLE)
   13 FORMAT(I6,F20.6)
   14 FORMAT(1H0/24H ROTATED FACTOR MATRIX (I3,9H FACTORS))
   15 FORMAT(9H0VARIABLEI3/(10F12.5))
   16 FORMAT(1H0/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(5H0ONLY,I2,30H FACTOR RETAINED.  NO ROTATION)
C	DOUBLE PRECISION TMPFIL,FILE
C	OPEN (UNIT=5, DEVICE='CDR', ACCESS='SEQIN')
C	OPEN (UNIT=6, DEVICE='LPT', ACCESS='SEQOUT')
C	FILE = TMPFIL('SSP')
C	OPEN (UNIT=9, DEVICE='DSK', FILE=FILE, ACCESS='SEQINOUT',
C	1	DISPOSE='DELETE')
C
C     ..................................................................
C
C     READ PROBLEM PARAMETER CARD
C
	LOGICAL EOF
	CALL CHKEOF (EOF)
  100 READ (5,18) PR,PR1,N,M,CON
	IF (EOF) GOTO 999
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
C                     TO RETAIN
C
      WRITE (6,1) PR,PR1,N,M
C
      IO=0
      X=0.0
C
      CALL CORRE (N,M,IO,X,XBAR,S,V,R,D,B,T)
C
C     PRINT MEANS
C
      WRITE (6,2) (XBAR(J),J=1,M)
C
C     PRINT STANDARD DEVIATIONS
C
      WRITE (6,3) (S(J),J=1,M)
C
C     PRINT CORRELATION COEFFICIENTS
C
      WRITE (6,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 (6,5) I,(D(J),J=1,M)
C
      MV=0
      CALL EIGEN (R,V,M,MV)
C
      CALL TRACE (M,R,CON,K,D)
C
C     PRINT EIGENVALUES
C
      DO 130 I=1,K
      L=I+(I*I-I)/2
  130 S(I)=R(L)
      WRITE (6,6) (S(J),J=1,K)
C
C     PRINT CUMULATIVE PERCENTAGE OF EIGENVALUES
C
      WRITE (6,7) (D(J),J=1,K)
C
C     PRINT EIGENVECTORS
C
      WRITE (6,8)
      L=0
      DO 150 J=1,K
      DO 140 I=1,M
      L=L+1
  140 D(I)=V(L)
  150 WRITE (6,9) J,(D(I),I=1,M)
C
      CALL LOAD (M,K,R,V)
C
C     PRINT FACTOR MATRIX
C
      WRITE (6,10) K
      DO 180 I=1,M
      DO 170 J=1,K
      L=M*(J-1)+I
  170 D(J)=V(L)
  180 WRITE (6,11) I,(D(J),J=1,K)
C
      IF(K-1) 185, 185, 188
  185 WRITE (6,19) K
      GO TO 100
C
  188 CALL VARMX (M,K,V,NC,TV,B,T,D,IER)
	IF (IER .EQ. 1) WRITE (6,998)
998	FORMAT(/' **** WARNING ****'/
     1	' CONVERGENCE NOT REACHED AFTER 50 ITERATIONS'/)
C
C     PRINT VARIANCES
C
      NV=NC+1
      WRITE (6,12)
      DO 190 I=1,NV
      NC=I-1
  190 WRITE (6,13) NC,TV(I)
C
C     PRINT ROTATED FACTOR MATRIX
C
      WRITE (6,14) K
      DO 220 I=1,M
      DO 210 J=1,K
      L=M*(J-1)+I
  210 S(J)=V(L)
  220 WRITE (6,15) I,(S(J),J=1,K)
C
C     PRINT COMMUNALITIES
C
      WRITE (6,16)
      DO 230 I=1,M
  230 WRITE (6,17) I,B(I),T(I),D(I)
      GO TO 100
999	STOP
      END