Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0026/varmx.ssp
There are 2 other files named varmx.ssp in the archive. Click here to see a list.
C                                                                       VARM  10
C     ..................................................................VARM  20
C                                                                       VARM  30
C        SUBROUTINE VARMX                                               VARM  40
C                                                                       VARM  50
C        PURPOSE                                                        VARM  60
C           PERFORM ORTHOGONAL ROTATIONS OF A FACTOR MATRIX.  THIS      VARM  70
C           SUBROUTINE NORMALLY OCCURS IN A SEQUENCE OF CALLS TO SUB-   VARM  80
C           ROUTINES CORRE, EIGEN, TRACE, LOAD, VARMX IN THE PERFORMANCEVARM  90
C           OF A FACTOR ANALYSIS.                                       VARM 100
C                                                                       VARM 110
C        USAGE                                                          VARM 120
C           CALL VARMX (M,K,A,NC,TV,H,F,D,IER)                          VARM 130
C                                                                       VARM 140
C        DESCRIPTION OF PARAMETERS                                      VARM 150
C           M     - NUMBER OF VARIABLES AND NUMBER OF ROWS OF MATRIX A. VARM 160
C           K     - NUMBER OF FACTORS.                                  VARM 170
C           A     - INPUT IS THE ORIGINAL FACTOR MATRIX, AND OUTPUT IS  VARM 180
C                   THE ROTATED FACTOR MATRIX.  THE ORDER OF MATRIX A   VARM 190
C                   IS M X K.                                           VARM 200
C           NC    - OUTPUT VARIABLE CONTAINING THE NUMBER OF ITERATION  VARM 210
C                   CYCLES PERFORMED.                                   VARM 220
C           TV    - OUTPUT VECTOR CONTAINING THE VARIANCE OF THE FACTOR VARM 230
C                   MATRIX FOR EACH ITERATION CYCLE.  THE VARIANCE PRIORVARM 240
C                   TO THE FIRST ITERATION CYCLE IS ALSO CALCULATED.    VARM 250
C                   THIS MEANS THAT NC+1 VARIANCES ARE STORED IN VECTOR VARM 260
C                   TV.  MAXIMUM NUMBER OF ITERATION CYCLES ALLOWED IN  VARM 270
C                   THIS SUBROUTINE IS 50.  THEREFORE, THE LENGTH OF    VARM 280
C                   VECTOR TV IS 51.                                    VARM 290
C           H     - OUTPUT VECTOR OF LENGTH M CONTAINING THE ORIGINAL   VARM 300
C                   COMMUNALITIES.                                      VARM 310
C           F     - OUTPUT VECTOR OF LENGTH M CONTAINING THE FINAL      VARM 320
C                   COMMUNALITIES.                                      VARM 330
C           D     - OUTPUT VECTOR OF LENGTH M CONTAINING THE DIFFERENCESVARM 340
C                   BETWEEN THE ORIGINAL AND FINAL COMMUNALITIES.       VARM 350
C           IER   - ERROR INDICATOR                                     VARM 351
C                   IER=0 - NO ERROR                                    VARM 352
C                   IER=1 - CONVERGENCE WAS NOT ACHIEVED IN 50 CYCLES   VARM 353
C                           OF ROTATION                                 VARM 354
C                                                                       VARM 360
C        REMARKS                                                        VARM 370
C           IF VARIANCE COMPUTED AFTER EACH ITERATION CYCLE DOES NOT    VARM 380
C           INCREASE FOR FOUR SUCCESSIVE TIMES, THE SUBROUTINE STOPS    VARM 390
C           ROTATION.                                                   VARM 400
C                                                                       VARM 410
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  VARM 420
C           NONE                                                        VARM 430
C                                                                       VARM 440
C        METHOD                                                         VARM 450
C           KAISER'S VARIMAX ROTATION AS DESCRIBED IN 'COMPUTER PROGRAM VARM 460
C           FOR VARIMAX ROTATION IN FACTOR ANALYSIS' BY THE SAME AUTHOR,VARM 470
C           EDUCATIONAL AND PSYCHOLOGICAL MEASUREMENT, VOL XIX, NO. 3,  VARM 480
C           1959.                                                       VARM 490
C                                                                       VARM 500
C     ..................................................................VARM 510
C                                                                       VARM 520
      SUBROUTINE VARMX (M,K,A,NC,TV,H,F,D,IER)                          VARM 530
      DIMENSION A(1),TV(1),H(1),F(1),D(1)                               VARM 540
C                                                                       VARM 550
C        ...............................................................VARM 560
C                                                                       VARM 570
C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE  VARM 580
C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION      VARM 590
C                                                                       VARM 600
C     DOUBLE PRECISION A,TV,H,F,D,TVLT,CONS,AA,BB,CC,DD,U,T,B,COS4T,    VARM 610
C    1                 SIN4T,TAN4T,SINP,COSP,CTN4T,COS2T,SIN2T,COST,SINTVARM 620
C                                                                       VARM 630
C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS    VARM 640
C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS      VARM 650
C        ROUTINE.                                                       VARM 660
C                                                                       VARM 670
C        THE DOUBLE PRECISION VERSION OF THIS SUBROUTINE MUST ALSO      VARM 680
C        CONTAIN DOUBLE PRECISION FORTRAN FUNCTIONS.  SQRT IN STATEMENTSVARM 690
C        115, 290, 330, 350, AND 355 MUST BE CHANGED TO DSQRT.  ABS IN  VARM 700
C        STATEMENTS 280, 320, AND 375 MUST BE CHANGED TO DABS.          VARM 710
C                                                                       VARM 720
C        ...............................................................VARM 730
C                                                                       VARM 740
C     INITIALIZATION                                                    VARM 750
C                                                                       VARM 760
      IER=0                                                             VARM 761
      EPS=0.00116                                                       VARM 770
      TVLT=0.0                                                          VARM 780
      LL=K-1                                                            VARM 790
      NV=1                                                              VARM 800
      NC=0                                                              VARM 810
      FN=M                                                              VARM 820
      FFN=FN*FN                                                         VARM 830
      CONS=0.7071066                                                    VARM 840
C                                                                       VARM 850
C     CALCULATE ORIGINAL COMMUNALITIES                                  VARM 860
C                                                                       VARM 870
      DO 110 I=1,M                                                      VARM 880
      H(I)=0.0                                                          VARM 890
      DO 110 J=1,K                                                      VARM 900
      L=M*(J-1)+I                                                       VARM 910
  110 H(I)=H(I)+A(L)*A(L)                                               VARM 920
C                                                                       VARM 930
C     CALCULATE NORMALIZED FACTOR MATRIX                                VARM 940
C                                                                       VARM 950
      DO 120 I=1,M                                                      VARM 960
  115 H(I)= SQRT(H(I))                                                  VARM 970
      DO 120 J=1,K                                                      VARM 980
      L=M*(J-1)+I                                                       VARM 990
  120 A(L)=A(L)/H(I)                                                    VARM1000
      GO TO 132                                                         VARM1010
C                                                                       VARM1020
C     CALCULATE VARIANCE FOR FACTOR MATRIX                              VARM1030
C                                                                       VARM1040
  130 NV=NV+1                                                           VARM1050
      TVLT=TV(NV-1)                                                     VARM1060
  132 TV(NV)=0.0                                                        VARM1070
      DO 150 J=1,K                                                      VARM1080
      AA=0.0                                                            VARM1090
      BB=0.0                                                            VARM1100
      LB=M*(J-1)                                                        VARM1110
      DO 140 I=1,M                                                      VARM1120
      L=LB+I                                                            VARM1130
      CC=A(L)*A(L)                                                      VARM1140
      AA=AA+CC                                                          VARM1150
  140 BB=BB+CC*CC                                                       VARM1160
  150 TV(NV)=TV(NV)+(FN*BB-AA*AA)/FFN                                   VARM1170
      IF(NV-51)160,155,155                                              VARM1180
  155 IER=1                                                             VARM1181
      GO TO 430                                                         VARM1182
C                                                                       VARM1190
C     PERFORM CONVERGENCE TEST                                          VARM1200
C                                                                       VARM1210
  160 IF((TV(NV)-TVLT)-(1.E-7)) 170, 170, 190                           VARM1220
  170 NC=NC+1                                                           VARM1230
      IF(NC-3) 190, 190, 430                                            VARM1240
C                                                                       VARM1250
C     ROTATION OF TWO FACTORS CONTINUES UP TO                           VARM1260
C     THE STATEMENT 120.                                                VARM1270
C                                                                       VARM1280
  190 DO 420 J=1,LL                                                     VARM1290
      L1=M*(J-1)                                                        VARM1300
      II=J+1                                                            VARM1310
C                                                                       VARM1320
C        CALCULATE NUM AND DEN                                          VARM1330
C                                                                       VARM1340
      DO 420 K1=II,K                                                    VARM1350
      L2=M*(K1-1)                                                       VARM1360
      AA=0.0                                                            VARM1370
      BB=0.0                                                            VARM1380
      CC=0.0                                                            VARM1390
      DD=0.0                                                            VARM1400
      DO 230 I=1,M                                                      VARM1410
      L3=L1+I                                                           VARM1420
      L4=L2+I                                                           VARM1430
      U=(A(L3)+A(L4))*(A(L3)-A(L4))                                     VARM1440
      T=A(L3)*A(L4)                                                     VARM1450
      T=T+T                                                             VARM1460
      CC=CC+(U+T)*(U-T)                                                 VARM1470
      DD=DD+2.0*U*T                                                     VARM1480
      AA=AA+U                                                           VARM1490
  230 BB=BB+T                                                           VARM1500
      T=DD-2.0*AA*BB/FN                                                 VARM1510
      B=CC-(AA*AA-BB*BB)/FN                                             VARM1520
C                                                                       VARM1530
C        COMPARISON OF NUM AND DEN                                      VARM1540
C                                                                       VARM1550
      IF(T-B) 280, 240, 320                                             VARM1560
  240 IF((T+B)-EPS) 420, 250, 250                                       VARM1570
C                                                                       VARM1580
C        NUM + DEN IS GREATER THAN OR EQUAL TO THE                      VARM1590
C        TOLERANCE FACTOR                                               VARM1600
C                                                                       VARM1610
  250 COS4T=CONS                                                        VARM1620
      SIN4T=CONS                                                        VARM1630
      GO TO 350                                                         VARM1640
C                                                                       VARM1650
C        NUM IS LESS THAN DEN                                           VARM1660
C                                                                       VARM1670
  280 TAN4T= ABS(T)/ ABS(B)                                             VARM1680
      IF(TAN4T-EPS) 300, 290, 290                                       VARM1690
  290 COS4T=1.0/ SQRT(1.0+TAN4T*TAN4T)                                  VARM1700
      SIN4T=TAN4T*COS4T                                                 VARM1710
      GO TO 350                                                         VARM1720
  300 IF(B) 310, 420, 420                                               VARM1730
  310 SINP=CONS                                                         VARM1740
      COSP=CONS                                                         VARM1750
      GO TO 400                                                         VARM1760
C                                                                       VARM1770
C        NUM IS GREATER THAN DEN                                        VARM1780
C                                                                       VARM1790
  320 CTN4T= ABS(T/B)                                                   VARM1800
      IF(CTN4T-EPS) 340, 330, 330                                       VARM1810
  330 SIN4T=1.0/ SQRT(1.0+CTN4T*CTN4T)                                  VARM1820
      COS4T=CTN4T*SIN4T                                                 VARM1830
      GO TO 350                                                         VARM1840
  340 COS4T=0.0                                                         VARM1850
      SIN4T=1.0                                                         VARM1860
C                                                                       VARM1870
C        DETERMINE COS THETA AND SIN THETA                              VARM1880
C                                                                       VARM1890
  350 COS2T= SQRT((1.0+COS4T)/2.0)                                      VARM1900
      SIN2T=SIN4T/(2.0*COS2T)                                           VARM1910
  355 COST= SQRT((1.0+COS2T)/2.0)                                       VARM1920
      SINT=SIN2T/(2.0*COST)                                             VARM1930
C                                                                       VARM1940
C        DETERMINE COS PHI AND SIN PHI                                  VARM1950
C                                                                       VARM1960
      IF(B) 370, 370, 360                                               VARM1970
  360 COSP=COST                                                         VARM1980
      SINP=SINT                                                         VARM1990
      GO TO 380                                                         VARM2000
  370 COSP=CONS*COST+CONS*SINT                                          VARM2010
  375 SINP= ABS(CONS*COST-CONS*SINT)                                    VARM2020
  380 IF(T) 390, 390, 400                                               VARM2030
  390 SINP=-SINP                                                        VARM2040
C                                                                       VARM2050
C        PERFORM ROTATION                                               VARM2060
C                                                                       VARM2070
  400 DO 410 I=1,M                                                      VARM2080
      L3=L1+I                                                           VARM2090
      L4=L2+I                                                           VARM2100
      AA=A(L3)*COSP+A(L4)*SINP                                          VARM2110
      A(L4)=-A(L3)*SINP+A(L4)*COSP                                      VARM2120
  410 A(L3)=AA                                                          VARM2130
  420 CONTINUE                                                          VARM2140
      GO TO 130                                                         VARM2150
C                                                                       VARM2160
C     DENORMALIZE VARIMAX LOADINGS                                      VARM2170
C                                                                       VARM2180
  430 DO 440 I=1,M                                                      VARM2190
      DO 440 J=1,K                                                      VARM2200
      L=M*(J-1)+I                                                       VARM2210
  440 A(L)=A(L)*H(I)                                                    VARM2220
C                                                                       VARM2230
C     CHECK ON COMMUNALITIES                                            VARM2240
C                                                                       VARM2250
      NC=NV-1                                                           VARM2260
      DO 450 I=1,M                                                      VARM2270
  450 H(I)=H(I)*H(I)                                                    VARM2280
      DO 470 I=1,M                                                      VARM2290
      F(I)=0.0                                                          VARM2300
      DO 460 J=1,K                                                      VARM2310
      L=M*(J-1)+I                                                       VARM2320
  460 F(I)=F(I)+A(L)*A(L)                                               VARM2330
  470 D(I)=H(I)-F(I)                                                    VARM2340
      RETURN                                                            VARM2350
      END                                                               VARM2360