C     SSA3-CORE 1                                                       COR   1 
C     NONMETRIC FACTOR ANALYSIS.  THIS PROGRAM STARTING WITH A MATRIX OFCOR   2 
C     COEFFICIENTS R(I,J) RESULTING FROM MM' DETERMINES A MINIMUM SET OFCOR   3 
C     ORTHOGONAL COORDINATES X(A), A=1,2,...,M SUCH THAT THE VALUES OB- COR   4 
C     TAINED FROM XX' ARE A MONOTONIC FUNCTION OF THE ORIGINAL COEFFI-  COR   5 
C     CIENTS.  THIS RESEARCH IS SUPPORTED IN PART BY NSF-GS-929, COPRIN-COR   6 
C     CIPAL INVESTIGATORS - GUTTMAN, L. AND LINGOES, J.C.               COR   7 
C     PROGRAMMED IN FORTRAN II (8/15/65).                               COR   8 
C                                                                       COR   9 
C     DECK SET-UP FOR G-L(SSA-III) -                                    COR  10 
C                                                                       COR  11 
C        1.  SYSTEM ID CARD/S.                                          COR  12 
C        2.  BINARY PROGRAM                                             COR  13 
C        3.  TITLE CARD (PUNCH A 1 IN COLUMN 1 AND ANY BCD TITLE IN COL-COR  14 
C            UMNS 2-72, WHICH WILL HEAD OUTPUT).                        COR  15 
C        4.  PARAMETER CARD, 10 4-COLUMN AND 1 8-COLUMN FIELDS CONTAIN- COR  16 
C            ING THE FOLLOWING INFORMATION SERIATUM -                   COR  17 
C            A)  RUN=SOME NUMERIC CODE IDENTIFYING OUTPUT .LE. 2**15,   COR  18 
C            B)  NV=NUMBER OF VARIABLES .LE. 70,                        COR  19 
C            C)  NFMT=NUMBER OF FORMAT CARDS .LE. 10,                   COR  20 
C            D)  NITER=NUMBER OF ITERATIONS, IF 0 OR BLANK NITER=25,    COR  21 
C            E)  MIND=MINIMUM NUMBER OF DIMENSIONS DESIRED.  IF BLANK ORCOR  22 
C                ZERO MIND=1,                                           COR  23 
C            F)  NDIM=MAXIMUM NUMBER OF DIMENSIONS DESIRED.  IF BLANK ORCOR  24 
C                ZERO PROGRAM WILL DETERMINE,                           COR  25 
C            G)  IFT=1 IF THETA COEFFICIENTS ARE TO BE PRINTED FOR 2 OR COR  26 
C                MORE DIMENSIONS, OTHERWISE SET TO ZERO OR LEAVE BLANK, COR  27 
C            H)  IFC=1 IF COORDINATES FOR 2 OR MORE DIMENSIONS ARE TO BECOR  28 
C                PUNCHED, OTHERWISE SET TO ZERO OR LEAVE BLANK,         COR  29 
C            I)  IFCOV=1 IF NORMALIZED (ON LARGEST VARIANCE) COVARIANCESCOR  30 
C                RATHER THAN CORRELATIONS ARE DESIRED, OTHERWISE LEAVE  COR  31 
C                BLANK OR SET TO ZERO FOR CORRELATIONS,                 COR  32 
C            J)  IFMISS=1 IF MISSING DATA, BLANK OR ZERO OTHERWISE,     COR  33 
C            K)  CODE=SOME NUMERIC CODE APPLICABLE TO ALL VARIABLES FOR COR  34 
C                WHICH MISSING DATA EXIST.  PUNCH WITH DECIMAL POINT.   COR  35 
C        5.  FORMAT CARD/S, (PUNCH '(I1,' AND DESCRIBE IN F-NOTATION    COR  36 
C            WHERE DATA APPEAR ON CARDS.  TERMINATE WITH ')').          COR  37 
C        6.  DATA CARDS - LEAVE COLUMN 1 BLANK AND PLACE DATA IN COLUMNSCOR  38 
C            2-72, RESERVING 73-80 FOR OPTIONAL ID INFORMATION.  DO NOT COR  39 
C            SPLIT A FIELD OVER 2 CARDS.  PUNCH ALL SCORES FOR 1 S ON 1 COR  40 
C            SET OF CARDS, FOLLOWED BY 2ND S, ETC.                      COR  41 
C        7.  IF THERE ARE T CARD/S, T TRAILER CARDS MUST FOLLOW DATA,   COR  42 
C            WITH A 9 PUNCHED IN COLUMN 1 OF THE FIRST TRAILER CARD.    COR  43 
C        8.  TITLE CARD FOR SSA-III PAGE HEADINGS (SEE ITEM 3 ABOVE).   COR  44 
C        9.  REPEAT 3-8 FOR ADDITONAL RUNS.                             COR  45 
C                                                                       COR  46 
C     *** REFERENCES - LINGOES, J. C.  AN IBM-7090 PROGRAM FOR GUTTMAN- COR  47 
C                        LINGOES SMALLEST SPACE ANALYSIS - III.  BEHAV. COR  48 
C                        SCI., 1966,11,75-76.                           COR  49 
C                      LINGOES, J. C. AND GUTTMAN, L.  NONMETRIC FACTOR COR  50 
C                        ANALYSIS - A RANK REDUCING ALTERNATIVE TO      COR  51 
C                        LINEAR FACTOR ANALYSIS.  MULT. BEHAV. RES.,    COR  52 
C                        1967,2,485-505.                                COR  53 
C                                                                       COR  54 
C     *** OBSERVE COMMENT CARDS FOR ADAPTING TO OTHER SYSTEMS ***       COR  55 
C                                                                       COR  56 
C                                                                       COR  57 
      DIMENSION R(71,71), D(71), FN(70), FMT(180)                       COR  58 
      COMMON R,D                                                        COR  59 
C                                                                       COR  60 
C     SUBROUTINES CALLED=MXOUT,RADIX SORT,EIGEN,PLOT,MATINV ***         COR  61 
C                                                                       COR  62 
C     TAPE ASSIGNMENTS                                                  COR  64 
      ITAPE=5                                                           COR  65 
      JTAPE=6                                                           COR  66 
      CALL REWIND (3)                                                           
      CALL REWIND (4)                                                           
      READ (ITAPE,31)                                                   COR  69 
      WRITE (JTAPE,31)                                                  COR  70 
      READ (ITAPE,32) NRUN,N,NFMT,NITER,MIND,NDIM,IFT,IFC,IFCOV,MISS,CODCOR  71 
     1E                                                                 COR  72 
      NFMT=NFMT*18                                                      COR  73 
      READ (ITAPE,33) (FMT(J),J=1,NFMT)                                 COR  74 
      NP1=N+1                                                           COR  75 
      IF (MISS) 1,12,1                                                  COR  76 
1     DO 2 J=1,N                                                        COR  77 
      D(J)=0.                                                           COR  78 
2     FN(J)=0.                                                          COR  79 
      NN=0                                                              COR  80 
3     READ (ITAPE,FMT) ITYPE,(R(NP1,J),J=1,N)                           COR  81 
      IF (ITYPE-9) 4,7,7                                                COR  82 
4     NN=NN+1                                                           COR  83 
      DO 6 J=1,N                                                        COR  84 
      IF (R(NP1,J)-CODE) 5,6,5                                          COR  85 
5     FN(J)=FN(J)+1.                                                    COR  86 
      D(J)=D(J)+R(NP1,J)                                                COR  87 
6     CONTINUE                                                          COR  88 
      WRITE (3) (R(NP1,J),J=1,N)                                                
      GO TO 3                                                           COR  90 
7     CALL REWIND (3)                                                           
      DO 8 J=1,N                                                        COR  92 
8     D(J)=D(J)/FN(J)                                                   COR  93 
      WRITE (JTAPE,34) (D(J),J=1,N)                                     COR  94 
      WRITE (JTAPE,37) (FN(J),J=1,N)                                    COR  95 
      ITYPE=0                                                           COR  96 
      DO 11 I=1,NN                                                      COR  97 
      READ (3) (R(NP1,J),J=1,N)                                                 
      DO 10 J=1,N                                                       COR  99 
      IF (R(NP1,J)-CODE) 10,9,10                                        COR 100 
9     R(NP1,J)=D(J)                                                     COR 101 
10    CONTINUE                                                          COR 102 
11    WRITE (4) ITYPE,(R(NP1,J),J=1,N)                                          
      CALL REWIND (3)                                                           
      ITYPE=9                                                           COR 105 
      WRITE (4) ITYPE, (R(NP1,J),J=1,N)                                         
      CALL REWIND (4)                                                           
12    DO 13 I=1,NP1                                                     COR 108 
      DO 13 J=1,I                                                       COR 109 
13    R(I,J)=0.                                                         COR 110 
      D(NP1)=1.                                                         COR 111 
      NN=0                                                              COR 112 
      WRITE (3) N,NITER,MIND,NDIM,IFCOV,IFT,IFC                                 
14    IF (MISS) 15,16,15                                                COR 114 
15    READ (4) ITYPE,(D(J),J=1,N)                                               
      GO TO 17                                                          COR 116 
16    READ (ITAPE,FMT) ITYPE,(D(J),J=1,N)                               COR 117 
17    IF (ITYPE-9) 18,20,20                                             COR 118 
18    NN=NN+1                                                           COR 119 
      DO 19 I=1,NP1                                                     COR 120 
      DO 19 J=1,I                                                       COR 121 
19    R(I,J)=R(I,J)+D(I)*D(J)                                           COR 122 
      GO TO 14                                                          COR 123 
20    WRITE (JTAPE,35) NRUN,N,NN                                        COR 124 
      FN(1)=R(NP1,NP1)                                                  COR 125 
      DO 21 I=1,N                                                       COR 126 
      D(I)=R(NP1,I)/FN(1)                                               COR 127 
      R(I,NP1)=SQRT(ABS(R(I,I)/FN(1)-D(I)**2))                          COR 128 
21    WRITE (JTAPE,36) I,R(NP1,I),D(I),R(I,I),R(I,NP1)                  COR 129 
      DO 22 I=1,N                                                       COR 130 
      DO 22 J=1,I                                                       COR 131 
22    R(I,J)=(R(I,J)-(R(NP1,I)*R(NP1,J))/FN(1))/FN(1)                   COR 132 
      IF (IFCOV) 23,27,23                                               COR 133 
23    SUM=0.                                                            COR 134 
      DO 25 I=1,N                                                       COR 135 
      IF (SUM-R(I,NP1)) 24,25,25                                        COR 136 
24    SUM=R(I,NP1)                                                      COR 137 
25    CONTINUE                                                          COR 138 
      SUM=SUM**2                                                        COR 139 
      DO 26 I=1,N                                                       COR 140 
      DO 26 J=1,I                                                       COR 141 
26    R(I,J)=R(I,J)/SUM                                                 COR 142 
      GO TO 29                                                          COR 143 
27    DO 28 I=1,N                                                       COR 144 
      DO 28 J=1,I                                                       COR 145 
28    R(I,J)=R(I,J)/(R(I,NP1)*R(J,NP1))                                 COR 146 
29    NM1=N-1                                                           COR 147 
      DO 30 I=1,NM1                                                     COR 148 
      IP1=I+1                                                           COR 149 
30    WRITE (3) (R(J,I),J=IP1,N)                                                
C     CALL ON NEXT CORE LOAD, I.E., THIS IS A CHAIN JOB.                COR 151 
      CALL PUNT ('-CORE2 ',0,0)                                         COR 152 
C     *** FORMAT STATEMENTS ***                                         COR 153 
C                                                                       COR 154 
31    FORMAT (72H                                                       COR 155 
     1                 )                                                COR 156 
32    FORMAT (10I4,F8.0)                                                COR 157 
33    FORMAT (18A4)                                                     COR 158 
34    FORMAT (31H0MISSING DATA MEANS BY VARIABLE/(1P7E18.7))            COR 159 
35    FORMAT (1H /1H0,16X10HRUN NO. = I5/1H0,16X19HNO. OF VARIABLES = I5COR 160 
     1/1H0,16X22HNO. OF OBSERVATIONS = I5/13H0    VAR. NO.,14X3HSUM,21X4COR 161 
     2HMEAN,18X11HSUM SQUARES,15X9HSTD. DEV.)                           COR 162 
36    FORMAT (1H0,I9,1P4E25.7)                                          COR 163 
37    FORMAT (38H0MISSING DATA SAMPLE SIZES BY VARIABLE/(7F18.0))       COR 164 
      END                                                               COR 165-
C     MATINV                                                            MIN   1 
C     PROGRAMMED BY B. S. GARBOW, ARGONNE NATIONAL LABORATORY, AND MODI-MIN   2 
C     FIED BY J. C. LINGOES (U. OF M.).                                 MIN   3 
C                                                                       MIN   4 
      SUBROUTINE MATINV (N,A,DETERM,IPIVOT,PIVOT,INDEX)                 MIN   5 
      DIMENSION A(70,70), INDEX(70,2), IPIVOT(70), PIVOT(70)            MIN   6 
      EQUIVALENCE (IROW,JROW), (ICOLUM,JCOLUM), (AMAX,T,SWAP)           MIN   7 
C                                                                       MIN   8 
C     INITIALIZATION                                                    MIN   9 
      DETERM=1.                                                         MIN  10 
      DO 1 J=1,N                                                        MIN  11 
1     IPIVOT(J)=0                                                       MIN  12 
      DO 13 I=1,N                                                       MIN  13 
C     SEARCH FOR PIVOT ELEMENT                                          MIN  14 
      AMAX=0.                                                           MIN  15 
      DO 6 J=1,N                                                        MIN  16 
      IF (IPIVOT(J)-1) 2,6,2                                            MIN  17 
2     DO 5 K=1,N                                                        MIN  18 
      IF (IPIVOT(K)-1) 3,5,17                                           MIN  19 
3     IF (ABS(AMAX)-ABS(A(J,K))) 4,5,5                                  MIN  20 
4     IROW=J                                                            MIN  21 
      ICOLUM=K                                                          MIN  22 
      AMAX=A(J,K)                                                       MIN  23 
5     CONTINUE                                                          MIN  24 
6     CONTINUE                                                          MIN  25 
      IPIVOT(ICOLUM)=IPIVOT(ICOLUM)+1                                   MIN  26 
C     INTERCHANGE ROWS TO PUT PIVOT ELEMENT ON DIAGONAL                 MIN  27 
      IF (IROW-ICOLUM) 7,9,7                                            MIN  28 
7     DETERM=-DETERM                                                    MIN  29 
      DO 8 L=1,N                                                        MIN  30 
      SWAP=A(IROW,L)                                                    MIN  31 
      A(IROW,L)=A(ICOLUM,L)                                             MIN  32 
8     A(ICOLUM,L)=SWAP                                                  MIN  33 
9     INDEX(I,1)=IROW                                                   MIN  34 
      INDEX(I,2)=ICOLUM                                                 MIN  35 
      PIVOT(I)=A(ICOLUM,ICOLUM)                                         MIN  36 
      DETERM=DETERM*PIVOT(I)                                            MIN  37 
C     DIVIDE PIVOT ROW BY PIVOT ELEMENT                                 MIN  38 
      A(ICOLUM,ICOLUM)=1.                                               MIN  39 
      DO 10 L=1,N                                                       MIN  40 
10    A(ICOLUM,L)=A(ICOLUM,L)/PIVOT(I)                                  MIN  41 
C     REDUCE NON-PIVOT ROWS                                             MIN  42 
      DO 13 L1=1,N                                                      MIN  43 
      IF (L1-ICOLUM) 11,13,11                                           MIN  44 
11    T=A(L1,ICOLUM)                                                    MIN  45 
      A(L1,ICOLUM)=0.                                                   MIN  46 
      DO 12 L=1,N                                                       MIN  47 
12    A(L1,L)=A(L1,L)-A(ICOLUM,L)*T                                     MIN  48 
13    CONTINUE                                                          MIN  49 
C     INTERCHANGE COLUMNS                                               MIN  50 
      DO 16 I=1,N                                                       MIN  51 
      L=N+1-I                                                           MIN  52 
      IF (INDEX(L,1)-INDEX(L,2)) 14,16,14                               MIN  53 
14    JROW=INDEX(L,1)                                                   MIN  54 
      JCOLUM=INDEX(L,2)                                                 MIN  55 
      DO 15 K=1,N                                                       MIN  56 
      SWAP=A(K,JROW)                                                    MIN  57 
      A(K,JROW)=A(K,JCOLUM)                                             MIN  58 
      A(K,JCOLUM)=SWAP                                                  MIN  59 
15    CONTINUE                                                          MIN  60 
16    CONTINUE                                                          MIN  61 
17    RETURN                                                            MIN  62 
      END                                                               MIN  63-
C     SSA3-CORE 2                                                       SA3   1 
C     CORE 2 FOR SSA-III AND IIIA - 6/6/66 - J. C. LINGOES.             SA3   2 
C                                                                       SA3   3 
      DIMENSION INDI(2415), INDJ(2415), VEC(2415), RP(2415), R(70,70), VSA3   4 
     1ECT(70,70), ROOT(70), INV(2415)                                   SA3   5 
      COMMON INDI,INDJ,VEC,RP,R,VECT                                    SA3   6 
      EQUIVALENCE (VEC,INV)                                             SA3   7 
C                                                                       SA3   8 
C     TAPE ASSIGNMENTS -                                                SA3  10 
      ITAPE=5                                                           SA3  11 
      JTAPE=6                                                           SA3  12 
      CALL REWIND (3)                                                           
      CALL REWIND (4)                                                           
C     READ TITLE AND PARAMETERS                                         SA3  15 
      READ (ITAPE,110)                                                  SA3  16 
      READ (3) NV,NITER,MIND,NDIM,IFCOV,IFT,IFC                                 
C     INITIALIZE                                                        SA3  18 
      MD=70                                                             SA3  19 
      ND=70                                                             SA3  20 
      NVM1=NV-1                                                         SA3  21 
      NVP1=NV+1                                                         SA3  22 
      FN=NV                                                             SA3  23 
      NEL=(NV*NVM1)/2                                                   SA3  24 
      FNEL=NEL                                                          SA3  25 
      JJ=0                                                              SA3  26 
      KK=NV                                                             SA3  27 
      U=0.                                                              SA3  28 
      A=0.                                                              SA3  29 
      DO 1 I=1,NVM1                                                     SA3  30 
      VECT(I,I)=1.                                                      SA3  31 
      R(I,I)=1.                                                         SA3  32 
      II=JJ+1                                                           SA3  33 
      KK=KK-1                                                           SA3  34 
      JJ=KK+JJ                                                          SA3  35 
      IP1=I+1                                                           SA3  36 
      READ (3) (VEC(J),J=II,JJ)                                                 
      II=II-1                                                           SA3  38 
      DO 1 K=IP1,NV                                                     SA3  39 
      II=II+1                                                           SA3  40 
      R(I,K)=VEC(II)                                                    SA3  41 
      U=U+R(I,K)**2                                                     SA3  42 
      A=A+R(I,K)                                                        SA3  43 
      VECT(K,I)=R(I,K)                                                  SA3  44 
      VECT(I,K)=VECT(K,I)                                               SA3  45 
1     R(K,I)=R(I,K)                                                     SA3  46 
      GL=SQRT(U)                                                        SA3  47 
      VECT(NV,NV)=1.                                                    SA3  48 
      R(NV,NV)=1.                                                       SA3  49 
      B=SQRT(FNEL*U-A**2)                                               SA3  50 
      U=2.*U                                                            SA3  51 
C     SAVE INPUT                                                        SA3  52 
      WRITE (4) (VEC(J),J=1,NEL)                                                
      CALL REWIND (4)                                                           
C     PRINT OUT COEFFICIENT MATRIX                                      SA3  55 
      CALL MXOUT (R,NV,0,MD)                                            SA3  56 
      IF (NITER) 3,2,3                                                  SA3  57 
2     NITER=25                                                          SA3  58 
3     ASSIGN 42 TO N1                                                   SA3  59 
C     *** SEE G-L(SSA-I) COMMENTS REGARDING SORT ROUTINE.               SA3  60 
C     SORT COEFFICIENTS HIGH TO LOW                                     SA3  61 
      CALL SORT (-1,NEL,VEC,1,INDI)                                     SA3  62 
      ITER=0                                                            SA3  63 
C     CHECK FOR ALTERNATIVE START                                       SA3  64 
      IF (IFCOV) 4,7,4                                                  SA3  65 
4     Z=0.                                                              SA3  66 
      DO 5 I=1,NVM1                                                     SA3  67 
      R(I,I)=0.                                                         SA3  68 
      IP1=I+1                                                           SA3  69 
      DO 5 J=IP1,NV                                                     SA3  70 
5     Z=Z+R(I,J)                                                        SA3  71 
      R(NV,NV)=0.                                                       SA3  72 
      Z=Z/FNEL                                                          SA3  73 
      DO 6 I=1,NVM1                                                     SA3  74 
      IP1=I+1                                                           SA3  75 
      DO 6 J=IP1,NV                                                     SA3  76 
      R(I,J)=R(I,J)-Z                                                   SA3  77 
6     R(J,I)=R(I,J)                                                     SA3  78 
      X=FN                                                              SA3  79 
      GO TO 21                                                          SA3  80 
C     CALL MATRIX INVERSION SUBROUTINE                                  SA3  81 
7     CALL MATINV (NV,VECT,DEN,INDJ(1),INDJ(71),INDJ(141))              SA3  82 
C     COMPUTE MULTIPLES                                                 SA3  83 
      DO 9 I=1,NV                                                       SA3  84 
      ROOT(I)=(VECT(I,I)-1.)/VECT(I,I)                                  SA3  85 
      IF (VECT(I,I)) 16,16,8                                            SA3  86 
8     IF (ROOT(I)-1.) 9,9,16                                            SA3  87 
9     CONTINUE                                                          SA3  88 
      DO 14 I=1,NV                                                      SA3  89 
      DO 14 J=I,NV                                                      SA3  90 
      Z=0.                                                              SA3  91 
      DO 10 K=1,NV                                                      SA3  92 
10    Z=Z+VECT(I,K)*R(J,K)                                              SA3  93 
      IF (I-J) 13,11,13                                                 SA3  94 
11    Z=ABS(Z-1.)                                                       SA3  95 
12    IF (Z-.005) 14,14,16                                              SA3  96 
13    Z=ABS(Z)                                                          SA3  97 
      GO TO 12                                                          SA3  98 
14    CONTINUE                                                          SA3  99 
      WRITE (JTAPE,111) DEN,(ROOT(J),J=1,NV)                            SA3 100 
      X=0.                                                              SA3 101 
      DO 15 I=1,NV                                                      SA3 102 
      X=X+ROOT(I)                                                       SA3 103 
      U=U+ROOT(I)**2                                                    SA3 104 
15    R(I,I)=ROOT(I)                                                    SA3 105 
      GO TO 21                                                          SA3 106 
C     COMPUTE CENTROIDS IF SINGULAR                                     SA3 107 
16    Z=0.                                                              SA3 108 
      DO 19 J=1,NV                                                      SA3 109 
      R(J,J)=0.                                                         SA3 110 
      DO 18 I=1,NV                                                      SA3 111 
      IF (I-J) 17,18,17                                                 SA3 112 
17    R(J,J)=R(J,J)+ABS(R(I,J))                                         SA3 113 
18    CONTINUE                                                          SA3 114 
19    Z=Z+R(J,J)                                                        SA3 115 
      X=0.                                                              SA3 116 
      DO 20 I=1,NV                                                      SA3 117 
      R(I,I)=R(I,I)**2/Z                                                SA3 118 
      U=U+R(I,I)**2                                                     SA3 119 
20    X=X+R(I,I)                                                        SA3 120 
C     DETERMINE UPPER-BOUND                                             SA3 121 
21    NDIM1=NDIM+1                                                      SA3 122 
      IF (NDIM) 23,22,23                                                SA3 123 
22    NDIM1=NV                                                          SA3 124 
23    WRITE (JTAPE,112)                                                 SA3 125 
C     START SSA-III ITERATIONS                                          SA3 126 
24    ITER=ITER+1                                                       SA3 127 
      H2=X/FN                                                           SA3 128 
C     CALL ON HOUSEHOLDER'S EIGENVALUE-EIGENVECTOR SUBROUTINE           SA3 129 
      CALL EIGEN (R,VECT,NV,ROOT,NDIM1,MD,VEC(1),VEC(211),VEC(281),VEC(3SA3 130 
     151),VEC(421),VEC(491))                                            SA3 131 
      NN=0                                                              SA3 132 
      MM=0                                                              SA3 133 
      TRACE=0.                                                          SA3 134 
      F1=0.                                                             SA3 135 
      F2=0.                                                             SA3 136 
      DO 27 J=1,NDIM1                                                   SA3 137 
      IF (ROOT(J)) 28,28,25                                             SA3 138 
25    NN=NN+1                                                           SA3 139 
      TRACE=TRACE+ROOT(J)                                               SA3 140 
      IF (ROOT(J)-H2) 27,26,26                                          SA3 141 
26    MM=MM+1                                                           SA3 142 
27    CONTINUE                                                          SA3 143 
28    IF (NDIM) 30,29,30                                                SA3 144 
29    NDIM=NN+(MM-NN)/2                                                 SA3 145 
      GO TO 32                                                          SA3 146 
30    IF (NDIM-NN) 32,32,31                                             SA3 147 
31    NDIM=NN                                                           SA3 148 
32    NDIM1=NDIM+1                                                      SA3 149 
      DO 33 J=1,NDIM                                                    SA3 150 
      F1=F1+ROOT(J)                                                     SA3 151 
33    F2=F2+ROOT(J)**2                                                  SA3 152 
C     COMPUTE THETAS                                                    SA3 153 
      II=0                                                              SA3 154 
      DO 35 I=1,NVM1                                                    SA3 155 
      IP1=I+1                                                           SA3 156 
      DO 35 J=IP1,NV                                                    SA3 157 
      R(I,J)=0.                                                         SA3 158 
      DO 34 K=1,NDIM                                                    SA3 159 
34    R(I,J)=R(I,J)+VECT(I,K)*VECT(J,K)                                 SA3 160 
      II=II+1                                                           SA3 161 
35    VEC(II)=R(I,J)                                                    SA3 162 
      READ (4) (R(J,1),J=1,NEL)                                                 
      CALL REWIND (4)                                                           
C     COMPUTE LINEAR TRANSFORMATION                                     SA3 165 
      PHI=0.                                                            SA3 166 
      DEN=0.                                                            SA3 167 
      Y=0.                                                              SA3 168 
      DO 36 J=1,NEL                                                     SA3 169 
      PHI=PHI+VEC(J)                                                    SA3 170 
      DEN=DEN+VEC(J)**2                                                 SA3 171 
36    Y=Y+VEC(J)*R(J,1)                                                 SA3 172 
      Q=FNEL*DEN-PHI**2                                                 SA3 173 
      V=(FNEL*Y-PHI*A)/Q                                                SA3 174 
      Z=(DEN*A-Y*PHI)/Q                                                 SA3 175 
C     IF ALTERNATIVE THEN NORM                                          SA3 176 
      IF (IFCOV) 37,39,37                                               SA3 177 
37    GLL=SQRT(DEN)                                                     SA3 178 
      DO 38 J=1,NEL                                                     SA3 179 
38    VEC(J)=(VEC(J)/GLL)*GL                                            SA3 180 
      GO TO 41                                                          SA3 181 
39    DO 40 J=1,NEL                                                     SA3 182 
40    VEC(J)=V*VEC(J)+Z                                                 SA3 183 
41    GO TO N1, (42,43)                                                 SA3 184 
C     *** SEE SORT COMMENTS.                                            SA3 185 
42    CALL SORT (0,0,VEC,1,INDJ)                                        SA3 186 
      ASSIGN 43 TO N1                                                   SA3 187 
      GO TO 44                                                          SA3 188 
C     *** SORT CALL - SEE REMARKS.                                      SA3 189 
43    CALL SORT (1,0,VEC,1,INDJ)                                        SA3 190 
C     COMPUTE RANK-IMAGES                                               SA3 191 
44    DO 45 J=1,NEL                                                     SA3 192 
      II=INDI(J)                                                        SA3 193 
      JJ=INDJ(J)                                                        SA3 194 
45    RP(II)=VEC(JJ)                                                    SA3 195 
C     COMPUTE COEFFICIENT OF MONOTONICITY                               SA3 196 
      PHI=0.                                                            SA3 197 
      DEN=0.                                                            SA3 198 
      Y=0.                                                              SA3 199 
      DO 46 J=1,NEL                                                     SA3 200 
      Y=Y+VEC(J)                                                        SA3 201 
      DEN=DEN+VEC(J)**2                                                 SA3 202 
46    PHI=PHI+RP(J)*VEC(J)                                              SA3 203 
      PHI=FNEL*PHI                                                      SA3 204 
      DEN=FNEL*DEN                                                      SA3 205 
      DEN=DEN-Y**2                                                      SA3 206 
      IF (ABS(DEN)-.00001) 47,47,48                                     SA3 207 
47    WRITE (JTAPE,113)                                                 SA3 208 
      GO TO 127                                                         SA3 209 
48    PHI=(PHI-Y**2)/DEN                                                SA3 210 
      IF (PHI-1.) 50,50,49                                              SA3 211 
49    PHI=1.                                                            SA3 212 
50    TRACE=TRACE/X                                                     SA3 213 
      F1=F1/X                                                           SA3 214 
      F2=F2/U                                                           SA3 215 
C     PRINT STATISTICS                                                  SA3 216 
      WRITE (JTAPE,114) ITER,MM,NN,H2,TRACE,PHI,F1,F2                   SA3 217 
      IF (ITER-1) 52,51,52                                              SA3 218 
C     PRINT INITIAL SOLUTION                                            SA3 219 
51    WRITE (JTAPE,110)                                                 SA3 220 
      WRITE (JTAPE,115)                                                 SA3 221 
      PRTR=TRACE+TRACE                                                  SA3 222 
      GO TO 61                                                          SA3 223 
C     TEST FOR TERMINATION                                              SA3 224 
52    IF (1.-PHI) 60,60,53                                              SA3 225 
53    IF (ABS(TRACE-PRTR)-.000001) 60,54,54                             SA3 226 
54    PRTR=TRACE                                                        SA3 227 
      IF (ITER-NITER) 56,60,60                                          SA3 228 
55    WRITE (JTAPE,112)                                                 SA3 229 
C     INITIALIZE FOR CONTINUATION                                       SA3 230 
56    II=0                                                              SA3 231 
      U=0.                                                              SA3 232 
      DO 57 I=1,NVM1                                                    SA3 233 
      IP1=I+1                                                           SA3 234 
      DO 57 J=IP1,NV                                                    SA3 235 
      II=II+1                                                           SA3 236 
      R(I,J)=RP(II)                                                     SA3 237 
      U=U+R(I,J)**2                                                     SA3 238 
57    R(J,I)=R(I,J)                                                     SA3 239 
      U=2.*U                                                            SA3 240 
      X=0.                                                              SA3 241 
      DO 59 I=1,NV                                                      SA3 242 
      R(I,I)=0.                                                         SA3 243 
      DO 58 J=1,NDIM                                                    SA3 244 
58    R(I,I)=R(I,I)+VECT(I,J)**2                                        SA3 245 
      U=U+R(I,I)**2                                                     SA3 246 
59    X=X+R(I,I)                                                        SA3 247 
      GO TO 24                                                          SA3 248 
C     PRINT FINAL CONFIGURATION                                         SA3 249 
60    WRITE (JTAPE,110)                                                 SA3 250 
      WRITE (JTAPE,116)                                                 SA3 251 
C     PRINT X AND STATISTICS                                            SA3 252 
61    II=NDIM                                                           SA3 253 
62    JJ=1                                                              SA3 254 
      KK=18                                                             SA3 255 
63    IF (KK-II) 66,65,64                                               SA3 256 
64    KK=II                                                             SA3 257 
65    NN=0                                                              SA3 258 
      GO TO 67                                                          SA3 259 
66    NN=1                                                              SA3 260 
67    WRITE (JTAPE,117) (NO,NO=JJ,KK)                                   SA3 261 
      WRITE (JTAPE,118)                                                 SA3 262 
      DO 68 I=1,NV                                                      SA3 263 
68    WRITE (JTAPE,119) I,(VECT(I,J),J=JJ,KK)                           SA3 264 
      WRITE (JTAPE,120) (ROOT(J),J=JJ,KK)                               SA3 265 
      IF (NN) 69,70,69                                                  SA3 266 
69    JJ=KK+1                                                           SA3 267 
      KK=KK+18                                                          SA3 268 
      WRITE (JTAPE,110)                                                 SA3 269 
      GO TO 63                                                          SA3 270 
70    IF (ITER) 71,95,71                                                SA3 271 
71    READ (4) (R(J,1),J=1,NEL)                                                 
      CALL REWIND (4)                                                           
      CD=PHI**2                                                         SA3 274 
      PHI=SQRT(1.-CD)                                                   SA3 275 
      WRITE (JTAPE,121) PHI                                             SA3 276 
      X=0.                                                              SA3 277 
      DO 72 J=1,NEL                                                     SA3 278 
72    X=X+R(J,1)*VEC(J)                                                 SA3 279 
      DEN=SQRT(DEN)                                                     SA3 280 
      X=FNEL*X                                                          SA3 281 
      DEN=(X-A*Y)/(B*DEN)                                               SA3 282 
      CD=1.-DEN**2/CD                                                   SA3 283 
      WRITE (JTAPE,122) DEN,V,Z,CD                                      SA3 284 
      IF (ITER-1) 73,55,73                                              SA3 285 
C     NORMAL VARIMAX ROTATION                                           SA3 286 
73    IF (II-MM) 75,75,74                                               SA3 287 
74    II=MM+1                                                           SA3 288 
      GO TO 76                                                          SA3 289 
75    IF (II-1) 127,127,76                                              SA3 290 
76    DO 78 I=1,NV                                                      SA3 291 
      VEC(I)=0.                                                         SA3 292 
      DO 77 J=1,II                                                      SA3 293 
77    VEC(I)=VEC(I)+VECT(I,J)**2                                        SA3 294 
      VEC(I)=SQRT(VEC(I))                                               SA3 295 
      DO 78 K=1,II                                                      SA3 296 
78    VECT(I,K)=VECT(I,K)/VEC(I)                                        SA3 297 
      M=II-1                                                            SA3 298 
      ITER=50                                                           SA3 299 
79    DO 85 I=1,M                                                       SA3 300 
      IP1=I+1                                                           SA3 301 
      DO 85 K=IP1,II                                                    SA3 302 
      SUMU=0.                                                           SA3 303 
      SUMV=0.                                                           SA3 304 
      SUMUV=0.                                                          SA3 305 
      USMVS=0.                                                          SA3 306 
      DO 80 J=1,NV                                                      SA3 307 
      U=VECT(J,I)**2-VECT(J,K)**2                                       SA3 308 
      V=2.*VECT(J,I)*VECT(J,K)                                          SA3 309 
      SUMU=U+SUMU                                                       SA3 310 
      SUMV=V+SUMV                                                       SA3 311 
      Q=U**2                                                            SA3 312 
      S=V**2                                                            SA3 313 
      SUMUV=U*V+SUMUV                                                   SA3 314 
80    USMVS=Q-S+USMVS                                                   SA3 315 
      Y=2.*(FN*SUMUV-SUMU*SUMV)                                         SA3 316 
      X=FN*USMVS-SUMU**2+SUMV**2                                        SA3 317 
      Z=ATAN2(Y,X)                                                      SA3 318 
      IF (Z-3.1415927) 82,82,81                                         SA3 319 
81    Z=Z-6.2831853                                                     SA3 320 
82    Z=.25*Z                                                           SA3 321 
      IF (ABS(Z)-.001) 85,85,83                                         SA3 322 
83    F1=COS(Z)                                                         SA3 323 
      F2=SIN(Z)                                                         SA3 324 
      DO 84 J=1,NV                                                      SA3 325 
      ST=VECT(J,I)*F1+VECT(J,K)*F2                                      SA3 326 
      VECT(J,K)=-VECT(J,I)*F2+VECT(J,K)*F1                              SA3 327 
84    VECT(J,I)=ST                                                      SA3 328 
85    CONTINUE                                                          SA3 329 
      ITER=ITER-1                                                       SA3 330 
      IF (ITER) 86,86,79                                                SA3 331 
86    WRITE (JTAPE,110)                                                 SA3 332 
      WRITE (JTAPE,123)                                                 SA3 333 
      DO 87 I=1,NV                                                      SA3 334 
      DO 87 J=1,II                                                      SA3 335 
87    VECT(I,J)=VECT(I,J)*VEC(I)                                        SA3 336 
      DO 88 J=1,II                                                      SA3 337 
      ROOT(J)=0.                                                        SA3 338 
      DO 88 I=1,NV                                                      SA3 339 
88    ROOT(J)=ROOT(J)+VECT(I,J)**2                                      SA3 340 
      DO 93 I=1,M                                                       SA3 341 
      DEN=0.                                                            SA3 342 
      DO 90 J=I,II                                                      SA3 343 
      IF (DEN-ROOT(J)) 89,90,90                                         SA3 344 
89    DEN=ROOT(J)                                                       SA3 345 
      JJ=J                                                              SA3 346 
90    CONTINUE                                                          SA3 347 
      IF (JJ-I) 91,93,91                                                SA3 348 
91    DO 92 K=1,NV                                                      SA3 349 
      DEN=VECT(K,I)                                                     SA3 350 
      VECT(K,I)=VECT(K,JJ)                                              SA3 351 
92    VECT(K,JJ)=DEN                                                    SA3 352 
      DEN=ROOT(I)                                                       SA3 353 
      ROOT(I)=ROOT(JJ)                                                  SA3 354 
      ROOT(JJ)=DEN                                                      SA3 355 
93    CONTINUE                                                          SA3 356 
      DO 94 I=1,NV                                                      SA3 357 
      VEC(I)=0.                                                         SA3 358 
      DO 94 J=1,II                                                      SA3 359 
94    VEC(I)=VEC(I)+VECT(I,J)**2                                        SA3 360 
      WRITE (JTAPE,124) (VEC(I),I=1,NV)                                 SA3 361 
      GO TO 62                                                          SA3 362 
95    CALL PLOT (VECT,INV(1),INV(71),INV(141),INV(211),INV(281),NV,II,MDSA3 363 
     1,ND)                                                              SA3 364 
      U=0.                                                              SA3 365 
      DEN=0.                                                            SA3 366 
      DO 97 I=1,NVM1                                                    SA3 367 
      IP1=I+1                                                           SA3 368 
      DO 97 J=IP1,NV                                                    SA3 369 
      R(I,J)=0.                                                         SA3 370 
      DO 96 K=1,NDIM                                                    SA3 371 
96    R(I,J)=R(I,J)+VECT(I,K)*VECT(J,K)                                 SA3 372 
      U=U+R(I,J)**2                                                     SA3 373 
      DEN=DEN+R(I,J)                                                    SA3 374 
97    R(J,I)=R(I,J)                                                     SA3 375 
      U=2.*U                                                            SA3 376 
      X=0.                                                              SA3 377 
      DO 99 I=1,NV                                                      SA3 378 
      R(I,I)=0.                                                         SA3 379 
      DO 98 J=1,NDIM                                                    SA3 380 
98    R(I,I)=R(I,I)+VECT(I,J)**2                                        SA3 381 
      X=X+R(I,I)                                                        SA3 382 
99    U=U+R(I,I)**2                                                     SA3 383 
C     PRINT OUT THETAS                                                  SA3 384 
      IF (IFT) 100,101,100                                              SA3 385 
100   CALL MXOUT (R,NV,1,MD)                                            SA3 386 
C     PUNCH OUT COORDINATES                                             SA3 387 
101   IF (IFC) 102,104,102                                              SA3 388 
102   DO 103 I=1,NV                                                     SA3 389 
103   PUNCH 125, (VECT(I,K),K=1,NDIM)                                   SA3 390 
C     DETERMINE IF A DIMENSION IS TO BE DROPPED                         SA3 391 
104   IF (NDIM-MIND) 127,127,105                                        SA3 392 
105   Y=0.                                                              SA3 393 
      DEN=DEN/FNEL                                                      SA3 394 
      DO 107 I=1,NVM1                                                   SA3 395 
      IP1=I+1                                                           SA3 396 
      DO 107 J=IP1,NV                                                   SA3 397 
      IF (ABS(R(I,J)-DEN)-.1) 106,106,107                               SA3 398 
106   Y=Y+1.                                                            SA3 399 
107   CONTINUE                                                          SA3 400 
      Y=Y/FNEL                                                          SA3 401 
      IF (Y-.6) 109,108,108                                             SA3 402 
108   WRITE (JTAPE,126) Y,DEN                                           SA3 403 
      GO TO 127                                                         SA3 404 
109   NDIM1=NDIM                                                        SA3 405 
      NDIM=NDIM-1                                                       SA3 406 
      GO TO 23                                                          SA3 407 
C     SUBSTITUTE YOUR OWN PROGRAM CALL FOR MULTIPLE CORE LOADS OR CHAIN SA3 408 
C     JOBS.                                                             SA3 409 
127   CALL PUNT('-CORE1 ',0,0)                                          SA3 410 
C     *** FORMAT STATEMENTS ***                                         SA3 411 
C                                                                       SA3 412 
110   FORMAT (72H                                                       SA3 413 
     1                 )                                                SA3 414 
111   FORMAT (14H1DETERMINANT =,E12.6/30H0SQUARED MULTIPLE CORRELATIONS/SA3 415 
     1(10F10.4))                                                        SA3 416 
112   FORMAT (11H1 ITERATION,5X17HNO. ROOTS .GE. H2,5X15HNO. ROOTS .G. 0SA3 417 
     1,5X11HCOMMUNALITY,5X11HTRACE PROP.,5X13HR(R(T),R*(T)),5X5HALPHA,5XSA3 418 
     24HBETA/1H ,122(1H-))                                              SA3 419 
113   FORMAT (107H0DEGENERATE SOLUTION.  SET NDIM=NO. ROOTS .G. 0 ON ITESA3 420 
     1RATION 1 OF FIRST CYCLE AND MIND=YOUR PRESENT NDIM+1./88H IF, HOWESA3 421 
     2VER, A SATISFACTORY SOLUTION HAS ALREADY BEEN GIVEN IN HIGHER SPACSA3 422 
     3E, FORGET IT.)                                                    SA3 423 
114   FORMAT (I7,9XI9,13XI8,12XF8.4,8XF8.4,8XF9.4,F14.4,F9.4)           SA3 424 
115   FORMAT (40H0PRINCIPAL AXES OF INITIAL CONFIGURATION)              SA3 425 
116   FORMAT (62H0PRINCIPAL AXES COORDINATES OF FINAL SOLUTION FOR G-L(SSA3 426 
     1SA-III))                                                          SA3 427 
117   FORMAT (10H0DIMENSION/1H0,I12,17I7)                               SA3 428 
118   FORMAT (6X126(1H-))                                               SA3 429 
119   FORMAT (I4,2X18F7.4)                                              SA3 430 
120   FORMAT (6H0ROOT=,18F7.2)                                          SA3 431 
121   FORMAT (28H0COEFFICIENT OF ALIENATION =,E12.6)                    SA3 432 
122   FORMAT (15H0R(R(0),R(T)) =,E12.6/4H0Y =,F9.6,3HX +,E12.6/29H0COEFFSA3 433 
     1ICIENT OF DEFORMATION =,E12.6)                                    SA3 434 
123   FORMAT (28H0NORMALIZED VARIMAX ROTATION)                          SA3 435 
124   FORMAT (14H0COMMUNALITIES/(10F10.4))                              SA3 436 
125   FORMAT (9F8.5)                                                    SA3 437 
126   FORMAT (6H1SINCE,F6.3,56H OF THE COEFFICIENTS ARE WITHIN + OR -.10SA3 438 
     1 OF THE MEAN OF,F7.4,43H NO FURTHER REDUCTION IN NDIM IS WARRANTEDSA3 439 
     2./87H IF A SATISFACTORY SOLUTION IN HIGHER SPACE HAS NOT BEEN ACHISA3 440 
     3EVED ADJUST NDIM AND MIND.)                                       SA3 441 
      END                                                               SA3 442-
1G-L(SSA-III) OF TWO ORTHOGONAL MSA SCALES.                                     
   1   8   1       2   4   1                                                    
(I1,8F1.0)                                                                      
 11101000                                                                       
 10001111                                                                       
 11111110                                                                       
 11101111                                                                       
 00001100                                                                       
 10001000                                                                       
 00001110                                                                       
 11111100                                                                       
 10000000                                                                       
 11001100                                                                       
 00000000                                                                       
 11001111                                                                       
 10001110                                                                       
 11001110                                                                       
 11000000                                                                       
 11001000                                                                       
 11101100                                                                       
 11111000                                                                       
 11101110                                                                       
 00001000                                                                       
 10001100                                                                       
 11110000                                                                       
 00001111                                                                       
 11100000                                                                       
 11111111                                                                       
9                                                                               
1G-L(SSA-III) OF TWO ORTHOGONAL MSA SCALES.                                     
C     SSA3A-CORE 1                                                      S3A   1 
C     SSA-IIIA - COEFFICIENT INPUT.  CORE 1.                            S3A   2 
C                                                                       S3A   3 
C     DECK SET-UP FOR G-L(SSA-IIIA) -                                   S3A   4 
C                                                                       S3A   5 
C        1.  SYSTEM ID CARDS.                                           S3A   6 
C        2.  BINARY PROGRAM.                                            S3A   7 
C        3.  PARAMETER CARD, 8 4-COLUMN FIELDS CONTAINING THE FOLLOWING S3A   8 
C            INFORMATION SERIATUM -                                     S3A   9 
C            A)  NV=NUMBER OF VARIABLES, .LE. 70,                       S3A  10 
C            B)  NFMT=NUMBER OF FORMAT CARDS, .LE. 10,                  S3A  11 
C            C)  NITER=NUMBER OF ITERATIONS (SEE SSA-III),              S3A  12 
C            D)  MIND=MINIMUM NUMBER OF DIMENSIONS (SEE SSA-III),       S3A  13 
C            E)  NDIM=MAXIMUM NUMBER OF DIMENSIONS (SEE SSA-III),       S3A  14 
C            F)  IFNOM=1 IF MEAN OF INPUT VALUES IS NOT TO BE PRESERVED,S3A  15 
C                OTHERWISE SET TO ZERO OR LEAVE BLANK,                  S3A  16 
C            G)  IFT=1 IF THETA COEFFICIENTS ARE TO BE PRINTED FOR 2 OR S3A  17 
C                MORE DIMENSIONS, OTHERWISE SET TO ZERO OR LEAVE BLANK, S3A  18 
C            H)  IFC=1 IF COORDINATES FOR 2 OR MORE DIMENSIONS ARE TO BES3A  19 
C                PUNCHED, OTHERWISE SET TO ZERO OR LEAVE BLANK.         S3A  20 
C        4.  FORMAT CARD/S (SEE SSA-I).                                 S3A  21 
C        5.  DATA CARDS (SAME AS SSA-I).                                S3A  22 
C        6.  TITLE CARD FOR SSA-IIIA OUTPUT.                            S3A  23 
C        7.  REPEAT ITEMS 3-6 FOR ADDITONAL RUNS.                       S3A  24 
C                                                                       S3A  25 
C     *** OBSERVE COMMENT CARDS FOR ADAPTING TO OTHER SYSTEMS.          S3A  26 
C                                                                       S3A  27 
      DIMENSION R(70,70), FMT(180)                                      S3A  28 
C                                                                       S3A  29 
C     TAPE ASSIGNMENTS -                                                S3A  31 
      ITAPE=5                                                           S3A  32 
      CALL REWIND (3)                                                           
      READ (ITAPE,2) NV,NFMT,NITER,MIND,NDIM,IFNOM,IFT,IFC              S3A  34 
      NFMT=NFMT*18                                                      S3A  35 
      READ (ITAPE,3) (FMT(J),J=1,NFMT)                                  S3A  36 
      WRITE (3) NV,NITER,MIND,NDIM,IFNOM,IFT,IFC                                
      NVM1=NV-1                                                         S3A  38 
      DO 1 I=1,NVM1                                                     S3A  39 
      IP1=I+1                                                           S3A  40 
      READ (ITAPE,FMT) (R(I,J),J=IP1,NV)                                S3A  41 
1     WRITE (3) (R(I,K),K=IP1,NV)                                               
      CALL REWIND (3)                                                           
C     CALL ON SUBROUTINE FOR MULTIPLE CORE LOADS, I.E., THIS IS CORE 1  S3A  44 
C     OF A CHAIN JOB.                                                   S3A  45 
      CALL PUNT ('-CORE2 ',0,0)                                         S3A  46 
C     *** FORMAT STATEMENTS ***                                         S3A  47 
C                                                                       S3A  48 
2     FORMAT (8I4)                                                      S3A  49 
3     FORMAT (18A4)                                                     S3A  50 
      END                                                               S3A  51-
   8   1 150   2   4       1                                                    
(7F3.3)                                                                         
846805859473398301382                                                           
881826376326277415                                                              
801380319237345                                                                 
436329327365                                                                    
762730629                                                                       
583577                                                                          
539                                                                             
1CORRELATIONS AMONG 8 PHYSICAL VARIABLES FOR 305 GIRLS (HARMON-TBL.5.3).        
