$JOB FACTO[30,30] $FORTRAN FACTO C FCTO 10 C ................................................................. FCTO 20 C FCTO 30 C SAMPLE MAIN PROGRAM FOR FACTOR ANALYSIS - FACTO FCTO 40 C FCTO 50 C PURPOSE FCTO 60 C (1) READ THE PROBLEM PARAMETER CARD, (2) CALL FIVE SUBROU- FCTO 70 C TINES TO PERFORM A PRINCIPAL COMPONENT SOLUTION AND THE FCTO 80 C VARIMAX ROTATION OF A FACTOR MATRIX, AND (3) PRINT THE FCTO 90 C RESULTS. FCTO 100 C FCTO 110 C REMARKS FCTO 120 C NONE FCTO 130 C FCTO 140 C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED FCTO 150 C CORRE (WHICH, IN TURN, CALLS THE SUBROUTINE NAMED DATA.) FCTO 160 C EIGEN FCTO 170 C TRACE FCTO 180 C LOAD FCTO 190 C VARMX FCTO 200 C FCTO 210 C METHOD FCTO 220 C REFER TO 'BMD COMPUTER PROGRAMS MANUAL', EDITED BY W. J. FCTO 230 C DIXON, UCLA, 1964. FCTO 240 C FCTO 250 C ..................................................................FCTO 260 C FCTO 270 C THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE FCTO 280 C NUMBER OF VARIABLES, M.. FCTO 290 C FCTO 300 DIMENSION B(35),D(35),S(35),T(35),XBAR(35) FCTO 310 C FCTO 320 C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE FCTO 330 C PRODUCT OF M*M.. FCTO 340 C FCTO 350 DIMENSION V(1225) FCTO 360 C FCTO 370 C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO FCTO 380 C (M+1)*M/2.. FCTO 390 C FCTO 400 DIMENSION R(630) FCTO 410 C FCTO 420 C THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO 51.. FCTO 430 C FCTO 440 DIMENSION TV(51) FCTO 450 C FCTO 460 C ..................................................................FCTO 470 C FCTO 480 C IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE FCTO 490 C C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION FCTO 500 C STATEMENT WHICH FOLLOWS. FCTO 510 C FCTO 520 C DOUBLE PRECISION XBAR,S,V,R,D,B,T,TV FCTO 530 C FCTO 540 C THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS FCTO 550 C APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS FCTO 560 C ROUTINE. FCTO 570 C FCTO 580 C ...............................................................FCTO 590 C FCTO 600 1 FORMAT(21H1FACTOR ANALYSIS.....A4,A2//3X,12HNO. OF CASES,4X,I6/3X,FCTO 610 116HNO. OF VARIABLES,I6/) FCTO 620 2 FORMAT(6H0MEANS/(8F15.5)) FCTO 630 3 FORMAT(20H0STANDARD DEVIATIONS/(8F15.5)) FCTO 640 4 FORMAT(25H0CORRELATION COEFFICIENTS) FCTO 650 5 FORMAT(4H0ROWI3/(10F12.5)) FCTO 660 6 FORMAT(1H0/12H EIGENVALUES/(10F12.5)) FCTO 670 7 FORMAT(37H0CUMULATIVE PERCENTAGE OF EIGENVALUES/(10F12.5)) FCTO 680 8 FORMAT(1H0/13H EIGENVECTORS) FCTO 690 9 FORMAT(7H0VECTORI3/(10F12.5)) FCTO 700 10 FORMAT(1H0/16H FACTOR MATRIX (,I3,9H FACTORS)) FCTO 710 11 FORMAT(9H0VARIABLEI3/(10F12.5)) FCTO 720 12 FORMAT(1H0/10H ITERATION,7X,9HVARIANCES/8H CYCLE) FCTO 730 13 FORMAT(I6,F20.6) FCTO 740 14 FORMAT(1H0/24H ROTATED FACTOR MATRIX (I3,9H FACTORS)) FCTO 750 15 FORMAT(9H0VARIABLEI3/(10F12.5)) FCTO 760 16 FORMAT(1H0/23H CHECK ON COMMUNALITIES//9H VARIABLE,7X,8HORIGINAL, FCTO 770 112X,5HFINAL,10X,10HDIFFERENCE) FCTO 780 17 FORMAT(I6,3F18.5) FCTO 790 18 FORMAT(A4,A2,I5,I2,F6.0) FCTO 800 19 FORMAT(5H0ONLY,I2,30H FACTOR RETAINED. NO ROTATION) FCTO 810 C FCTO 820 C ..................................................................FCTO 830 C FCTO 840 C READ PROBLEM PARAMETER CARD FCTO 850 C FCTO 860 100 READ (5,18,END=999) PR,PR1,N,M,CON FCTO 870 C PR.........PROBLEM NUMBER (MAY BE ALPHAMERIC) FCTO 880 C PR1........PROBLEM NUMBER (CONTINUED) FCTO 890 C N..........NUMBER OF CASES FCTO 900 C M..........NUMBER OF VARIABLES FCTO 910 C CON........CONSTANT USED TO DECIDE HOW MANY EIGENVALUES FCTO 920 C TO RETAIN FCTO 930 C FCTO 940 WRITE (6,1) PR,PR1,N,M FCTO 950 C FCTO 960 IO=0 FCTO 970 X=0.0 FCTO 980 C FCTO 990 CALL CORRE (N,M,IO,X,XBAR,S,V,R,D,B,T) FCTO1000 C FCTO1010 C PRINT MEANS FCTO1020 C FCTO1030 WRITE (6,2) (XBAR(J),J=1,M) FCTO1040 C FCTO1050 C PRINT STANDARD DEVIATIONS FCTO1060 C FCTO1070 WRITE (6,3) (S(J),J=1,M) FCTO1080 C FCTO1090 C PRINT CORRELATION COEFFICIENTS FCTO1100 C FCTO1110 WRITE (6,4) FCTO1120 DO 120 I=1,M FCTO1130 DO 110 J=1,M FCTO1140 IF(I-J) 102, 104, 104 FCTO1150 102 L=I+(J*J-J)/2 FCTO1160 GO TO 110 FCTO1170 104 L=J+(I*I-I)/2 FCTO1180 110 D(J)=R(L) FCTO1190 120 WRITE (6,5) I,(D(J),J=1,M) FCTO1200 C FCTO1210 MV=0 FCTO1220 CALL EIGEN (R,V,M,MV) FCTO1230 C FCTO1240 CALL TRACE (M,R,CON,K,D) FCTO1250 C FCTO1260 C PRINT EIGENVALUES FCTO1270 C FCTO1280 DO 130 I=1,K FCTO1290 L=I+(I*I-I)/2 FCTO1300 130 S(I)=R(L) FCTO1310 WRITE (6,6) (S(J),J=1,K) FCTO1320 C FCTO1330 C PRINT CUMULATIVE PERCENTAGE OF EIGENVALUES FCTO1340 C FCTO1350 WRITE (6,7) (D(J),J=1,K) FCTO1360 C FCTO1370 C PRINT EIGENVECTORS FCTO1380 C FCTO1390 WRITE (6,8) FCTO1400 L=0 FCTO1410 DO 150 J=1,K FCTO1420 DO 140 I=1,M FCTO1430 L=L+1 FCTO1440 140 D(I)=V(L) FCTO1450 150 WRITE (6,9) J,(D(I),I=1,M) FCTO1460 C FCTO1470 CALL LOAD (M,K,R,V) FCTO1480 C FCTO1490 C PRINT FACTOR MATRIX FCTO1500 C FCTO1510 WRITE (6,10) K FCTO1520 DO 180 I=1,M FCTO1530 DO 170 J=1,K FCTO1540 L=M*(J-1)+I FCTO1550 170 D(J)=V(L) FCTO1560 180 WRITE (6,11) I,(D(J),J=1,K) FCTO1570 C FCTO1580 IF(K-1) 185, 185, 188 FCTO1590 185 WRITE (6,19) K FCTO1600 GO TO 100 FCTO1610 C FCTO1620 188 CALL VARMX (M,K,V,NC,TV,B,T,D,IER) FCTO1630 IF (IER .EQ. 1) WRITE (6,998) 998 FORMAT(/' **** WARNING ****'/ 1 ' CONVERGENCE NOT REACHED AFTER 50 ITERATIONS'/) C FCTO1640 C PRINT VARIANCES FCTO1650 C FCTO1660 NV=NC+1 FCTO1670 WRITE (6,12) FCTO1680 DO 190 I=1,NV FCTO1690 NC=I-1 FCTO1700 190 WRITE (6,13) NC,TV(I) FCTO1710 C FCTO1720 C PRINT ROTATED FACTOR MATRIX FCTO1730 C FCTO1740 WRITE (6,14) K FCTO1750 DO 220 I=1,M FCTO1760 DO 210 J=1,K FCTO1770 L=M*(J-1)+I FCTO1780 210 S(J)=V(L) FCTO1790 220 WRITE (6,15) I,(S(J),J=1,K) FCTO1800 C FCTO1810 C PRINT COMMUNALITIES FCTO1820 C FCTO1830 WRITE (6,16) FCTO1840 DO 230 I=1,M FCTO1850 230 WRITE (6,17) I,B(I),T(I),D(I) FCTO1860 GO TO 100 FCTO1870 999 STOP END FCTO1880 $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 FAC.CDR SAMPLE00023090001.0 20 7 7 9 7 15 36 60 15 24 30 13 18 25 15 13 35 61 18 30 40 9 18 24 23 12 43 62 14 31 50 7 13 25 36 11 12 63 26 32 60 6 8 20 7 15 46 18 28 15 70 10 12 30 11 10 42 27 12 17 80 7 6 11 7 15 35 60 20 25 90 16 19 25 16 13 30 64 20 30 100 9 22 26 24 13 40 66 15 32 110 8 15 26 30 13 10 66 25 34 120 8 10 20 8 17 40 20 30 18 130 9 12 28 11 8 45 30 15 19 140 11 17 21 30 10 45 60 17 30 150 9 16 26 27 14 31 59 19 17 160 10 15 24 18 12 29 48 18 26 170 11 11 30 19 19 26 57 20 30 180 16 9 16 20 18 31 60 21 17 190 9 8 19 14 16 33 67 9 19 200 7 18 22 9 15 37 62 11 20 210 8 11 23 18 9 36 61 22 24 220 6 6 27 23 7 40 55 24 31 230 10 9 26 26 10 37 57 27 29 240 8 10 26 15 11 42 59 20 28 250 $EOD .ASSIGN CDR 5 .ASSIGN LPT 6 .ASSIGN DSK 13 .SET CDR FAC .EXECUTE/REL FACTO,DATA,WES:SSP/LIB %FIN:: .DELETE FAC.CDR,FOR13.DAT