C     MAC1-CORE 1                                                       CD1   1 
C     LINGOES MULTIVARIATE ANALYSIS OF CONTINGENCIES - CORE 1 (3/15/63) CD1   2 
C                                                                       CD1   3 
C     PROGRAM CAN BE REDIMENSIONED FOR ALL VALUES OF NS AND NV THAT MEETCD1   4 
C     THE INEQUALITY - NV((NS+1)+NV) .L. 22,000                         CD1   5 
C                                                                       CD1   6 
      DIMENSION R(1001,20), MATR(1001,20), MPLOT(21,21), EPLOT(21,21), MCD1   7 
     1P(21), FMT(18)                                                    CD1   8 
      EQUIVALENCE (R,MATR), (MPLOT,EPLOT)                               CD1   9 
      COMMON R,MPLOT                                                    CD1  10 
C                                                                       CD1  11 
C     TAPE ASSIGNMENTS -                                                CD1  13 
      ITAPE=5                                                           CD1  14 
      JTAPE=6                                                           CD1  15 
      READ (ITAPE,65)                                                   CD1  16 
      WRITE (JTAPE,65)                                                  CD1  17 
      READ (ITAPE,66) NV,NS,IFCODE,MAX,NCAT,IFCDS,CODE                  CD1  18 
      READ (ITAPE,67) (FMT(I),I=1,18)                                   CD1  19 
      DO 1 I=1,NS                                                       CD1  20 
1     READ (ITAPE,FMT) (R(I,J),J=1,NV)                                  CD1  21 
      CALL REWIND (3)                                                   CD1  22 
      FNS=NS                                                            CD1  23 
      NSP1=NS+1                                                         CD1  24 
      IFCODE=IFCODE+1                                                   CD1  25 
      GO TO (2,20), IFCODE                                              CD1  26 
C     CHECK FOR MISSING DATA AND SUBSTITUTE MEANS IF THEY EXIST         CD1  27 
2     IF (CODE) 3,11,3                                                  CD1  28 
3     DO 10 J=1,NV                                                      CD1  29 
      COUNT=0.                                                          CD1  30 
      SUM=0.                                                            CD1  31 
      DO 6 I=1,NS                                                       CD1  32 
      IF (R(I,J)-CODE) 5,4,5                                            CD1  33 
4     COUNT=COUNT+1.                                                    CD1  34 
      GO TO 6                                                           CD1  35 
5     SUM=SUM+R(I,J)                                                    CD1  36 
6     CONTINUE                                                          CD1  37 
      IF (COUNT) 7,10,7                                                 CD1  38 
7     SUM=SUM/(FNS-COUNT)                                               CD1  39 
      DO 9 I=1,NS                                                       CD1  40 
      IF (R(I,J)-CODE) 9,8,9                                            CD1  41 
8     R(I,J)=SUM                                                        CD1  42 
9     CONTINUE                                                          CD1  43 
10    CONTINUE                                                          CD1  44 
C     COMPUTE CODED SCORES FOR EACH VARIABLE                            CD1  45 
11    WRITE (JTAPE,68)                                                  CD1  46 
      PGRPS=MAX                                                         CD1  47 
      DO 19 J=1,NV                                                      CD1  48 
      BIG=0.                                                            CD1  49 
      SMALL=10000.                                                      CD1  50 
      DO 15 I=1,NS                                                      CD1  51 
      IF (BIG-R(I,J)) 12,13,13                                          CD1  52 
12    BIG=R(I,J)                                                        CD1  53 
13    IF (R(I,J)-SMALL) 14,15,15                                        CD1  54 
14    SMALL=R(I,J)                                                      CD1  55 
15    CONTINUE                                                          CD1  56 
      CODE=(BIG-SMALL+1.)/PGRPS                                         CD1  57 
      WRITE (JTAPE,69) J,SMALL,BIG,CODE                                 CD1  58 
      DO 18 I=1,NS                                                      CD1  59 
      R(I,J)=R(I,J)-SMALL                                               CD1  60 
      DO 17 K=1,21                                                      CD1  61 
      R(I,J)=R(I,J)-CODE                                                CD1  62 
      IF (R(I,J)) 16,17,17                                              CD1  63 
16    MATR(I,J)=K                                                       CD1  64 
      GO TO 18                                                          CD1  65 
17    CONTINUE                                                          CD1  66 
      MATR(I,J)=21                                                      CD1  67 
18    CONTINUE                                                          CD1  68 
19    CONTINUE                                                          CD1  69 
C     SET FREQUENCIES FOR EACH CATEGORY ACCORDING TO PARAMETER          CD1  70 
20    IF (NCAT) 50,50,21                                                CD1  71 
21    DO 49 J=1,NV                                                      CD1  72 
      DO 22 K=1,21                                                      CD1  73 
22    MP(K)=0                                                           CD1  74 
      DO 23 I=1,NS                                                      CD1  75 
      KK=MATR(I,J)                                                      CD1  76 
23    MP(KK)=1                                                          CD1  77 
      KK=0                                                              CD1  78 
      DO 25 L=1,21                                                      CD1  79 
      IF (MP(L)) 25,25,24                                               CD1  80 
24    KK=KK+1                                                           CD1  81 
      MP(L)=KK                                                          CD1  82 
25    CONTINUE                                                          CD1  83 
      LL=KK-1                                                           CD1  84 
      DO 26 M=1,NS                                                      CD1  85 
      INDEXI=MATR(M,J)                                                  CD1  86 
26    MATR(M,J)=MP(INDEXI)                                              CD1  87 
      DO 27 K=1,21                                                      CD1  88 
27    MP(K)=0                                                           CD1  89 
      DO 28 I=1,NS                                                      CD1  90 
      INDEXI=MATR(I,J)                                                  CD1  91 
28    MP(INDEXI)=MP(INDEXI)+1                                           CD1  92 
      DO 38 K=2,LL                                                      CD1  93 
      KM1=K                                                             CD1  94 
      IF (MP(K)-NCAT) 29,38,38                                          CD1  95 
29    KM1=KM1-1                                                         CD1  96 
      IF (MP(KM1)) 30,29,30                                             CD1  97 
30    KP1=K+1                                                           CD1  98 
      IF (MP(KM1)-MP(KP1)) 31,34,34                                     CD1  99 
31    MP(KM1)=MP(KM1)+MP(K)                                             CD1 100 
      DO 33 I=1,NS                                                      CD1 101 
      IF (MATR(I,J)-K) 33,32,33                                         CD1 102 
32    MATR(I,J)=KM1                                                     CD1 103 
33    CONTINUE                                                          CD1 104 
      GO TO 37                                                          CD1 105 
34    MP(KP1)=MP(KP1)+MP(K)                                             CD1 106 
      DO 36 I=1,NS                                                      CD1 107 
      IF (MATR(I,J)-K) 36,35,36                                         CD1 108 
35    MATR(I,J)=KP1                                                     CD1 109 
36    CONTINUE                                                          CD1 110 
37    MP(K)=0                                                           CD1 111 
38    CONTINUE                                                          CD1 112 
      IF (MP(1)-NCAT) 39,44,44                                          CD1 113 
39    K=1                                                               CD1 114 
40    K=K+1                                                             CD1 115 
      IF (MP(K)) 41,40,41                                               CD1 116 
41    DO 43 I=1,NS                                                      CD1 117 
      IF (MATR(I,J)-1) 43,42,43                                         CD1 118 
42    MATR(I,J)=K                                                       CD1 119 
43    CONTINUE                                                          CD1 120 
44    LL=LL+1                                                           CD1 121 
      IF (MP(LL)-NCAT) 45,49,49                                         CD1 122 
45    LL=LL-1                                                           CD1 123 
      IF (MP(LL)) 46,45,46                                              CD1 124 
46    DO 48 I=1,NS                                                      CD1 125 
      IF (MATR(I,J)-KK) 48,47,48                                        CD1 126 
47    MATR(I,J)=LL                                                      CD1 127 
48    CONTINUE                                                          CD1 128 
49    CONTINUE                                                          CD1 129 
C     REPLACE CODED SCORES WITH COMPACT RANKS                           CD1 130 
50    DO 55 J=1,NV                                                      CD1 131 
      DO 51 K=1,21                                                      CD1 132 
51    MP(K)=0                                                           CD1 133 
      DO 52 I=1,NS                                                      CD1 134 
      KK=MATR(I,J)                                                      CD1 135 
52    MP(KK)=1                                                          CD1 136 
      KK=0                                                              CD1 137 
      DO 54 L=1,21                                                      CD1 138 
      IF (MP(L)) 54,54,53                                               CD1 139 
53    KK=KK+1                                                           CD1 140 
      MP(L)=KK                                                          CD1 141 
54    CONTINUE                                                          CD1 142 
      MATR(NSP1,J)=KK                                                   CD1 143 
      DO 55 M=1,NS                                                      CD1 144 
      KK=MATR(M,J)                                                      CD1 145 
55    MATR(M,J)=MP(KK)                                                  CD1 146 
      NVM1=NV-1                                                         CD1 147 
      WRITE (JTAPE,70)                                                  CD1 148 
      WRITE (JTAPE,71) (KK,KK=1,21)                                     CD1 149 
      DO 58 I=1,NV                                                      CD1 150 
      LL=MATR(NSP1,I)                                                   CD1 151 
      DO 56 J=1,LL                                                      CD1 152 
56    MP(J)=0                                                           CD1 153 
      DO 57 K=1,NS                                                      CD1 154 
      INDEXI=MATR(K,I)                                                  CD1 155 
57    MP(INDEXI)=MP(INDEXI)+1                                           CD1 156 
58    WRITE (JTAPE,72) I,(MP(L),L=1,LL)                                 CD1 157 
      CALL REWIND (9)                                                   CD1 158 
      WRITE (3) NV,NVM1,NS,FNS,(MATR(NSP1,J),J=1,NV)                    CD1 159 
      DO 61 I=1,NVM1                                                    CD1 160 
      NC=MATR(NSP1,I)                                                   CD1 161 
      IP1=I+1                                                           CD1 162 
      DO 61 J=IP1,NV                                                    CD1 163 
      NR=MATR(NSP1,J)                                                   CD1 164 
      DO 59 K=1,NR                                                      CD1 165 
      DO 59 L=1,NC                                                      CD1 166 
59    MPLOT(K,L)=0                                                      CD1 167 
      DO 60 M=1,NS                                                      CD1 168 
      INDEXI=MATR(M,J)                                                  CD1 169 
      INDEXJ=MATR(M,I)                                                  CD1 170 
60    EPLOT(INDEXI,INDEXJ)=EPLOT(INDEXI,INDEXJ)+1.                      CD1 171 
61    WRITE (3) ((EPLOT(L,K),K=1,NC),L=1,NR)                            CD1 172 
      DO 63 I=1,NS                                                      CD1 173 
      IF (IFCDS) 63,63,62                                               CD1 174 
62    PUNCH 64, I,(MATR(I,K),K=1,NV)                                    CD1 175 
63    WRITE (9) (MATR(I,J),J=1,NV)                                      CD1 176 
C     CALL ON MULTIPLE CORE LOAD SUBROUTINE.                            CD1 177 
      CALL PUNT('-CORE2 ',0,0)                                          CD1 178 
C     *** FORMAT STATEMENTS ***                                         CD1 179 
C                                                                       CD1 180 
64    FORMAT (I4,34I2/(36I2))                                           CD1 181 
65    FORMAT (72H                                                       CD1 182 
     1                 )                                                CD1 183 
66    FORMAT (6I4,F8.4)                                                 CD1 184 
67    FORMAT (18A4)                                                     CD1 185 
68    FORMAT (10H0 VARIABLE,10X13HSCORE   RANGE,10X14HCODED INTERVAL/1H CD1 186 
     1,57(1H-)/1H )                                                     CD1 187 
69    FORMAT (I7,E17.6,4H TO ,E12.6,E16.6)                              CD1 188 
70    FORMAT (1H1,43X44HFREQUENCY DISTRIBUTION FOR RANKED CODED DATA)   CD1 189 
71    FORMAT (6H0 VAR.,21I6/1H ,131(1H-)/1H )                           CD1 190 
72    FORMAT (22I6)                                                     CD1 191 
      END                                                               CD1 192-
C     MAC1-CORE 2                                                       SL1   1 
C     LINGOES-GUTTMAN SIMULTANEOUS LINEARIZATION PROGRAM.               SL1   2 
C                                                                       SL1   3 
      DIMENSION A(100,100), B(10000), V(10000), ETA(20), SQRTCR(100), NCSL1   4 
     1AT(20), ISCORE(20), SCORE(20), C(100,100)                         SL1   5 
      COMMON A,B                                                        SL1   6 
      EQUIVALENCE (A,V), (NCAT,ISCORE), (ETA,SCORE), (B,C)              SL1   7 
C                                                                       SL1   9 
C     TAPE ASSIGNMENTS -                                                SL1  10 
      JTAPE=6                                                           SL1  11 
      CALL REWIND (3)                                                   SL1  12 
      CALL REWIND (4)                                                   SL1  13 
      CALL REWIND (9)                                                   SL1  14 
      READ (3) NV,NVM1,NS,FNS,(NCAT(J),J=1,NV)                          SL1  15 
      N=0                                                               SL1  16 
      NI=22                                                             SL1  17 
      DO 2 I=1,NV                                                       SL1  18 
      IF (NCAT(I)-NI) 1,2,2                                             SL1  19 
1     NI=NCAT(I)                                                        SL1  20 
2     N=N+NCAT(I)                                                       SL1  21 
      NI=NI-1                                                           SL1  22 
      FNV=NV                                                            SL1  23 
      FNVM1=NVM1                                                        SL1  24 
      JJ=0                                                              SL1  25 
      DO 3 K=1,NV                                                       SL1  26 
      JJ=JJ+NCAT(K)                                                     SL1  27 
      II=JJ-NCAT(K)+1                                                   SL1  28 
      DO 3 I=II,JJ                                                      SL1  29 
      DO 3 J=I,JJ                                                       SL1  30 
3     A(I,J)=0.                                                         SL1  31 
      JJ=0                                                              SL1  32 
      DO 6 K=1,NVM1                                                     SL1  33 
      JJ=JJ+NCAT(K)                                                     SL1  34 
      II=JJ-NCAT(K)+1                                                   SL1  35 
      KK=K+1                                                            SL1  36 
      MM=JJ                                                             SL1  37 
      DO 4 L=KK,NV                                                      SL1  38 
      MM=MM+NCAT(L)                                                     SL1  39 
      LL=MM-NCAT(L)+1                                                   SL1  40 
4     READ (3) ((A(J,I),J=II,JJ),I=LL,MM)                               SL1  41 
      DO 6 NN=II,JJ                                                     SL1  42 
      FF=0.                                                             SL1  43 
      DO 5 MMM=LL,MM                                                    SL1  44 
5     FF=FF+A(NN,MMM)                                                   SL1  45 
6     SQRTCR(NN)=SQRT(FF)                                               SL1  46 
      CALL REWIND (3)                                                   SL1  47 
      DO 8 J=LL,MM                                                      SL1  48 
      FF=0.                                                             SL1  49 
      DO 7 I=II,JJ                                                      SL1  50 
7     FF=FF+A(I,J)                                                      SL1  51 
8     SQRTCR(J)=SQRT(FF)                                                SL1  52 
      DO 9 I=1,N                                                        SL1  53 
      DO 9 J=I,N                                                        SL1  54 
      FF=SQRTCR(I)*SQRTCR(J)                                            SL1  55 
      C(I,J)=A(I,J)/FF-FF/FNS                                           SL1  56 
9     C(J,I)=C(I,J)                                                     SL1  57 
C     CALL ON HOUSEHOLDER SUBROUTINE                                    SL1  58 
      CALL EIGEN (C,A,N,ETA,NI)                                         SL1  59 
      KK=0                                                              SL1  60 
      DO 11 J=1,NI                                                      SL1  61 
      IF (ETA(J)) 12,12,10                                              SL1  62 
10    ETA(J)=ETA(J)/FNVM1                                               SL1  63 
      KK=KK+1                                                           SL1  64 
11    CONTINUE                                                          SL1  65 
12    NI=KK                                                             SL1  66 
      WRITE (JTAPE,20)                                                  SL1  67 
      NROW=0                                                            SL1  68 
      DO 13 J=1,NI                                                      SL1  69 
      L=0                                                               SL1  70 
      DO 13 K=1,NV                                                      SL1  71 
      NROW=NROW+1                                                       SL1  72 
      NCATK=NCAT(K)                                                     SL1  73 
      DO 13 I=1,NCATK                                                   SL1  74 
      L=L+1                                                             SL1  75 
13    C(NROW,I)=A(L,J)/SQRTCR(L)                                        SL1  76 
      NROW=0                                                            SL1  77 
      DO 14 J=1,NI                                                      SL1  78 
      WRITE (JTAPE,21) J,ETA(J),(MMM,MMM=1,20)                          SL1  79 
      DO 14 K=1,NV                                                      SL1  80 
      NROW=NROW+1                                                       SL1  81 
      NCATK=NCAT(K)                                                     SL1  82 
14    WRITE (JTAPE,23) K,(C(NROW,I),I=1,NCATK)                          SL1  83 
      WRITE (4) NV,NS                                                   SL1  84 
      DO 16 I=1,NS                                                      SL1  85 
      NROW=0                                                            SL1  86 
      READ (9) (ISCORE(J),J=1,NV)                                       SL1  87 
      DO 15 L=1,NV                                                      SL1  88 
      KK=ISCORE(L)                                                      SL1  89 
      NROW=NROW+1                                                       SL1  90 
15    SCORE(L)=C(NROW,KK)                                               SL1  91 
16    WRITE (4) (SCORE(M),M=1,NV)                                       SL1  92 
      CALL REWIND (9)                                                   SL1  93 
      WRITE (JTAPE,22) (II,II=1,20)                                     SL1  94 
      DO 19 I=1,NS                                                      SL1  95 
      NROW=0                                                            SL1  96 
      READ (9) (ISCORE(J),J=1,NV)                                       SL1  97 
      DO 18 K=1,NI                                                      SL1  98 
      SCORE(K)=0.                                                       SL1  99 
      DO 17 L=1,NV                                                      SL1 100 
      NROW=NROW+1                                                       SL1 101 
      KK=ISCORE(L)                                                      SL1 102 
17    SCORE(K)=SCORE(K)+C(NROW,KK)                                      SL1 103 
18    SCORE(K)=SCORE(K)/FNV                                             SL1 104 
19    WRITE (JTAPE,23) I,(SCORE(M),M=1,NI)                              SL1 105 
C     CALL ON MULTIPLE CORE LOAD SUBROUTINE.                            SL1 106 
      CALL PUNT ('-CORE3 ',0,0)                                         SL1 107 
C     *** FORMAT STATEMENTS ***                                         SL1 108 
C                                                                       SL1 109 
20    FORMAT (1H1,42X46HLINGOES MULTIVARIATE ANALYSIS OF CONTINGENCIES/1SL1 110 
     17H0CATEGORY WEIGHTS/1H ,16(1H-))                                  SL1 111 
21    FORMAT (7H0VECTOR,I4,1H.,5X5HETA =,F5.3/9H CATEGORY,3X20I6/1H ,131SL1 112 
     1(1H-)/9H VARIABLE)                                                SL1 113 
22    FORMAT (39H1SCORES FOR EACH SUBJECT ON EACH VECTOR/7H0VECTOR,5X20ISL1 114 
     16/1H ,131(1H-)/8H SUBJECT)                                        SL1 115 
23    FORMAT (I6,6X3P20F6.0)                                            SL1 116 
      END                                                               SL1 117-
C     EIGEN                                                             EG1   1 
C     EIGENVALUES AND NORMALIZED EIGENVECTORS OF A REAL SYMMETRIC MATRIXEG1   2 
C     PROGRAMMED BY GARBOW, ARGONNE, 1965 AND MODIFIED BY LINGOES, U OF EG1   3 
C     M, 1966 USING HOUSEHOLDER'S TRIDIAGONALIZATION PROCEDURE AND      EG1   4 
C     INVERSE ITERATIONS TO OBTAIN EIGENVECTORS.  COMPLETE MULTIPLICITY EG1   5 
C     OF EIGENSYSTEM IS DETERMINED.                                     EG1   6 
C     EIGENVALUES ARE RETURNED IN VALU AND NORMALIZED EIGENVECTORS ARE  EG1   7 
C     STORED IN B.  NSUB IS ORDER OF MATRICES A AND B AND MSUB IS THE   EG1   8 
C     NUMBER OF ROOTS AND VECTORS DESIRED.                              EG1   9 
C                                                                       EG1  10 
      SUBROUTINE EIGEN (A,B,NSUB,VALU,MSUB)                             EG1  11 
C                                                                       EG1  12 
      DIMENSION A(100,100), B(100,100), VALU(21), T(100,3), DIAG(100), SEG1  13 
     1UPERD(100), WVEC(100), PVEC(100), QVEC(100), VALL(100), Q(100), U(EG1  14 
     2100), INDEX(100), FACTOR(100), V(100)                             EG1  15 
C                                                                       EG1  16 
      EQUIVALENCE (WVEC,VALL,FACTOR,U),(PVEC,QVEC,Q,V), (I1,T1),(I2,T2),EG1  17 
     1 (TEMP,T0), (SUM,MATCH), (I,P), (DIV,SCALAR,TAU), (ANORM2,ANORM), EG1  18 
     2 (VTEMP,VNORM2,VNORM)                                             EG1  19 
C                                                                       EG1  20 
C     INITIALIZATION                                                    EG1  21 
      N=NSUB                                                            EG1  22 
      M=MSUB                                                            EG1  23 
      NP1=N+1                                                           EG1  24 
      NM1=N-1                                                           EG1  25 
      E1=1.E-6                                                          EG1  26 
C                                                                       EG1  27 
C     GENERATE IDENTITY MATRIX                                          EG1  28 
      DO 3 I=1,N                                                        EG1  29 
      DO 3 J=1,N                                                        EG1  30 
      IF (I-J) 2,1,2                                                    EG1  31 
1     B(I,J)=1.                                                         EG1  32 
      GO TO 3                                                           EG1  33 
2     B(I,J)=0.                                                         EG1  34 
3     CONTINUE                                                          EG1  35 
C     HOUSEHOLDER SIMILARITY TRANSFORMATION TO CO-DIAGONAL FORM         EG1  36 
C     REDUCE COLUMN OF MATRIX                                           EG1  37 
      DO 14 I=1,NM1                                                     EG1  38 
      IF (I-NM1) 4,13,4                                                 EG1  39 
4     I1=I+1                                                            EG1  40 
      I2=I1+1                                                           EG1  41 
      SUM=0.                                                            EG1  42 
      DO 5 J=I2,N                                                       EG1  43 
5     SUM=SUM+A(J,I)**2                                                 EG1  44 
      IF (SUM) 6,13,6                                                   EG1  45 
6     J=I1                                                              EG1  46 
      TEMP=A(J,I)                                                       EG1  47 
      SUM=SQRT(SUM+TEMP**2)                                             EG1  48 
      A(J,I)=-SIGN(SUM,TEMP)                                            EG1  49 
      WVEC(J)=SQRT(1.+ABS(TEMP)/SUM)                                    EG1  50 
      DIV=SIGN(WVEC(J)*SUM,TEMP)                                        EG1  51 
      DO 7 J=I2,N                                                       EG1  52 
7     WVEC(J)=A(J,I)/DIV                                                EG1  53 
      SCALAR=0.                                                         EG1  54 
      DO 9 J=I1,N                                                       EG1  55 
      PVEC(J)=0.                                                        EG1  56 
      DO 8 K=I1,N                                                       EG1  57 
8     PVEC(J)=PVEC(J)+A(K,J)*WVEC(K)                                    EG1  58 
      SCALAR=SCALAR+PVEC(J)*WVEC(J)                                     EG1  59 
9     CONTINUE                                                          EG1  60 
      SCALAR=SCALAR/2.                                                  EG1  61 
      DO 10 J=I1,N                                                      EG1  62 
      QVEC(J)=PVEC(J)-SCALAR*WVEC(J)                                    EG1  63 
      DO 10 K=I1,J                                                      EG1  64 
      A(K,J)=A(K,J)-(WVEC(K)*QVEC(J)+WVEC(J)*QVEC(K))                   EG1  65 
      A(J,K)=A(K,J)                                                     EG1  66 
10    CONTINUE                                                          EG1  67 
C     SAVE ROTATION FOR LATER APPLICATION TO CO-DIAGONAL VECTORS        EG1  68 
      DO 12 K=2,N                                                       EG1  69 
      TEMP=0.                                                           EG1  70 
      DO 11 J=I1,N                                                      EG1  71 
11    TEMP=TEMP+WVEC(J)*B(J,K)                                          EG1  72 
      DO 12 J=I1,N                                                      EG1  73 
      B(J,K)=B(J,K)-WVEC(J)*TEMP                                        EG1  74 
12    CONTINUE                                                          EG1  75 
C     MOVE CO-DIAGONAL FORM ELEMENTS FOR ITERATIVE PROCEDURE            EG1  76 
13    J=I                                                               EG1  77 
      DIAG(I)=A(J,I)                                                    EG1  78 
      SUPERD(I)=A(J+1,I)                                                EG1  79 
14    CONTINUE                                                          EG1  80 
      DIAG(N)=A(N,N)                                                    EG1  81 
C     DETERMINE EIGENVALUES FROM STURM CHAIN OF CO-DIAGONAL MINORS      EG1  82 
C     CALCULATE NORM OF MATRIX AND INITIALIZE EIGENVALUE BOUNDS         EG1  83 
      ANORM2=DIAG(1)**2                                                 EG1  84 
      DO 15 L=2,N                                                       EG1  85 
      Q(L-1)=SUPERD(L-1)**2                                             EG1  86 
      ANORM2=DIAG(L)**2+Q(L-1)+Q(L-1)+ANORM2                            EG1  87 
15    CONTINUE                                                          EG1  88 
      ANORM=SQRT(ANORM2)                                                EG1  89 
      DO 16 L=1,M                                                       EG1  90 
      VALU(L)=ANORM                                                     EG1  91 
      VALL(L)=-ANORM                                                    EG1  92 
16    CONTINUE                                                          EG1  93 
      EPS1=ANORM*E1                                                     EG1  94 
      IF (EPS1) 17,72,17                                                EG1  95 
C     CHOOSE NEW TRIAL VALUE WHILE TESTING BOUNDS FOR CONVERGENCE       EG1  96 
17    DO 35 L=1,M                                                       EG1  97 
      ITER=0                                                            EG1  98 
      VTEMP=EPS1                                                        EG1  99 
18    TAU=(VALU(L)+VALL(L))/2.                                          EG1 100 
      IF (ITER-10) 20,19,20                                             EG1 101 
19    VTEMP=VTEMP*10.                                                   EG1 102 
      ITER=0                                                            EG1 103 
20    IF (2.*(TAU-VALL(L))-VTEMP) 35,35,21                              EG1 104 
C     DETERMINE SIGNS OF PRINCIPAL MINORS                               EG1 105 
21    MATCH=0                                                           EG1 106 
      ITER=ITER+1                                                       EG1 107 
      T2=0.                                                             EG1 108 
      T1=1.                                                             EG1 109 
      DO 30 L1=1,N                                                      EG1 110 
      P=DIAG(L1)-TAU                                                    EG1 111 
      IF (T2) 23,22,23                                                  EG1 112 
22    T1=SIGN(1.,T1)                                                    EG1 113 
23    IF (T1) 25,24,25                                                  EG1 114 
24    T0=-SIGN(1.,T2)                                                   EG1 115 
      T2=0.                                                             EG1 116 
      IF (Q(L1-1)) 26,22,26                                             EG1 117 
25    T0=P-Q(L1-1)*T2/T1                                                EG1 118 
      T2=1.                                                             EG1 119 
C     COUNT AGREEMENTS IN SIGN (ZERO CONSIDERED POSITIVE)               EG1 120 
26    IF (T0) 29,27,28                                                  EG1 121 
27    T2=T1                                                             EG1 122 
      IF (T2) 29,28,28                                                  EG1 123 
28    MATCH=MATCH+1                                                     EG1 124 
29    T1=T0                                                             EG1 125 
30    CONTINUE                                                          EG1 126 
C     ESTABLISH TIGHTER BOUNDS ON EIGENVALUES                           EG1 127 
      DO 34 L1=L,M                                                      EG1 128 
      IF (L1-MATCH) 33,33,31                                            EG1 129 
31    IF (VALU(L1)-TAU) 18,18,32                                        EG1 130 
32    VALU(L1)=TAU                                                      EG1 131 
      GO TO 34                                                          EG1 132 
33    VALL(L1)=TAU                                                      EG1 133 
34    CONTINUE                                                          EG1 134 
      GO TO 18                                                          EG1 135 
35    CONTINUE                                                          EG1 136 
C     EIGENVECTORS OF CO-DIAGONAL SYMMETRIC MATRIX -- INVERSE ITERATION EG1 137 
C     CHECK FOR REPEATED VALUE                                          EG1 138 
      DO 68 I=1,M                                                       EG1 139 
      IF (I-2) 37,36,36                                                 EG1 140 
36    IF (VALU(I-1)-VALU(I)-EPS1) 38,37,37                              EG1 141 
37    I1=-1                                                             EG1 142 
38    I1=I1+1                                                           EG1 143 
C     TRIANGULARIZE CO-DIAGONAL FORM AFTER EIGENVALUE SUBTRACTION       EG1 144 
      DO 43 L=1,N                                                       EG1 145 
      V(L)=EPS1                                                         EG1 146 
      T(L,2)=DIAG(L)-VALU(I)                                            EG1 147 
      IF (L-N) 40,39,40                                                 EG1 148 
39    T(L,3)=0.                                                         EG1 149 
      GO TO 43                                                          EG1 150 
40    T(L,3)=SUPERD(L)                                                  EG1 151 
      IF (T(L,3)) 42,41,42                                              EG1 152 
41    T(L,3)=EPS1                                                       EG1 153 
42    T(L+1,1)=T(L,3)                                                   EG1 154 
43    CONTINUE                                                          EG1 155 
      DO 50 J=1,N                                                       EG1 156 
      T(J,1)=T(J,2)                                                     EG1 157 
      T(J,2)=T(J,3)                                                     EG1 158 
      T(J,3)=0.                                                         EG1 159 
      VTEMP=ABS(T(J,1))                                                 EG1 160 
      IF (J-N) 46,44,46                                                 EG1 161 
44    IF (VTEMP) 50,45,50                                               EG1 162 
45    T(J,1)=EPS1                                                       EG1 163 
      GO TO 50                                                          EG1 164 
46    INDEX(J)=0                                                        EG1 165 
      IF (ABS(T(J+1,1))-VTEMP) 49,49,47                                 EG1 166 
47    INDEX(J)=1                                                        EG1 167 
      DO 48 K=1,3                                                       EG1 168 
      VTEMP=T(J,K)                                                      EG1 169 
      T(J,K)=T(J+1,K)                                                   EG1 170 
      T(J+1,K)=VTEMP                                                    EG1 171 
48    CONTINUE                                                          EG1 172 
49    VTEMP=T(J+1,1)/T(J,1)                                             EG1 173 
      FACTOR(J)=VTEMP                                                   EG1 174 
      T(J+1,2)=T(J+1,2)-VTEMP*T(J,2)                                    EG1 175 
      T(J+1,3)=T(J+1,3)-VTEMP*T(J,3)                                    EG1 176 
50    CONTINUE                                                          EG1 177 
      ITER=1                                                            EG1 178 
      IF (I1) 58,51,58                                                  EG1 179 
C     BACK SUBSTITUTE TO OBTAIN EIGENVECTOR                             EG1 180 
51    DO 52 L1=1,N                                                      EG1 181 
      L=NP1-L1                                                          EG1 182 
      V(L)=(V(L)-T(L,2)*V(L+1)-T(L,3)*V(L+2))/T(L,1)                    EG1 183 
52    CONTINUE                                                          EG1 184 
      GO TO (53,58), ITER                                               EG1 185 
C     PERFORM SECOND ITERATION                                          EG1 186 
53    ITER=2                                                            EG1 187 
54    DO 57 L=2,N                                                       EG1 188 
      IF (INDEX(L-1)) 55,56,55                                          EG1 189 
55    VTEMP=V(L-1)                                                      EG1 190 
      V(L-1)=V(L)                                                       EG1 191 
      V(L)=VTEMP                                                        EG1 192 
56    V(L)=V(L)-FACTOR(L-1)*V(L-1)                                      EG1 193 
57    CONTINUE                                                          EG1 194 
      GO TO 51                                                          EG1 195 
C     ORTHOGONALIZE VECTOR TO OTHERS ASSOCIATED WITH REPEATED ROOT      EG1 196 
58    IF (I1) 59,62,59                                                  EG1 197 
59    DO 61 L1=1,I1                                                     EG1 198 
      K=I-L1                                                            EG1 199 
      VTEMP=0.                                                          EG1 200 
      DO 60 J=1,N                                                       EG1 201 
60    VTEMP=VTEMP+A(J,K)*V(J)                                           EG1 202 
      DO 61 J=1,N                                                       EG1 203 
61    V(J)=V(J)-A(J,K)*VTEMP                                            EG1 204 
62    GO TO (54,63), ITER                                               EG1 205 
C     NORMALIZE VECTOR TO UNIT LENGTH                                   EG1 206 
63    VNORM2=0.                                                         EG1 207 
      SUM=0.                                                            EG1 208 
      DO 65 L=1,N                                                       EG1 209 
      IF (SUM-ABS(V(L))) 64,65,65                                       EG1 210 
64    SUM=ABS(V(L))                                                     EG1 211 
65    CONTINUE                                                          EG1 212 
      DO 66 L=1,N                                                       EG1 213 
      V(L)=V(L)/SUM                                                     EG1 214 
66    VNORM2=VNORM2+V(L)**2                                             EG1 215 
      VNORM=SQRT(VNORM2)                                                EG1 216 
      DO 67 J=1,N                                                       EG1 217 
67    A(J,I)=V(J)/VNORM                                                 EG1 218 
68    CONTINUE                                                          EG1 219 
C     ROTATION OF CO-DIAGONAL VECTORS INTO MATRIX EIGENVECTORS          EG1 220 
      DO 70 I=1,M                                                       EG1 221 
      DO 69 K=2,N                                                       EG1 222 
      U(K)=0.                                                           EG1 223 
      DO 69 J=2,N                                                       EG1 224 
69    U(K)=U(K)+B(J,K)*A(J,I)                                           EG1 225 
      DO 70 J=2,N                                                       EG1 226 
70    A(J,I)=U(J)                                                       EG1 227 
C     STORE UNIT LENGTH VECTORS IN B(I,J)                               EG1 228 
      DO 71 J=1,M                                                       EG1 229 
      DO 71 I=1,N                                                       EG1 230 
71    B(I,J)=A(I,J)                                                     EG1 231 
72    CONTINUE                                                          EG1 232 
      RETURN                                                            EG1 233 
      END                                                               EG1 234-
C     CORR-CORE 3                                                       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     *** REFERENCES - LINGOES, J. C.  AN IBM-7090 PROGRAM FOR GUTTMAN- COR  10 
C                        LINGOES SMALLEST SPACE ANALYSIS - III.  BEHAV. COR  11 
C                        SCI., 1966,11,75-76.                           COR  12 
C                      LINGOES, J. C. AND GUTTMAN, L.  NONMETRIC FACTOR COR  13 
C                        ANALYSIS - A RANK REDUCING ALTERNATIVE TO      COR  14 
C                        LINEAR FACTOR ANALYSIS. MULT. BEHAV. RES.,1967,COR  15 
C                                                                       COR  16 
      DIMENSION R(71,71), D(71)                                         COR  17 
      COMMON R,D                                                        COR  18 
C     TAPE ASSIGNMENTS                                                  COR  20 
      ITAPE=5                                                           COR  21 
      JTAPE=6                                                           COR  22 
      CALL REWIND (3)                                                           
      CALL REWIND (4)                                                           
      READ (ITAPE,8)                                                    COR  25 
      WRITE (JTAPE,8)                                                   COR  26 
      READ (4) N,NS                                                             
      NP1=N+1                                                           COR  28 
      NM1=N-1                                                           COR  29 
      DO 1 I=1,NP1                                                      COR  30 
      DO 1 J=1,I                                                        COR  31 
1     R(I,J)=0.                                                         COR  32 
      D(NP1)=1.                                                         COR  33 
      NITER=25                                                          COR  34 
      MIND=N/2                                                          COR  35 
      NDIM=MIND                                                         COR  36 
      WRITE (3) N,NITER,MIND,NDIM                                               
      DO 3 K=1,NS                                                       COR  38 
      READ (4) (D(J),J=1,N)                                                     
      DO 2 I=1,NP1                                                      COR  40 
      DO 2 J=1,I                                                        COR  41 
2     R(I,J)=R(I,J)+D(I)*D(J)                                           COR  42 
3     CONTINUE                                                          COR  43 
      CALL REWIND (4)                                                           
      WRITE (JTAPE,9) N,NS                                              COR  45 
      FNS=R(NP1,NP1)                                                    COR  46 
      DO 4 I=1,N                                                        COR  47 
      D(I)=R(NP1,I)/FNS                                                 COR  48 
      R(I,NP1)=SQRT(ABS(R(I,I)/FNS-D(I)**2))                            COR  49 
4     WRITE (JTAPE,10) I,R(NP1,I),D(I),R(I,I),R(I,NP1)                  COR  50 
      DO 5 I=1,N                                                        COR  51 
      DO 5 J=1,I                                                        COR  52 
5     R(I,J)=(R(I,J)-(R(NP1,I)*R(NP1,J))/FNS)/FNS                       COR  53 
      DO 6 I=1,N                                                        COR  54 
      DO 6 J=1,I                                                        COR  55 
6     R(I,J)=R(I,J)/(R(I,NP1)*R(J,NP1))                                 COR  56 
      DO 7 I=1,NM1                                                      COR  57 
      IP1=I+1                                                           COR  58 
7     WRITE (3) (R(J,I),J=IP1,N)                                                
      CALL REWIND (3)                                                           
C     CALL ON NEXT CORE LOAD, I.E., THIS IS A CHAIN JOB.                COR  61 
      CALL PUNT ('-CORE4 ',0,0)                                         COR  62 
C     *** FORMAT STATEMENTS ***                                         COR  63 
C                                                                       COR  64 
8     FORMAT (72H                                                       COR  65 
     1                 )                                                COR  66 
9     FORMAT (1H /1H0,16X19HNO. OF VARIABLES = I5/1H0,16X22HNO. OF OBSERCOR  67 
     1VATIONS = I5/13H0    VAR. NO.,14X3HSUM,21X4HMEAN,18X11HSUM SQUARESCOR  68 
     2,15X9HSTD. DEV.)                                                  COR  69 
10    FORMAT (1H0,I9,1P4E25.7)                                          COR  70 
      END                                                               COR  71-
C     SSA3-CORE 4                                                       SA3   1 
C     CORE 4 FOR MAC - 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   9 
C     TAPE ASSIGNMENTS -                                                SA3  10 
      ITAPE=5                                                           SA3  11 
      JTAPE=6                                                           SA3  12 
      CALL REWIND (3)                                                           
      CALL REWIND (4)                                                           
      READ (ITAPE,98)                                                   SA3  15 
      READ (3) NV,NITER,MIND,NDIM                                               
      MD=70                                                             SA3  17 
      ND=70                                                             SA3  18 
      NVM1=NV-1                                                         SA3  19 
      NVP1=NV+1                                                         SA3  20 
      FN=NV                                                             SA3  21 
      NEL=(NV*NVM1)/2                                                   SA3  22 
      FNEL=NEL                                                          SA3  23 
      JJ=0                                                              SA3  24 
      KK=NV                                                             SA3  25 
      U=0.                                                              SA3  26 
      A=0.                                                              SA3  27 
      DO 1 I=1,NVM1                                                     SA3  28 
      VECT(I,I)=1.                                                      SA3  29 
      R(I,I)=1.                                                         SA3  30 
      II=JJ+1                                                           SA3  31 
      KK=KK-1                                                           SA3  32 
      JJ=KK+JJ                                                          SA3  33 
      IP1=I+1                                                           SA3  34 
      READ (3) (VEC(J),J=II,JJ)                                                 
      II=II-1                                                           SA3  36 
      DO 1 K=IP1,NV                                                     SA3  37 
      II=II+1                                                           SA3  38 
      R(I,K)=VEC(II)                                                    SA3  39 
      U=U+R(I,K)**2                                                     SA3  40 
      A=A+R(I,K)                                                        SA3  41 
      VECT(K,I)=R(I,K)                                                  SA3  42 
      VECT(I,K)=VECT(K,I)                                               SA3  43 
1     R(K,I)=R(I,K)                                                     SA3  44 
      VECT(NV,NV)=1.                                                    SA3  45 
      R(NV,NV)=1.                                                       SA3  46 
      B=SQRT(FNEL*U-A**2)                                               SA3  47 
      U=2.*U                                                            SA3  48 
      WRITE (4) (VEC(J),J=1,NEL)                                                
      CALL REWIND (4)                                                           
      CALL MXOUT (R,NV,0,MD)                                            SA3  51 
      IF (NITER) 3,2,3                                                  SA3  52 
2     NITER=25                                                          SA3  53 
3     ASSIGN 34 TO N1                                                   SA3  54 
C     *** SEE G-L(SSA-I) COMMENTS REGARDING SORT ROUTINE.               SA3  55 
      CALL SORT (-1,NEL,VEC,1,INDI)                                     SA3  56 
      ITER=0                                                            SA3  57 
C     CALL MATRIX INVERSION SUBROUTINE                                  SA3  58 
      CALL MATINV (NV,VECT,DEN,INDJ(1),INDJ(71),INDJ(141))              SA3  59 
      DO 5 I=1,NV                                                       SA3  60 
      ROOT(I)=(VECT(I,I)-1.)/VECT(I,I)                                  SA3  61 
      IF (VECT(I,I)) 12,12,4                                            SA3  62 
4     IF (ROOT(I)-1.) 5,5,12                                            SA3  63 
5     CONTINUE                                                          SA3  64 
      DO 10 I=1,NV                                                      SA3  65 
      DO 10 J=I,NV                                                      SA3  66 
      Z=0.                                                              SA3  67 
      DO 6 K=1,NV                                                       SA3  68 
6     Z=Z+VECT(I,K)*R(J,K)                                              SA3  69 
      IF (I-J) 9,7,9                                                    SA3  70 
7     Z=ABS(Z-1.)                                                       SA3  71 
8     IF (Z-.005) 10,10,12                                              SA3  72 
9     Z=ABS(Z)                                                          SA3  73 
      GO TO 8                                                           SA3  74 
10    CONTINUE                                                          SA3  75 
      WRITE (JTAPE,99) DEN,(ROOT(J),J=1,NV)                             SA3  76 
      X=0.                                                              SA3  77 
      DO 11 I=1,NV                                                      SA3  78 
      X=X+ROOT(I)                                                       SA3  79 
      U=U+ROOT(I)**2                                                    SA3  80 
11    R(I,I)=ROOT(I)                                                    SA3  81 
      GO TO 17                                                          SA3  82 
12    Z=0.                                                              SA3  83 
      DO 15 J=1,NV                                                      SA3  84 
      R(J,J)=0.                                                         SA3  85 
      DO 14 I=1,NV                                                      SA3  86 
      IF (I-J) 13,14,13                                                 SA3  87 
13    R(J,J)=R(J,J)+ABS(R(I,J))                                         SA3  88 
14    CONTINUE                                                          SA3  89 
15    Z=Z+R(J,J)                                                        SA3  90 
      X=0.                                                              SA3  91 
      DO 16 I=1,NV                                                      SA3  92 
      R(I,I)=R(I,I)**2/Z                                                SA3  93 
      U=U+R(I,I)**2                                                     SA3  94 
16    X=X+R(I,I)                                                        SA3  95 
17    NDIM1=NDIM+1                                                      SA3  96 
      IF (NDIM) 19,18,19                                                SA3  97 
18    NDIM1=NV                                                          SA3  98 
19    WRITE (JTAPE,100)                                                 SA3  99 
20    ITER=ITER+1                                                       SA3 100 
      H2=X/FN                                                           SA3 101 
C     CALL ON HOUSEHOLDER'S EIGENVALUE-EIGENVECTOR SUBROUTINE           SA3 102 
      CALL EIGEN (R,VECT,NV,ROOT,NDIM1,MD,VEC(1),VEC(211),VEC(281),VEC(3SA3 103 
     151),VEC(421),VEC(491))                                            SA3 104 
      NN=0                                                              SA3 105 
      MM=0                                                              SA3 106 
      TRACE=0.                                                          SA3 107 
      F1=0.                                                             SA3 108 
      F2=0.                                                             SA3 109 
      DO 23 J=1,NDIM1                                                   SA3 110 
      IF (ROOT(J)) 24,24,21                                             SA3 111 
21    NN=NN+1                                                           SA3 112 
      TRACE=TRACE+ROOT(J)                                               SA3 113 
      IF (ROOT(J)-H2) 23,22,22                                          SA3 114 
22    MM=MM+1                                                           SA3 115 
23    CONTINUE                                                          SA3 116 
24    IF (NDIM) 26,25,26                                                SA3 117 
25    NDIM=NN+(MM-NN)/2                                                 SA3 118 
      GO TO 28                                                          SA3 119 
26    IF (NDIM-NN) 28,28,27                                             SA3 120 
27    NDIM=NN                                                           SA3 121 
28    NDIM1=NDIM+1                                                      SA3 122 
      DO 29 J=1,NDIM                                                    SA3 123 
      F1=F1+ROOT(J)                                                     SA3 124 
29    F2=F2+ROOT(J)**2                                                  SA3 125 
      II=0                                                              SA3 126 
      DO 31 I=1,NVM1                                                    SA3 127 
      IP1=I+1                                                           SA3 128 
      DO 31 J=IP1,NV                                                    SA3 129 
      R(I,J)=0.                                                         SA3 130 
      DO 30 K=1,NDIM                                                    SA3 131 
30    R(I,J)=R(I,J)+VECT(I,K)*VECT(J,K)                                 SA3 132 
      II=II+1                                                           SA3 133 
31    VEC(II)=R(I,J)                                                    SA3 134 
      READ (4) (R(J,1),J=1,NEL)                                                 
      CALL REWIND (4)                                                           
      PHI=0.                                                            SA3 137 
      DEN=0.                                                            SA3 138 
      Y=0.                                                              SA3 139 
      DO 32 J=1,NEL                                                     SA3 140 
      PHI=PHI+VEC(J)                                                    SA3 141 
      DEN=DEN+VEC(J)**2                                                 SA3 142 
32    Y=Y+VEC(J)*R(J,1)                                                 SA3 143 
      Q=FNEL*DEN-PHI**2                                                 SA3 144 
      V=(FNEL*Y-PHI*A)/Q                                                SA3 145 
      Z=(DEN*A-Y*PHI)/Q                                                 SA3 146 
      DO 33 J=1,NEL                                                     SA3 147 
33    VEC(J)=V*VEC(J)+Z                                                 SA3 148 
      GO TO N1, (34,35)                                                 SA3 149 
C     *** SEE SORT COMMENTS.                                            SA3 150 
34    CALL SORT (0,0,VEC,1,INDJ)                                        SA3 151 
      ASSIGN 35 TO N1                                                   SA3 152 
      GO TO 36                                                          SA3 153 
C     *** SORT CALL - SEE REMARKS.                                      SA3 154 
35    CALL SORT (1,0,VEC,1,INDJ)                                        SA3 155 
36    DO 37 J=1,NEL                                                     SA3 156 
      II=INDI(J)                                                        SA3 157 
      JJ=INDJ(J)                                                        SA3 158 
37    RP(II)=VEC(JJ)                                                    SA3 159 
      PHI=0.                                                            SA3 160 
      DEN=0.                                                            SA3 161 
      Y=0.                                                              SA3 162 
      DO 38 J=1,NEL                                                     SA3 163 
      Y=Y+VEC(J)                                                        SA3 164 
      DEN=DEN+VEC(J)**2                                                 SA3 165 
38    PHI=PHI+RP(J)*VEC(J)                                              SA3 166 
      PHI=FNEL*PHI                                                      SA3 167 
      DEN=FNEL*DEN                                                      SA3 168 
      DEN=DEN-Y**2                                                      SA3 169 
      IF (ABS(DEN)-.00001) 39,39,40                                     SA3 170 
39    WRITE (JTAPE,101)                                                 SA3 171 
      GO TO 97                                                          SA3 172 
40    PHI=(PHI-Y**2)/DEN                                                SA3 173 
      IF (PHI-1.) 42,42,41                                              SA3 174 
41    PHI=1.                                                            SA3 175 
42    TRACE=TRACE/X                                                     SA3 176 
      F1=F1/X                                                           SA3 177 
      F2=F2/U                                                           SA3 178 
      WRITE (JTAPE,102) ITER,MM,NN,H2,TRACE,PHI,F1,F2                   SA3 179 
      IF (ITER-1) 44,43,44                                              SA3 180 
43    WRITE (JTAPE,98)                                                  SA3 181 
      WRITE (JTAPE,103)                                                 SA3 182 
      PRTR=TRACE+TRACE                                                  SA3 183 
      GO TO 53                                                          SA3 184 
44    IF (1.-PHI) 52,52,45                                              SA3 185 
45    IF (ABS(TRACE-PRTR)-.000001) 52,46,46                             SA3 186 
46    PRTR=TRACE                                                        SA3 187 
      IF (ITER-NITER) 48,52,52                                          SA3 188 
47    WRITE (JTAPE,100)                                                 SA3 189 
48    II=0                                                              SA3 190 
      U=0.                                                              SA3 191 
      DO 49 I=1,NVM1                                                    SA3 192 
      IP1=I+1                                                           SA3 193 
      DO 49 J=IP1,NV                                                    SA3 194 
      II=II+1                                                           SA3 195 
      R(I,J)=RP(II)                                                     SA3 196 
      U=U+R(I,J)**2                                                     SA3 197 
49    R(J,I)=R(I,J)                                                     SA3 198 
      U=2.*U                                                            SA3 199 
      X=0.                                                              SA3 200 
      DO 51 I=1,NV                                                      SA3 201 
      R(I,I)=0.                                                         SA3 202 
      DO 50 J=1,NDIM                                                    SA3 203 
50    R(I,I)=R(I,I)+VECT(I,J)**2                                        SA3 204 
      U=U+R(I,I)**2                                                     SA3 205 
51    X=X+R(I,I)                                                        SA3 206 
      GO TO 20                                                          SA3 207 
52    WRITE (JTAPE,98)                                                  SA3 208 
      WRITE (JTAPE,104)                                                 SA3 209 
53    II=NDIM                                                           SA3 210 
54    JJ=1                                                              SA3 211 
      KK=18                                                             SA3 212 
55    IF (KK-II) 58,57,56                                               SA3 213 
56    KK=II                                                             SA3 214 
57    NN=0                                                              SA3 215 
      GO TO 59                                                          SA3 216 
58    NN=1                                                              SA3 217 
59    WRITE (JTAPE,105) (NO,NO=JJ,KK)                                   SA3 218 
      WRITE (JTAPE,106)                                                 SA3 219 
      DO 60 I=1,NV                                                      SA3 220 
60    WRITE (JTAPE,107) I,(VECT(I,J),J=JJ,KK)                           SA3 221 
      WRITE (JTAPE,108) (ROOT(J),J=JJ,KK)                               SA3 222 
      IF (NN) 61,62,61                                                  SA3 223 
61    JJ=KK+1                                                           SA3 224 
      KK=KK+18                                                          SA3 225 
      WRITE (JTAPE,98)                                                  SA3 226 
      GO TO 55                                                          SA3 227 
62    IF (ITER) 63,87,63                                                SA3 228 
63    READ (4) (R(J,1),J=1,NEL)                                                 
      CALL REWIND (4)                                                           
      CD=PHI**2                                                         SA3 231 
      PHI=SQRT(1.-CD)                                                   SA3 232 
      WRITE (JTAPE,109) PHI                                             SA3 233 
      X=0.                                                              SA3 234 
      DO 64 J=1,NEL                                                     SA3 235 
64    X=X+R(J,1)*VEC(J)                                                 SA3 236 
      DEN=SQRT(DEN)                                                     SA3 237 
      X=FNEL*X                                                          SA3 238 
      DEN=(X-A*Y)/(B*DEN)                                               SA3 239 
      CD=1.-DEN**2/CD                                                   SA3 240 
      WRITE (JTAPE,110) DEN,V,Z,CD                                      SA3 241 
      IF (ITER-1) 65,47,65                                              SA3 242 
65    IF (II-MM) 67,67,66                                               SA3 243 
66    II=MM+1                                                           SA3 244 
      GO TO 68                                                          SA3 245 
67    IF (II-1) 97,97,68                                                SA3 246 
68    DO 70 I=1,NV                                                      SA3 247 
      VEC(I)=0.                                                         SA3 248 
      DO 69 J=1,II                                                      SA3 249 
69    VEC(I)=VEC(I)+VECT(I,J)**2                                        SA3 250 
      VEC(I)=SQRT(VEC(I))                                               SA3 251 
      DO 70 K=1,II                                                      SA3 252 
70    VECT(I,K)=VECT(I,K)/VEC(I)                                        SA3 253 
      M=II-1                                                            SA3 254 
      ITER=50                                                           SA3 255 
71    DO 77 I=1,M                                                       SA3 256 
      IP1=I+1                                                           SA3 257 
      DO 77 K=IP1,II                                                    SA3 258 
      SUMU=0.                                                           SA3 259 
      SUMV=0.                                                           SA3 260 
      SUMUV=0.                                                          SA3 261 
      USMVS=0.                                                          SA3 262 
      DO 72 J=1,NV                                                      SA3 263 
      U=VECT(J,I)**2-VECT(J,K)**2                                       SA3 264 
      V=2.*VECT(J,I)*VECT(J,K)                                          SA3 265 
      SUMU=U+SUMU                                                       SA3 266 
      SUMV=V+SUMV                                                       SA3 267 
      Q=U**2                                                            SA3 268 
      S=V**2                                                            SA3 269 
      SUMUV=U*V+SUMUV                                                   SA3 270 
72    USMVS=Q-S+USMVS                                                   SA3 271 
      Y=2.*(FN*SUMUV-SUMU*SUMV)                                         SA3 272 
      X=FN*USMVS-SUMU**2+SUMV**2                                        SA3 273 
C     ATAN2 IS EQUIVALENT TO ATN1                                       SA3 274 
      Z=ATAN2(Y,X)                                                      SA3 275 
      IF (Z-3.1415927) 74,74,73                                         SA3 276 
73    Z=Z-6.2831853                                                     SA3 277 
74    Z=.25*Z                                                           SA3 278 
      IF (ABS(Z)-.001) 77,77,75                                         SA3 279 
75    F1=COS(Z)                                                         SA3 280 
      F2=SIN(Z)                                                         SA3 281 
      DO 76 J=1,NV                                                      SA3 282 
      ST=VECT(J,I)*F1+VECT(J,K)*F2                                      SA3 283 
      VECT(J,K)=-VECT(J,I)*F2+VECT(J,K)*F1                              SA3 284 
76    VECT(J,I)=ST                                                      SA3 285 
77    CONTINUE                                                          SA3 286 
      ITER=ITER-1                                                       SA3 287 
      IF (ITER) 78,78,71                                                SA3 288 
78    WRITE (JTAPE,98)                                                  SA3 289 
      WRITE (JTAPE,111)                                                 SA3 290 
      DO 79 I=1,NV                                                      SA3 291 
      DO 79 J=1,II                                                      SA3 292 
79    VECT(I,J)=VECT(I,J)*VEC(I)                                        SA3 293 
      DO 80 J=1,II                                                      SA3 294 
      ROOT(J)=0.                                                        SA3 295 
      DO 80 I=1,NV                                                      SA3 296 
80    ROOT(J)=ROOT(J)+VECT(I,J)**2                                      SA3 297 
      DO 85 I=1,M                                                       SA3 298 
      DEN=0.                                                            SA3 299 
      DO 82 J=I,II                                                      SA3 300 
      IF (DEN-ROOT(J)) 81,82,82                                         SA3 301 
81    DEN=ROOT(J)                                                       SA3 302 
      JJ=J                                                              SA3 303 
82    CONTINUE                                                          SA3 304 
      IF (JJ-I) 83,85,83                                                SA3 305 
83    DO 84 K=1,NV                                                      SA3 306 
      DEN=VECT(K,I)                                                     SA3 307 
      VECT(K,I)=VECT(K,JJ)                                              SA3 308 
84    VECT(K,JJ)=DEN                                                    SA3 309 
      DEN=ROOT(I)                                                       SA3 310 
      ROOT(I)=ROOT(JJ)                                                  SA3 311 
      ROOT(JJ)=DEN                                                      SA3 312 
85    CONTINUE                                                          SA3 313 
      DO 86 I=1,NV                                                      SA3 314 
      VEC(I)=0.                                                         SA3 315 
      DO 86 J=1,II                                                      SA3 316 
86    VEC(I)=VEC(I)+VECT(I,J)**2                                        SA3 317 
      WRITE (JTAPE,112) (VEC(I),I=1,NV)                                 SA3 318 
      GO TO 54                                                          SA3 319 
87    CALL PLOT (VECT,INV(1),INV(71),INV(141),INV(211),INV(281),NV,II,MDSA3 320 
     1,ND)                                                              SA3 321 
      U=0.                                                              SA3 322 
      DEN=0.                                                            SA3 323 
      DO 89 I=1,NVM1                                                    SA3 324 
      IP1=I+1                                                           SA3 325 
      DO 89 J=IP1,NV                                                    SA3 326 
      R(I,J)=0.                                                         SA3 327 
      DO 88 K=1,NDIM                                                    SA3 328 
88    R(I,J)=R(I,J)+VECT(I,K)*VECT(J,K)                                 SA3 329 
      U=U+R(I,J)**2                                                     SA3 330 
      DEN=DEN+R(I,J)                                                    SA3 331 
89    R(J,I)=R(I,J)                                                     SA3 332 
      U=2.*U                                                            SA3 333 
      X=0.                                                              SA3 334 
      DO 91 I=1,NV                                                      SA3 335 
      R(I,I)=0.                                                         SA3 336 
      DO 90 J=1,NDIM                                                    SA3 337 
90    R(I,I)=R(I,I)+VECT(I,J)**2                                        SA3 338 
      X=X+R(I,I)                                                        SA3 339 
91    U=U+R(I,I)**2                                                     SA3 340 
      CALL MXOUT (R,NV,1,MD)                                            SA3 341 
      IF (NDIM-MIND) 97,97,92                                           SA3 342 
92    Y=0.                                                              SA3 343 
      DEN=DEN/FNEL                                                      SA3 344 
      DO 94 I=1,NVM1                                                    SA3 345 
      IP1=I+1                                                           SA3 346 
      DO 94 J=IP1,NV                                                    SA3 347 
      IF (ABS(R(I,J)-DEN)-.1) 93,93,94                                  SA3 348 
93    Y=Y+1.                                                            SA3 349 
94    CONTINUE                                                          SA3 350 
      Y=Y/FNEL                                                          SA3 351 
      IF (Y-.6) 96,95,95                                                SA3 352 
95    WRITE (JTAPE,113) Y,DEN                                           SA3 353 
      GO TO 97                                                          SA3 354 
96    NDIM1=NDIM                                                        SA3 355 
      NDIM=NDIM-1                                                       SA3 356 
      GO TO 19                                                          SA3 357 
C     SUBSTITUTE YOUR OWN PROGRAM CALL FOR MULTIPLE CORE LOADS OR CHAIN SA3 358 
C     JOBS.                                                             SA3 359 
97    CALL PUNT ('-CORE1 ',0,0)                                         SA3 360 
C     *** FORMAT STATEMENTS ***                                         SA3 361 
C                                                                       SA3 362 
98    FORMAT (72H                                                       SA3 363 
     1                 )                                                SA3 364 
99    FORMAT (14H1DETERMINANT =,E12.6/30H0SQUARED MULTIPLE CORRELATIONS/SA3 365 
     1(10F10.4))                                                        SA3 366 
100   FORMAT (11H1 ITERATION,5X17HNO. ROOTS .GE. H2,5X15HNO. ROOTS .G. 0SA3 367 
     1,5X11HCOMMUNALITY,5X11HTRACE PROP.,5X13HR(R(T),R*(T)),5X5HALPHA,5XSA3 368 
     24HBETA/1H ,122(1H-))                                              SA3 369 
101   FORMAT (107H0DEGENERATE SOLUTION.  SET NDIM=NO. ROOTS .G. 0 ON ITESA3 370 
     1RATION 1 OF FIRST CYCLE AND MIND=YOUR PRESENT NDIM+1./88H IF, HOWESA3 371 
     2VER, A SATISFACTORY SOLUTION HAS ALREADY BEEN GIVEN IN HIGHER SPACSA3 372 
     3E, FORGET IT.)                                                    SA3 373 
102   FORMAT (I7,9XI9,13XI8,12XF8.4,8XF8.4,8XF9.4,F14.4,F9.4)           SA3 374 
103   FORMAT (40H0PRINCIPAL AXES OF INITIAL CONFIGURATION)              SA3 375 
104   FORMAT (62H0PRINCIPAL AXES COORDINATES OF FINAL SOLUTION FOR G-L(SSA3 376 
     1SA-III))                                                          SA3 377 
105   FORMAT (10H0DIMENSION/1H0,I12,17I7)                               SA3 378 
106   FORMAT (6X126(1H-))                                               SA3 379 
107   FORMAT (I4,2X18F7.4)                                              SA3 380 
108   FORMAT (6H0ROOT=,18F7.2)                                          SA3 381 
109   FORMAT (28H0COEFFICIENT OF ALIENATION =,E12.6)                    SA3 382 
110   FORMAT (15H0R(R(0),R(T)) =,E12.6/4H0Y =,F9.6,3HX +,E12.6/29H0COEFFSA3 383 
     1ICIENT OF DEFORMATION =,E12.6)                                    SA3 384 
111   FORMAT (28H0NORMALIZED VARIMAX ROTATION)                          SA3 385 
112   FORMAT (14H0COMMUNALITIES/(10F10.4))                              SA3 386 
113   FORMAT (6H1SINCE,F6.3,56H OF THE COEFFICIENTS ARE WITHIN + OR -.10SA3 387 
     1 OF THE MEAN OF,F7.4,43H NO FURTHER REDUCTION IN NDIM IS WARRANTEDSA3 388 
     2./87H IF A SATISFACTORY SOLUTION IN HIGHER SPACE HAS NOT BEEN ACHISA3 389 
     3EVED ADJUST NDIM AND MIND.)                                       SA3 390 
      END                                                               SA3 391-
                                                                                
 *** USE PLOT,EIGEN,SORT,AND MXOUT OF FILE 1 AND MATINV OF FILE 5 ***           
                                                                                
1MULTIVARIATE ANALYSIS OF CONTINGENCIES - (8 GUTTMAN-LINGOES SCALES).           
   9  88   1                                                                    
(4X9I2)                                                                         
   1 11813 1 9 7 9 8 1                                                          
   2 414 9 2 9 5 3 3 1                                                          
   3 21813 2 9 8 9 8 1                                                          
   4 11613 1 9 8 9 8 1                                                          
   5 81713 2 9 7 9 8 1                                                          
   6 31812 4 9 7 9 8 1                                                          
   7 31612 1 9 7 5 1 1                                                          
   8 21812 1 9 7 9 8 1                                                          
   9 11712 1 9 8 9 8 1                                                          
  10 21510 1 9 8 8 8 1                                                          
  11 31211 5 8 5 5 4 1                                                          
  12 71313 6 9 8 9 8 1                                                          
  13 41512 1 8 8 8 8 1                                                          
  14 51713 1 9 8 9 8 1                                                          
  15 11612 2 9 7 7 8 1                                                          
  16 112 7 2 6 5 5 3 1                                                          
  17 11312 1 8 4 9 7 1                                                          
  18 81311 7 7 7 3 2 2                                                          
  19 81612 6 8 8 9 8 2                                                          
  20 81413 7 8 8 9 8 2                                                          
  21 41313 6 7 7 9 8 2                                                          
  22 71312 7 7 7 9 8 2                                                          
  23 81712 7 9 8 9 8 2                                                          
  24 1 5 3 6 4 2 1 1 2                                                          
  25 81211 9 6 4 3 3 2                                                          
  26 81112 3 7 7 9 8 2                                                          
  27 81713 5 9 8 9 8 2                                                          
  28 31313 5 7 7 9 8 2                                                          
  29 81313 7 8 7 9 8 2                                                          
  30 81812 7 8 8 9 8 2                                                          
  31 8 9 6 8 6 3 3 4 2                                                          
  32 41313 5 6 6 9 8 2                                                          
  33 81313 7 7 8 8 8 2                                                          
  34 81713 7 9 7 9 8 2                                                          
  35 81313 7 7 6 9 7 2                                                          
  36 81713 6 9 7 9 8 2                                                          
  37 81812 7 9 7 8 8 2                                                          
  38 81712 4 9 8 9 8 2                                                          
  39 81312 7 7 8 9 8 2                                                          
  40 81312 7 7 8 7 8 2                                                          
  41 81213 6 6 7 9 8 2                                                          
  42 81212 8 8 4 9 8 2                                                          
  43 81212 6 7 8 9 8 2                                                          
  44 81313 7 7 6 9 8 2                                                          
  45 4 7 5 2 2 4 3 4 3                                                          
  46 3 9 4 5 7 2 2 6 3                                                          
  47 311 9 2 5 8 9 7 3                                                          
  48 4 5 2 6 3 6 1 6 3                                                          
  49 710 4 1 5 4 5 8 3                                                          
  50 5 6 5 7 3 6 2 2 3                                                          
  51 5 7 9 2 3 5 6 8 3                                                          
  52 5 4 4 8 3 4 2 1 3                                                          
  53 3 6 1 2 2 5 3 3 3                                                          
  54 3 410 1 5 4 5 7 3                                                          
  55 7 9 9 6 4 8 9 7 3                                                          
  56 4 5 2 2 3 5 1 7 3                                                          
  57 2 4 2 2 1 5 2 1 3                                                          
  58 7 6 5 7 3 5 2 3 3                                                          
  59 4 8 6 4 5 7 4 2 3                                                          
  60 6 4 3 9 3 3 2 1 3                                                          
  61 6 9 9 7 7 6 9 8 3                                                          
  62 4 8 8 2 5 6 3 4 3                                                          
  63 4 7 6 1 3 6 1 1 3                                                          
  64 5 5 6 5 2 2 7 8 3                                                          
  65 6 2 1 9 2 2 2 5 3                                                          
  66 7 5 310 3 2 1 1 4                                                          
  67 6 2 211 2 2 3 1 4                                                          
  68 7 3 211 1 2 1 1 4                                                          
  69 7 6 510 4 3 6 7 4                                                          
  70 6 4 8 9 3 3 7 8 4                                                          
  71 8 1 310 1 1 1 1 4                                                          
  72 6 2 111 1 1 1 1 4                                                          
  73 8 5 211 3 1 1 1 4                                                          
  74 7 3 111 1 2 1 1 4                                                          
  75 7 3 710 4 2 8 8 4                                                          
  76 8 4 410 3 2 5 7 4                                                          
  77 6 1 211 1 1 1 1 4                                                          
  78 8 2 311 1 1 1 2 4                                                          
  79 5 5 111 2 2 1 1 4                                                          
  80 5 6 1 9 2 2 4 6 4                                                          
  81 8 2 510 2 1 3 5 4                                                          
  82 7 1 111 1 1 3 1 4                                                          
  83 8 2 1 7 1 1 2 1 4                                                          
  84 6 4 311 1 1 2 1 4                                                          
  85 7 2 310 2 1 1 3 4                                                          
  86 8 6 410 2 2 1 1 4                                                          
  87 7 2 210 2 1 1 1 4                                                          
  88 5 1 110 1 1 1 1 4                                                          
1CORRELATIONS BASED ON MAC I SCALING.                                           
1NONMETRIC FACTOR ANALYSIS OF MAC I SCORING SYSTEM.                             
                                                                                
C     MAC2-CORE1                                                        CD2   1 
C     LINGOES MULTIVARIATE ANALYSIS OF CONTINGENCIES - CORE 1 (3/15/63).CD2   2 
C                                                                       CD2   3 
C     *** REFERENCES - LINGOES,J. C.,  MULTIVARIATE ANALYSIS OF CONTIN- CD2   4 
C                        GENCIES - AN IBM 7090 PROGRAM FOR ANALYZING    CD2   5 
C                        METRIC/NONMETRIC OR LINEAR/NONLINEAR DATA.     CD2   6 
C                        COMP. RPT., 1963,2,1-24.                       CD2   7 
C                      LINGOES, J. C.,  SIMULTANEOUS LINEAR REGRESSIONS-CD2   8 
C                        AN IBM 7090 PROGRAM FOR ANALYZING METRIC/NON-  CD2   9 
C                        METRIC OR LINEAR/NONLINEAR DATA.  BEHAV. SCI., CD2  10 
C                        1964,9,87-88.                                  CD2  11 
C                                                                       CD2  12 
      DIMENSION R(101,50), MATR(101,50), MP(21), A(100,100), FCAT(50,20)CD2  13 
     1, FMT(18)                                                         CD2  14 
      EQUIVALENCE (R,MATR)                                              CD2  15 
      COMMON R,A,FCAT                                                   CD2  16 
C                                                                       CD2  18 
C     TAPE ASSIGNMENTS -                                                CD2  19 
      ITAPE=5                                                           CD2  20 
      JTAPE=6                                                           CD2  21 
      READ (ITAPE,67)                                                   CD2  22 
      WRITE (JTAPE,67)                                                  CD2  23 
      READ (ITAPE,68) NV,NS,IFCODE,MAX,NCAT,IFCDS,CODE                  CD2  24 
      READ (ITAPE,69) (FMT(I),I=1,18)                                   CD2  25 
      DO 1 I=1,NS                                                       CD2  26 
1     READ (ITAPE,FMT) (R(I,J),J=1,NV)                                  CD2  27 
      CALL REWIND (3)                                                           
      FNS=NS                                                            CD2  29 
      NSP1=NS+1                                                         CD2  30 
      IFCODE=IFCODE+1                                                   CD2  31 
      GO TO (2,20), IFCODE                                              CD2  32 
C     CHECK FOR MISSING DATA AND SUBSTITUTE MEANS IF THEY EXIST         CD2  33 
2     IF (CODE) 3,11,3                                                  CD2  34 
3     DO 10 J=1,NV                                                      CD2  35 
      COUNT=0.                                                          CD2  36 
      SUM=0.                                                            CD2  37 
      DO 6 I=1,NS                                                       CD2  38 
      IF (R(I,J)-CODE) 5,4,5                                            CD2  39 
4     COUNT=COUNT+1.                                                    CD2  40 
      GO TO 6                                                           CD2  41 
5     SUM=SUM+R(I,J)                                                    CD2  42 
6     CONTINUE                                                          CD2  43 
      IF (COUNT) 7,10,7                                                 CD2  44 
7     SUM=SUM/(FNS-COUNT)                                               CD2  45 
      DO 9 I=1,NS                                                       CD2  46 
      IF (R(I,J)-CODE) 9,8,9                                            CD2  47 
8     R(I,J)=SUM                                                        CD2  48 
9     CONTINUE                                                          CD2  49 
10    CONTINUE                                                          CD2  50 
C     COMPUTE CODED SCORES FOR EACH VARIABLE                            CD2  51 
11    WRITE (JTAPE,70)                                                  CD2  52 
      PGRPS=MAX                                                         CD2  53 
      DO 19 J=1,NV                                                      CD2  54 
      BIG=0.                                                            CD2  55 
      SMALL=10000.                                                      CD2  56 
      DO 15 I=1,NS                                                      CD2  57 
      IF (BIG-R(I,J)) 12,13,13                                          CD2  58 
12    BIG=R(I,J)                                                        CD2  59 
13    IF (R(I,J)-SMALL) 14,15,15                                        CD2  60 
14    SMALL=R(I,J)                                                      CD2  61 
15    CONTINUE                                                          CD2  62 
      CODE=(BIG-SMALL+1.)/PGRPS                                         CD2  63 
      WRITE (JTAPE,71) J,SMALL,BIG,CODE                                 CD2  64 
      DO 18 I=1,NS                                                      CD2  65 
      R(I,J)=R(I,J)-SMALL                                               CD2  66 
      DO 17 K=1,21                                                      CD2  67 
      R(I,J)=R(I,J)-CODE                                                CD2  68 
      IF (R(I,J)) 16,17,17                                              CD2  69 
16    MATR(I,J)=K                                                       CD2  70 
      GO TO 18                                                          CD2  71 
17    CONTINUE                                                          CD2  72 
      MATR(I,J)=21                                                      CD2  73 
18    CONTINUE                                                          CD2  74 
19    CONTINUE                                                          CD2  75 
C     SET FREQUENCIES FOR EACH CATEGORY ACCORDING TO PARAMETER          CD2  76 
20    IF (NCAT) 50,50,21                                                CD2  77 
21    DO 49 J=1,NV                                                      CD2  78 
      DO 22 K=1,21                                                      CD2  79 
22    MP(K)=0                                                           CD2  80 
      DO 23 I=1,NS                                                      CD2  81 
      KK=MATR(I,J)                                                      CD2  82 
23    MP(KK)=1                                                          CD2  83 
      KK=0                                                              CD2  84 
      DO 25 L=1,21                                                      CD2  85 
      IF (MP(L)) 25,25,24                                               CD2  86 
24    KK=KK+1                                                           CD2  87 
      MP(L)=KK                                                          CD2  88 
25    CONTINUE                                                          CD2  89 
      LL=KK-1                                                           CD2  90 
      DO 26 M=1,NS                                                      CD2  91 
      INDEXI=MATR(M,J)                                                  CD2  92 
26    MATR(M,J)=MP(INDEXI)                                              CD2  93 
      DO 27 K=1,21                                                      CD2  94 
27    MP(K)=0                                                           CD2  95 
      DO 28 I=1,NS                                                      CD2  96 
      INDEXI=MATR(I,J)                                                  CD2  97 
28    MP(INDEXI)=MP(INDEXI)+1                                           CD2  98 
      DO 38 K=2,LL                                                      CD2  99 
      KM1=K                                                             CD2 100 
      IF (MP(K)-NCAT) 29,38,38                                          CD2 101 
29    KM1=KM1-1                                                         CD2 102 
      IF (MP(KM1)) 30,29,30                                             CD2 103 
30    KP1=K+1                                                           CD2 104 
      IF (MP(KM1)-MP(KP1)) 31,34,34                                     CD2 105 
31    MP(KM1)=MP(KM1)+MP(K)                                             CD2 106 
      DO 33 I=1,NS                                                      CD2 107 
      IF (MATR(I,J)-K) 33,32,33                                         CD2 108 
32    MATR(I,J)=KM1                                                     CD2 109 
33    CONTINUE                                                          CD2 110 
      GO TO 37                                                          CD2 111 
34    MP(KP1)=MP(KP1)+MP(K)                                             CD2 112 
      DO 36 I=1,NS                                                      CD2 113 
      IF (MATR(I,J)-K) 36,35,36                                         CD2 114 
35    MATR(I,J)=KP1                                                     CD2 115 
36    CONTINUE                                                          CD2 116 
37    MP(K)=0                                                           CD2 117 
38    CONTINUE                                                          CD2 118 
      IF (MP(1)-NCAT) 39,44,44                                          CD2 119 
39    K=1                                                               CD2 120 
40    K=K+1                                                             CD2 121 
      IF (MP(K)) 41,40,41                                               CD2 122 
41    DO 43 I=1,NS                                                      CD2 123 
      IF (MATR(I,J)-1) 43,42,43                                         CD2 124 
42    MATR(I,J)=K                                                       CD2 125 
43    CONTINUE                                                          CD2 126 
44    LL=LL+1                                                           CD2 127 
      IF (MP(LL)-NCAT) 45,49,49                                         CD2 128 
45    LL=LL-1                                                           CD2 129 
      IF (MP(LL)) 46,45,46                                              CD2 130 
46    DO 48 I=1,NS                                                      CD2 131 
      IF (MATR(I,J)-KK) 48,47,48                                        CD2 132 
47    MATR(I,J)=LL                                                      CD2 133 
48    CONTINUE                                                          CD2 134 
49    CONTINUE                                                          CD2 135 
C     REPLACE CODED SCORES WITH COMPACT RANKS                           CD2 136 
50    DO 55 J=1,NV                                                      CD2 137 
      DO 51 K=1,21                                                      CD2 138 
51    MP(K)=0                                                           CD2 139 
      DO 52 I=1,NS                                                      CD2 140 
      KK=MATR(I,J)                                                      CD2 141 
52    MP(KK)=1                                                          CD2 142 
      KK=0                                                              CD2 143 
      DO 54 L=1,21                                                      CD2 144 
      IF (MP(L)) 54,54,53                                               CD2 145 
53    KK=KK+1                                                           CD2 146 
      MP(L)=KK                                                          CD2 147 
54    CONTINUE                                                          CD2 148 
      MATR(NSP1,J)=KK                                                   CD2 149 
      DO 55 M=1,NS                                                      CD2 150 
      KK=MATR(M,J)                                                      CD2 151 
55    MATR(M,J)=MP(KK)                                                  CD2 152 
      NVM1=NV-1                                                         CD2 153 
      WRITE (JTAPE,72)                                                  CD2 154 
      WRITE (JTAPE,73) (KK,KK=1,21)                                     CD2 155 
      DO 59 I=1,NV                                                      CD2 156 
      LL=MATR(NSP1,I)                                                   CD2 157 
      DO 56 J=1,LL                                                      CD2 158 
56    MP(J)=0                                                           CD2 159 
      DO 57 K=1,NS                                                      CD2 160 
      INDEXI=MATR(K,I)                                                  CD2 161 
57    MP(INDEXI)=MP(INDEXI)+1                                           CD2 162 
      DO 58 KK=1,LL                                                     CD2 163 
58    FCAT(I,KK)=MP(KK)                                                 CD2 164 
59    WRITE (JTAPE,74) I,(MP(L),L=1,LL)                                 CD2 165 
      CALL REWIND (9)                                                           
      WRITE (3) NV,NVM1,NS,NSP1,(MATR(NSP1,J),J=1,NV)                           
      DO 60 I=1,NV                                                      CD2 168 
      LL=MATR(NSP1,I)                                                   CD2 169 
60    WRITE (3) (FCAT(I,J),J=1,LL)                                              
      DO 64 I=1,NS                                                      CD2 171 
      DO 63 J=I,NS                                                      CD2 172 
      A(I,J)=0.                                                         CD2 173 
      DO 62 K=1,NV                                                      CD2 174 
      IF (MATR(I,K)-MATR(J,K)) 62,61,62                                 CD2 175 
61    KK=MATR(I,K)                                                      CD2 176 
      COUNT=1./FCAT(K,KK)                                               CD2 177 
      A(I,J)=A(I,J)+COUNT                                               CD2 178 
62    CONTINUE                                                          CD2 179 
63    A(J,I)=A(I,J)                                                     CD2 180 
64    WRITE (3) (A(I,L),L=1,NS)                                                 
      CALL REWIND (3)                                                           
      DO 66 I=1,NS                                                      CD2 183 
      IF (IFCDS) 66,66,65                                               CD2 184 
65    PUNCH 75, I,(MATR(I,K),K=1,NV)                                    CD2 185 
66    WRITE (9) (MATR(I,J),J=1,NV)                                              
      CALL REWIND (9)                                                           
C     INSERT CALL FOR MULTIPLE CORE LOAD SUBROUTINE.                    CD2 188 
      CALL PUNT ('-SIMLIN ',0,0)                                        CD2 189 
C     *** FORMAT STATEMENTS ***                                         CD2 190 
C                                                                       CD2 191 
67    FORMAT (72H                                                       CD2 192 
     1                 )                                                CD2 193 
68    FORMAT (6I4,F8.4)                                                 CD2 194 
69    FORMAT (18A4)                                                     CD2 195 
70    FORMAT (10H0 VARIABLE,10X13HSCORE   RANGE,10X14HCODED INTERVAL/1H CD2 196 
     1,57(1H-)/1H )                                                     CD2 197 
71    FORMAT (I7,E17.6,4H TO ,E12.6,E16.6)                              CD2 198 
72    FORMAT (1H1,43X44HFREQUENCY DISTRIBUTION FOR RANKED CODED DATA)   CD2 199 
73    FORMAT (6H0 VAR.,21I6/1H ,131(1H-)/1H )                           CD2 200 
74    FORMAT (22I6)                                                     CD2 201 
75    FORMAT (I4,34I2/(36I2))                                           CD2 202 
      END                                                               CD2 203-
C     MAC2-CORE 2                                                       SL2   1 
C     LINGOES-GUTTMAN SIMULTANEOUS LINEARIZATION PROGRAM.               SL2   2 
C                                                                       SL2   3 
      DIMENSION A(100,100), MAT(100,100), V(10000), B(10000), C(100,100)SL2   4 
     1, FCAT(50,20), SCORE(50,20), ETA(21), NCAT(50), GUTSCR(50)        SL2   5 
      COMMON A,B                                                        SL2   6 
      EQUIVALENCE (A,MAT,V), (B,C)                                      SL2   7 
C                                                                       SL2   9 
C     TAPE ASSIGNMENTS -                                                SL2  10 
      JTAPE=6                                                           SL2  11 
      CALL REWIND (3)                                                           
      CALL REWIND (4)                                                           
      CALL REWIND (9)                                                           
      READ (3) NV,NVM1,NS,NSP1,(NCAT(J),J=1,NV)                                 
      KK=0                                                              SL2  16 
      DO 1 I=1,NV                                                       SL2  17 
      LL=NCAT(I)                                                        SL2  18 
      KK=KK+LL                                                          SL2  19 
1     READ (3) (FCAT(I,J),J=1,LL)                                               
      DF=KK-NV+NS                                                       SL2  21 
      NI=22                                                             SL2  22 
      DO 3 I=1,NV                                                       SL2  23 
      IF (NCAT(I)-NI) 2,3,3                                             SL2  24 
2     NI=NCAT(I)                                                        SL2  25 
3     CONTINUE                                                          SL2  26 
      IF (21-NS) 5,5,4                                                  SL2  27 
4     NR=NS                                                             SL2  28 
      GO TO 6                                                           SL2  29 
5     NR=21                                                             SL2  30 
6     FNVM1=NVM1                                                        SL2  31 
      FF=NS                                                             SL2  32 
      DEN=SQRT(FF)*FNVM1                                                SL2  33 
      DO 7 I=1,NS                                                       SL2  34 
7     READ (3) (A(I,J),J=1,NS)                                                  
      CALL REWIND (3)                                                           
C     CALL ON HOUSEHOLDER SUBROUTINE                                    SL2  37 
      CALL EIGEN (A,C,NS,ETA,NR)                                        SL2  38 
      DO 8 J=1,NR                                                       SL2  39 
8     ETA(J)=(ETA(J)-1.)/FNVM1                                          SL2  40 
      DO 9 J=1,NR                                                       SL2  41 
      DO 9 I=1,NS                                                       SL2  42 
9     C(I,J)=C(I,J)                                                     SL2  43 
      WRITE (JTAPE,33) (II,II=1,20)                                     SL2  44 
      DO 10 I=1,NS                                                      SL2  45 
10    WRITE (JTAPE,36) I,(C(I,J),J=2,NR)                                SL2  46 
      WRITE (JTAPE,34)                                                  SL2  47 
      DO 11 I=1,NS                                                      SL2  48 
11    READ (9) (MAT(I,J),J=1,NV)                                                
      WRITE (4) NV,NS                                                           
      DO 19 J=1,NI                                                      SL2  51 
      DO 14 K=1,NV                                                      SL2  52 
      LL=NCAT(K)                                                        SL2  53 
      DO 14 M=1,LL                                                      SL2  54 
      SCORE(K,M)=0.                                                     SL2  55 
      DO 13 L=1,NS                                                      SL2  56 
      IF (MAT(L,K)-M) 13,12,13                                          SL2  57 
12    SCORE(K,M)=SCORE(K,M)+C(L,J)                                      SL2  58 
13    CONTINUE                                                          SL2  59 
14    SCORE(K,M)=SCORE(K,M)/FCAT(K,M)                                   SL2  60 
      WRITE (JTAPE,35) J,ETA(J),(MMM,MMM=1,20)                          SL2  61 
      DO 15 N=1,NV                                                      SL2  62 
      II=NCAT(N)                                                        SL2  63 
15    WRITE (JTAPE,36) N,(SCORE(N,JJ),JJ=1,II)                          SL2  64 
      IF (2-J) 19,16,19                                                 SL2  65 
16    DO 18 II=1,NS                                                     SL2  66 
      DO 17 JJ=1,NV                                                     SL2  67 
      KK=MAT(II,JJ)                                                     SL2  68 
17    GUTSCR(JJ)=SCORE(JJ,KK)                                           SL2  69 
18    WRITE (4) (GUTSCR(LL),LL=1,NV)                                            
19    CONTINUE                                                          SL2  71 
      CALL REWIND (4)                                                           
      IF (NR-3) 32,20,20                                                SL2  73 
20    DO 21 J=2,NI                                                      SL2  74 
      FF=SQRT(ETA(J))                                                   SL2  75 
      DO 21 I=1,NS                                                      SL2  76 
21    C(I,J)=C(I,J)*FF                                                  SL2  77 
      NVM1=NS-1                                                         SL2  78 
      DO 23 J=1,NVM1                                                    SL2  79 
      NN=J+1                                                            SL2  80 
      DO 23 I=NN,NS                                                     SL2  81 
      A(I,J)=0.                                                         SL2  82 
      DO 22 K=2,NI                                                      SL2  83 
22    A(I,J)=A(I,J)+(C(J,K)-C(I,K))**2                                  SL2  84 
      A(I,J)=SQRT(A(I,J))                                               SL2  85 
23    A(J,I)=A(I,J)                                                     SL2  86 
      DO 29 I=1,NS                                                      SL2  87 
      FF=0.                                                             SL2  88 
      FNVM1=1000.                                                       SL2  89 
      DO 28 J=1,NS                                                      SL2  90 
      IF (I-J) 24,28,24                                                 SL2  91 
24    IF (FF-A(I,J)) 25,26,26                                           SL2  92 
25    FF=A(I,J)                                                         SL2  93 
      JJ=J                                                              SL2  94 
26    IF (A(I,J)-FNVM1) 27,28,28                                        SL2  95 
27    FNVM1=A(I,J)                                                      SL2  96 
      NN=J                                                              SL2  97 
28    CONTINUE                                                          SL2  98 
29    A(I,I)=FLOAT(JJ)+.001*FLOAT(NN)                                   SL2  99 
      CALL MXOUT (A,NS)                                                 SL2 100 
      NN=NI-1                                                           SL2 101 
      WRITE (3) NN,NS                                                           
      DO 30 I=1,NS                                                      SL2 103 
30    WRITE (3) (C(I,J),J=2,NI)                                                 
      DO 31 I=2,NS                                                      SL2 105 
      II=I-1                                                            SL2 106 
31    WRITE (3) (A(I,J),J=1,II)                                                 
      CALL REWIND (3)                                                           
C     INSERT CALL FOR MULTIPLE CORE LOAD SUBROUTINE.                    SL2 109 
      CALL PUNT ('-MAXMIN ',0,0)                                        SL2 110 
C     INSERT CALL FOR MULTIPLE CORE LOAD SUBROUTINE BYPASSING CLUSTER   SL2 111 
C     ANALYSIS.                                                         SL2 112 
32    CALL PUNT ('-CORR ',0,0)                                          SL2 113 
C     *** FORMAT STATEMENTS ***                                         SL2 114 
C                                                                       SL2 115 
C                                                                       SL2 116 
33    FORMAT (39H1SCORES FOR EACH SUBJECT ON EACH VECTOR/7H0VECTOR,5X20ISL2 117 
     16/1H ,131(1H-)/8H SUBJECT)                                        SL2 118 
34    FORMAT (1H1,42X46HLINGOES MULTIVARIATE ANALYSIS OF CONTINGENCIES/1SL2 119 
     17H0CATEGORY WEIGHTS/1H ,16(1H-))                                  SL2 120 
35    FORMAT (7H0VECTOR,I4,1H.,5X5HETA =,F5.3/9H CATEGORY,3X20I6/1H ,131SL2 121 
     1(1H-)/9H VARIABLE)                                                SL2 122 
36    FORMAT (I6,6X3P20F6.0)                                            SL2 123 
      END                                                               SL2 124-
C     MXOUT                                                             MXT   1 
C     SUBROUTINE TO PRINT EUCLIDEAN METRIC DISTANCES IN MATRIX FORM     MXT   2 
C                                                                       MXT   3 
      SUBROUTINE MXOUT (R,N)                                            MXT   4 
      DIMENSION R(100,100)                                              MXT   5 
C                                                                       MXT   6 
C     TAPE ASSIGNMENT -                                                 MXT   7 
      JTAPE=6                                                           MXT   8 
      K=17                                                              MXT   9 
      I=N/K                                                             MXT  10 
      IF (N-I*K) 2,2,1                                                  MXT  11 
1     I=I+1                                                             MXT  12 
2     ITOTAL=(I*(I+1))/2                                                MXT  13 
      IPAGE=0                                                           MXT  14 
      I1=1-K                                                            MXT  15 
3     I1=I1+K                                                           MXT  16 
      I2=I1+K-1                                                         MXT  17 
      IF (I2-N) 5,5,4                                                   MXT  18 
4     I2=N                                                              MXT  19 
5     J1=1-K                                                            MXT  20 
6     J1=J1+K                                                           MXT  21 
      J2=J1+K-1                                                         MXT  22 
      IF (J2-N) 8,8,7                                                   MXT  23 
7     J2=N                                                              MXT  24 
8     IPAGE=IPAGE+1                                                     MXT  25 
      WRITE (JTAPE,16) IPAGE,ITOTAL,(J,J=J1,J2)                         MXT  26 
      IF (J2-I2) 9,10,10                                                MXT  27 
9     ISWTCH=2                                                          MXT  28 
      GO TO 11                                                          MXT  29 
10    ISWTCH=1                                                          MXT  30 
11    DO 13 I=I1,I2                                                     MXT  31 
      GO TO (12,13), ISWTCH                                             MXT  32 
12    J2=I                                                              MXT  33 
13    WRITE (JTAPE,17) I,(R(I,J),J=J1,J2)                               MXT  34 
      GO TO (14,6), ISWTCH                                              MXT  35 
14    IF (I2-N) 3,15,15                                                 MXT  36 
15    RETURN                                                            MXT  37 
C     * * * * * *   T  H  E    E  N  D   * * * * * *                    MXT  38 
C     *** FORMAT STATEMENTS ***                                         MXT  39 
C                                                                       MXT  40 
16    FORMAT (1H1,36(1H ),42H     E U C L I D E A N   D I S T A N C E S,MXT  41 
     124(1H ),9HPAGE NO. ,I2,4H OF ,I2//12H0COLUMN =   ,17I7)           MXT  42 
17    FORMAT (1H /8H0 ROW = ,I3,1H ,17(F7.3))                           MXT  43 
      END                                                               MXT  44-
                                                                                
 *** INSERT EIGEN SUBROUTINE (EG1), PROPERLY DIMENSIONED. ***                   
                                                                                
C     MAXMIN-CORE 3                                                     MXM   1 
C     LINGOES MAX-MIN CLUSTER ANALYSIS - 10/18/63.                      MXM   2 
C                                                                       MXM   3 
      DIMENSION DIST(100,100), CORD(100,21), INDEX(100,100), NCLUS(100),MXM   4 
     1 TTEST(25), ID(25), SFN(25)                                       MXM   5 
      COMMON DIST,INDEX                                                 MXM   6 
C                                                                       MXM   8 
C     TAPE ASSIGNMENTS -                                                MXM   9 
      JTAPE=6                                                           MXM  10 
      CALL REWIND (3)                                                           
      CALL REWIND (9)                                                           
      READ (3) NR,NS                                                            
      DO 1 I=1,NS                                                       MXM  14 
1     READ (3) (CORD(I,J),J=1,NR)                                               
      DO 2 I=2,NS                                                       MXM  16 
      IM1=I-1                                                           MXM  17 
2     READ (3) (DIST(I,J),J=1,IM1)                                              
      SUMD=0.                                                           MXM  19 
      SUMDSQ=0.                                                         MXM  20 
      NSM1=NS-1                                                         MXM  21 
      DO 3 J=1,NSM1                                                     MXM  22 
      IM1=J+1                                                           MXM  23 
      DIST(J,J)=0.                                                      MXM  24 
      DO 3 I=IM1,NS                                                     MXM  25 
      SUMD=SUMD+DIST(I,J)                                               MXM  26 
      SUMDSQ=SUMDSQ+DIST(I,J)**2                                        MXM  27 
3     DIST(J,I)=DIST(I,J)                                               MXM  28 
      DIST(NS,NS)=0.                                                    MXM  29 
      WRITE (9) ((CORD(I,J),J=1,NR),I=1,NS)                                     
      FN=(NS*NSM1)/2                                                    MXM  31 
      SUMDSQ=SQRT((FN*SUMDSQ-SUMD**2)/FN**2)                            MXM  32 
      SIGMAD=SUMDSQ/2.                                                  MXM  33 
      QSD=SIGMAD/4.                                                     MXM  34 
      NL=0                                                              MXM  35 
      NC=NS                                                             MXM  36 
      LEVEL=0                                                           MXM  37 
      NRP1=NR+1                                                         MXM  38 
      ITEST=NS-NS/4                                                     MXM  39 
      DO 4 I=1,NS                                                       MXM  40 
      INDEX(I,1)=1                                                      MXM  41 
      INDEX(I,2)=I                                                      MXM  42 
4     CORD(I,NRP1)=1.                                                   MXM  43 
5     LEVEL=LEVEL+1                                                     MXM  44 
      CALL REWIND (9)                                                           
      DMEAN=SUMD/FN                                                     MXM  46 
      WRITE (JTAPE,63) DMEAN,SUMDSQ                                     MXM  47 
      NL=NL+1                                                           MXM  48 
      IF (NL-6) 8,6,8                                                   MXM  49 
6     IF (ITEST-NC) 7,8,8                                               MXM  50 
7     WRITE (JTAPE,64)                                                  MXM  51 
      GO TO 54                                                          MXM  52 
8     IF (NL-14) 9,54,54                                                MXM  53 
9     WRITE (JTAPE,65) LEVEL                                            MXM  54 
      WRITE (JTAPE,66) SIGMAD                                           MXM  55 
      NCL=0                                                             MXM  56 
      CALL REWIND (3)                                                           
10    IM1=0                                                             MXM  58 
      DO 16 I=1,NC                                                      MXM  59 
      NCLUS(I)=0                                                        MXM  60 
      IF (DIST(I,I)-100.) 11,16,16                                      MXM  61 
11    DIST(I,I)=0.                                                      MXM  62 
      DO 15 J=1,NC                                                      MXM  63 
      IF (I-J) 12,15,12                                                 MXM  64 
12    IF (DIST(I,J)-100.) 13,15,15                                      MXM  65 
13    IF (SIGMAD-DIST(I,J)) 15,14,14                                    MXM  66 
14    NCLUS(I)=NCLUS(I)+1                                               MXM  67 
      DIST(I,I)=DIST(I,I)+DIST(I,J)**2                                  MXM  68 
      IM1=IM1+1                                                         MXM  69 
15    CONTINUE                                                          MXM  70 
16    CONTINUE                                                          MXM  71 
      IF (IM1) 39,39,17                                                 MXM  72 
17    IM1=0                                                             MXM  73 
      NCL=NCL+1                                                         MXM  74 
      DO 21 I=1,NC                                                      MXM  75 
      IF (NCLUS(I)) 18,21,18                                            MXM  76 
18    IF (IM1-NCLUS(I)) 19,20,21                                        MXM  77 
19    IM1=NCLUS(I)                                                      MXM  78 
      KK=I                                                              MXM  79 
      GO TO 21                                                          MXM  80 
20    IF (DIST(KK,KK)-DIST(I,I)) 21,21,19                               MXM  81 
21    CONTINUE                                                          MXM  82 
      NSM1=0                                                            MXM  83 
      DO 24 I=1,NC                                                      MXM  84 
      IF (I-KK) 22,24,22                                                MXM  85 
22    IF (SIGMAD-DIST(I,KK)) 24,23,23                                   MXM  86 
23    NSM1=NSM1+1                                                       MXM  87 
      NCLUS(NSM1)=I                                                     MXM  88 
24    CONTINUE                                                          MXM  89 
      FN=CORD(KK,NRP1)                                                  MXM  90 
      DO 25 J=1,NR                                                      MXM  91 
25    CORD(KK,J)=CORD(KK,J)*FN                                          MXM  92 
      DO 28 J=1,IM1                                                     MXM  93 
      JJ=NCLUS(J)                                                       MXM  94 
      DO 26 K=1,NC                                                      MXM  95 
      DIST(JJ,K)=100.                                                   MXM  96 
26    DIST(K,JJ)=100.                                                   MXM  97 
      DO 27 L=1,NR                                                      MXM  98 
27    CORD(KK,L)=CORD(KK,L)+CORD(JJ,L)*CORD(JJ,NRP1)                    MXM  99 
      CORD(KK,NRP1)=CORD(KK,NRP1)+CORD(JJ,NRP1)                         MXM 100 
28    CORD(JJ,NRP1)=0.                                                  MXM 101 
      FN=CORD(KK,NRP1)                                                  MXM 102 
      DO 29 J=1,NR                                                      MXM 103 
29    CORD(KK,J)=CORD(KK,J)/FN                                          MXM 104 
      DO 30 I=1,NC                                                      MXM 105 
      DIST(I,KK)=100.                                                   MXM 106 
30    DIST(KK,I)=100.                                                   MXM 107 
      NSM1=0                                                            MXM 108 
      DO 32 I=1,NS                                                      MXM 109 
      IF (INDEX(I,1)) 31,32,31                                          MXM 110 
31    NSM1=NSM1+1                                                       MXM 111 
      IF (NSM1-KK) 32,33,32                                             MXM 112 
32    CONTINUE                                                          MXM 113 
33    KK=I                                                              MXM 114 
      DO 38 J=1,IM1                                                     MXM 115 
      NSM1=0                                                            MXM 116 
      DO 37 I=1,NS                                                      MXM 117 
      IF (INDEX(I,1)) 34,37,34                                          MXM 118 
34    NSM1=NSM1+1                                                       MXM 119 
      IF (NSM1-NCLUS(J)) 37,35,37                                       MXM 120 
35    LL=INDEX(I,1)                                                     MXM 121 
      JJ=INDEX(KK,1)+2                                                  MXM 122 
      MM=JJ+LL-1                                                        MXM 123 
      INDEX(KK,1)=INDEX(KK,1)+LL                                        MXM 124 
      NN=1                                                              MXM 125 
      DO 36 K=JJ,MM                                                     MXM 126 
      NN=NN+1                                                           MXM 127 
36    INDEX(KK,K)=INDEX(I,NN)                                           MXM 128 
      INDEX(I,1)=-INDEX(I,1)                                            MXM 129 
      GO TO 38                                                          MXM 130 
37    CONTINUE                                                          MXM 131 
38    CONTINUE                                                          MXM 132 
      GO TO 10                                                          MXM 133 
39    IF (NCL) 44,40,44                                                 MXM 134 
40    NL=NL+1                                                           MXM 135 
      IF (NL-6) 42,41,42                                                MXM 136 
41    IF (ITEST-NC) 7,42,42                                             MXM 137 
42    IF (NL-14) 43,54,54                                               MXM 138 
43    SIGMAD=SIGMAD+QSD                                                 MXM 139 
      WRITE (JTAPE,66) SIGMAD                                           MXM 140 
      GO TO 10                                                          MXM 141 
44    KK=0                                                              MXM 142 
      LL=1                                                              MXM 143 
      READ (9) ((DIST(I,J),J=1,NR),I=1,NS)                                      
      NN=0                                                              MXM 145 
      DO 53 I=1,NC                                                      MXM 146 
      IF (CORD(I,NRP1)) 45,53,45                                        MXM 147 
45    KK=KK+1                                                           MXM 148 
      WRITE (3) (CORD(I,J),J=1,NRP1)                                            
46    IF (INDEX(LL,1)) 47,47,48                                         MXM 150 
47    LL=LL+1                                                           MXM 151 
      GO TO 46                                                          MXM 152 
48    NSM1=INDEX(LL,1)+1                                                MXM 153 
      IM1=NSM1-1                                                        MXM 154 
      WRITE (JTAPE,67) IM1,KK                                           MXM 155 
      WRITE (JTAPE,68) (INDEX(LL,J),J=2,NSM1)                           MXM 156 
      IF (IM1-4) 52,49,49                                               MXM 157 
49    SUMD=0.                                                           MXM 158 
      SUMDSQ=0.                                                         MXM 159 
      DO 51 K=2,NSM1                                                    MXM 160 
      JJ=INDEX(LL,K)                                                    MXM 161 
      DMEAN=0.                                                          MXM 162 
      DO 50 J=1,NR                                                      MXM 163 
50    DMEAN=DMEAN+DIST(JJ,J)**2                                         MXM 164 
      SUMDSQ=SUMDSQ+DMEAN                                               MXM 165 
      SUMD=SUMD+SQRT(DMEAN)                                             MXM 166 
51    CONTINUE                                                          MXM 167 
      FN=IM1                                                            MXM 168 
      DMEAN=SUMD/FN                                                     MXM 169 
      SUMDSQ=(FN*SUMDSQ-SUMD**2)/(FN*(FN-1.))                           MXM 170 
      WRITE (JTAPE,69) DMEAN,SUMDSQ                                     MXM 171 
      NN=NN+1                                                           MXM 172 
      TTEST(NN)=SUMDSQ*(FN-1.)                                          MXM 173 
      ID(NN)=KK                                                         MXM 174 
      SFN(NN)=FN                                                        MXM 175 
52    LL=LL+1                                                           MXM 176 
53    CONTINUE                                                          MXM 177 
      IF (KK-3) 54,55,55                                                MXM 178 
54    WRITE (JTAPE,70)                                                  MXM 179 
C     INSERT CALL FOR NEXT CORE LOAD.                                   MXM 180 
      CALL PUNT ('-CORR ',0,0)                                          MXM 181 
55    CALL REWIND (3)                                                           
      NC=KK                                                             MXM 183 
      DO 56 I=1,NC                                                      MXM 184 
56    READ (3) (CORD(I,J),J=1,NRP1)                                             
      SUMD=0.                                                           MXM 186 
      SUMDSQ=0.                                                         MXM 187 
      NSM1=NC-1                                                         MXM 188 
      DO 58 I=1,NSM1                                                    MXM 189 
      IM1=I+1                                                           MXM 190 
      DIST(I,I)=0.                                                      MXM 191 
      DO 58 J=IM1,NC                                                    MXM 192 
      DIST(I,J)=0.                                                      MXM 193 
      DO 57 K=1,NR                                                      MXM 194 
57    DIST(I,J)=DIST(I,J)+(CORD(I,K)-CORD(J,K))**2                      MXM 195 
      DIST(I,J)=SQRT(DIST(I,J))                                         MXM 196 
      SUMD=SUMD+DIST(I,J)                                               MXM 197 
      SUMDSQ=SUMDSQ+DIST(I,J)**2                                        MXM 198 
58    DIST(J,I)=DIST(I,J)                                               MXM 199 
      DIST(NC,NC)=0.                                                    MXM 200 
      FN=(NC*NSM1)/2                                                    MXM 201 
      SUMDSQ=SQRT((FN*SUMDSQ-SUMD**2)/FN**2)                            MXM 202 
      SIGMAD=SIGMAD+QSD                                                 MXM 203 
      DO 60 I=1,NS                                                      MXM 204 
      IF (INDEX(I,1)) 59,60,60                                          MXM 205 
59    INDEX(I,1)=0                                                      MXM 206 
60    CONTINUE                                                          MXM 207 
      IF (NN-2) 5,61,61                                                 MXM 208 
61    JJ=NN-1                                                           MXM 209 
      WRITE (JTAPE,71)                                                  MXM 210 
      DO 62 I=1,JJ                                                      MXM 211 
      IM1=I+1                                                           MXM 212 
      LL=ID(I)                                                          MXM 213 
      DO 62 J=IM1,NN                                                    MXM 214 
      MM=ID(J)                                                          MXM 215 
      DF=SFN(I)+SFN(J)-2.                                               MXM 216 
      T=(TTEST(I)+TTEST(J))/DF                                          MXM 217 
      T=DIST(LL,MM)/SQRT(T/SFN(I)+T/SFN(J))                             MXM 218 
62    WRITE (JTAPE,72) ID(I),ID(J),T,DF,DIST(LL,MM)                     MXM 219 
      GO TO 5                                                           MXM 220 
C     *** FORMAT STATEMENTS ***                                         MXM 221 
C                                                                       MXM 222 
63    FORMAT (16H0MEAN DISTANCE =F8.6,25H AND STANDARD DEVIATION =F8.6) MXM 223 
64    FORMAT (72H0LESS THAN 1/4 OF SUBJECTS CAN BE CLASSIFIED WITH A CRIMXM 224 
     1TERION OF 1 SIGMA)                                                MXM 225 
65    FORMAT (31H1MAX-MIN CLUSTER ANALYSIS LEVEL,I3,81X17HCURRENT CRITERMXM 226 
     1ION/1H ,33(1H-))                                                  MXM 227 
66    FORMAT (1H0,118XF8.6)                                             MXM 228 
67    FORMAT (14H0THE FOLLOWING,I3,35H INDIVIDUALS ARE MEMBERS OF CLUSTEMXM 229 
     1R,I3,2H -)                                                        MXM 230 
68    FORMAT (22(I5,1H,))                                               MXM 231 
69    FORMAT (16H MEAN DISTANCE =,F8.6,19H WITH A VARIANCE OF,F8.6)     MXM 232 
70    FORMAT (22H0CLUSTERING COMPLETED.)                                MXM 233 
71    FORMAT (1H1,54X22HT-TESTS AMONG CLUSTERS/1H0)                     MXM 234 
72    FORMAT (3H T(,I2,1H,I2,3H) =,E12.6,10H WITH DF =,F3.0,36H FOR A MEMXM 235 
     1AN INTERCLUSTER DISTANCE OF,F8.6)                                 MXM 236 
      END                                                               MXM 237-
                                                                                
 *** INSERT CORES 3 AND 4 OF MAC I IF FACTORING IS DESIRED ***                  
                                                                                
*** PARAMETER CARDS FOR MAC II ***                                              
1MAC II OF 8 MSA SCALES + PARTY MEMBERSHIP.                                     
   8  88   1       5                                                            
(4X8I2)                                                                         
1CORRELATIONS FROM MAC II SCORING SYSTEM.                                       
1NONMETRIC FACTOR ANALYSIS OF MAC II OF MSA SCALES + PARTY MEMBERSHIP.          
                                                                                
C     MAC3-CORE 1                                                       CD3   1 
C     CODE DATA FOR LARGE N FOR MAC III (LINGOES - 3/15/65).            CD3   2 
C     TO BE USED WITH LAST 2 CORE LOADS OF MAC I IF FACTORING DESIRED,  CD3   3 
C     OR CAN BE USED ALONE IF ONLY THE BEST WEIGHTING SYSTEM IS NEEDED. CD3   4 
C                                                                       CD3   5 
C     DECK SET-UP FOR MAC III -                                         CD3   6 
C        1.   SYSTEM ID CARD/S.                                         CD3   7 
C        2.   BINARY PROGRAM.                                           CD3   8 
C        3.   TITLE CARD 1 - PUNCH A '1' IN COLUMN 1 AND ANY ALPHANUMER-CD3   9 
C             IC HEADING IN COLUMNS 2-72.                               CD3  10 
C        4.   PARAMETER CARD 1, CONTAINING THE FOLLOWING INFORMATION -  CD3  11 
C             A)  COLS. 3-4 = NV .LE. 70, THE NUMBER OF VARIABLES,      CD3  12 
C             B)  COLS. 7-8 = NREC .LE. 10.  THIS PARAMETER INDICATES TOCD3  13 
C                             THE PROGRAM THAT NREC-1 CATEGORY CODES ARECD3  14 
C                             TO BE SET EQUIVALENT TO A FIXED CODE OVER CD3  15 
C                             ALL VARIABLES AND SUBJECTS.  (BOTH THE    CD3  16 
C                             ASSIGNED AND TO-BE-ASSIGNED CODES MUST BE CD3  17 
C                             NUMERIC.)  FOR EXAMPLE, IF THE FOLLOWING  CD3  18 
C                             VALUES , 3,-7,2 (WHICH MAY BE IN ANY ORDERCD3  19 
C                             ) WERE TO BE SET = 8, THEN NREC=4.  IF    CD3  20 
C                             THERE IS NO ASSIGNMENT CODING TO BE DONE  CD3  21 
C                             PRIOR TO INTERVAL CODING (V.I.), THEN     CD3  22 
C                             LEAVE FIELD BLANK OR SET TO ZERO,         CD3  23 
C             C)  COL. 12 =   NCWD=1 IF ANY VARIABLES ARE TO BE RANGE   CD3  24 
C                             CODED, I.E., FOR SPECIFIED CATEGORY WIDTHSCD3  25 
C                             ALL VALUES IN THAT RANGE ARE CONSIDERED   CD3  26 
C                             EQUIVALENT TO THE LOWER BOUND OF THE RANGECD3  27 
C                             FOR A GIVEN VARIABLE.  IF THERE IS NO     CD3  28 
C                             RANGE CODING TO BE DONE PRIOR TO INTERVAL CD3  29 
C                             CODING, LEAVE FIELD BLANK OR SET TO ZERO, CD3  30 
C             D)  COL. 16 =   IFCODE = 1 IF CARD OUTPUT OF RANK CODED   CD3  31 
C                             DATA IS DESIRED, OTHERWISE SET TO ZERO OR CD3  32 
C                             LEAVE BLANK.  OUTPUT FORMAT IS - (I4,34I2/CD3  33 
C                             (36I2)), WHERE COLS. 1-4 OF THE FIRST CARDCD3  34 
C                             CONTAINS THE OBSERVATION'S SEQUENCE NUMBERCD3  35 
C                             (AS INPUT),                               CD3  36 
C             E)  COL. 20 =   IFGL = 1 IF CARD OUTPUT OF BEST CATEGORY  CD3  37 
C                             WEIGHTS ARE DESIRED FOR EACH OBSERVATION. CD3  38 
C                             OUTPUT FORMAT IS - (I4,17F4/(18F4)), WHERECD3  39 
C                             COLS. 1-4 OF FIRST CARD OF AN OBSERVATION CD3  40 
C                             IS THE S'S SEQUENCE NUMBER.  SUBSEQUENT   CD3  41 
C                             FIELDS CONTAIN BEST CATEGORY WEIGHTS.     CD3  42 
C                             IF NO CARD OUTPUT IS DESIRED, SET TO ZERO CD3  43 
C                             OR LEAVE FIELD BLANK FOR THIS ITEM,       CD3  44 
C             F)  COL. 24 =   IFTAB = 1 IF (NV*(NV-1))/2 BIVARIATE FRE- CD3  45 
C                             QUENCY TABLES ARE TO BE PRINTED (APPROX.  CD3  46 
C                             4/PAGE).  NOT ADVISEABLE WHEN NV .G. 30.  CD3  47 
C                             IF THIS OUTPUT NOT NEEDED, SET TO ZERO OR CD3  48 
C                             LEAVE BLANK,                              CD3  49 
C             G)  COLS. 27-28=NFMT = NUMBER OF FORMAT CARDS .LE. 10.    CD3  50 
C        5.   FORMAT CARD, PUNCH '(I1,' IN COLUMNS 1-4 AND DESCRIBE IN  CD3  51 
C             F-NOTATION WHERE THE DATA APPEAR ON DATA CARDS IN COLUMNS CD3  52 
C             5-72,TERMINATING IN A ')'.                                CD3  53 
C        6.   PARAMETER CARD 2 - IN COLUMNS 1-72 INDICATE IN CONSECUTIVECD3  54 
C             FIELDS OF TWO COLUMNS THE NUMBER OF EQUAL INTERVALS (.LE. CD3  55 
C             20) INTO WHICH THE RANGE FOR EACH VARIABLE IS TO BE DIVI- CD3  56 
C             DED.  IF NV .G. 36, USE AS MANY ADDITIONAL CARDS AS NECES-CD3  57 
C             SARY TO SATISFY NV.  THE FIRST FIELD CORRESPONDS TO THE   CD3  58 
C             FIRST VARIABLE, THE 2ND TO THE 2ND, ETC.  FOR ALL VARI-   CD3  59 
C             ABLES WHICH ARE TO BE RANGE CODED (V.I.), SET THE NUMBER  CD3  60 
C             OF CATEGORIES = 20.  SUM OF CATEGORIES .LE. 1000.         CD3  61 
C        7.   PARAMETER CARD 3 - IN COLUMNS 1-72 INDICATE IN CONSECUTIVECD3  62 
C             FIELDS OF 4 COLUMNS THE SMALLEST (FREQ, Q.V., MAY BE EM-  CD3  63 
C             PLOYED TO DETERMINE THIS, IF UNKNOWN) OBSERVED VALUE      CD3  64 
C             (WHICH MAY BE NEGATIVE) FOR EACH VARIABLE IN TURN.  FOR   CD3  65 
C             MORE THAN 18 VARIABLES, USE ADDITIONAL CARDS TO SATISFY   CD3  66 
C             THE NV PARAMETER.                                         CD3  67 
C        8.   PARAMETER CARD 4 - PUNCH 18 (SEE ITEM 7 ABOVE) LARGEST OB-CD3  68 
C             SERVED VALUES FOR EACH VARIABLE IN TURN PER CARD.         CD3  69 
C        9.   PARAMETER CARD 5 - IF NREC .G. 0, PUNCH THE ASSIGNED CODE CD3  70 
C             IN COLUMNS 1-4, AND THE TO-BE-ASSIGNED CODES IN NREC-1    CD3  71 
C             CONSECUTIVE FIELDS OF FOUR COLUMNS.  IF NREC=0 OR BLANK,  CD3  72 
C             DO NOT INCLUDE THIS CARD.                                 CD3  73 
C        10.  PARAMETER CARD 6 - IF NCWD=1, PUNCH THE NUMBER OF RANGES  CD3  74 
C             FOR EACH VARIABLE IN TURN.  IF A GIVEN VARIABLE IS NOT TO CD3  75 
C             BE RANGE CODED, SET THAT RANGE NUMBER = 0 OR LEAVE BLANK. CD3  76 
C             USE AS MANY CARDS AS NECESSARY TO SATISFY NV WHERE 36     CD3  77 
C             RANGE NUMBERS CAN BE PUNCHED ON ONE CARD.  THE NUMBER OF  CD3  78 
C             RANGES FOR ANY VARIABLE MUST BE .LE. 10.  IF NCWD = BLANK CD3  79 
C             OR 0, OMIT THIS SET OF CARDS.                             CD3  80 
C        11.  PARAMETER CARD 7 - IF NCWD=1, FOR EACH VARIABLE HAVING A  CD3  81 
C             RANGE NUMBER .G. 0, PUNCH THE LOWER AND UPPER LIMITS FOR  CD3  82 
C             EACH RANGE IN TURN.  THE RANGES MUST BE ALGEBRAICALLY OR- CD3  83 
C             DERED FROM LOW TO HIGH AND THE LOWER LIMIT MUST BE PUNCHEDCD3  84 
C             BEFORE THE UPPER LIMIT.  AS MANY RANGE PAIRS OF VALUES    CD3  85 
C             MUST BE PUNCHED AS ARE INDICATED ON THE RANGE NUMBER CARD CD3  86 
C             SET ABOVE.  AS MANY AS 9 RANGE PAIRS MAY BE PUNCHED ON ONECD3  87 
C             CARD IN FOUR COLUMN FIELDS.  IF A PARTICULAR VARIABLE HAS CD3  88 
C             10 RANGES THEN A 2ND CARD MUST BE PUNCHED.  VARIABLES     CD3  89 
C             WHOSE RANGE NUMBERS ARE ZERO NEED NOT HAVE (A) CARD/S     CD3  90 
C             PUNCHED.  THESE CARD SETS MUST BE ORDERED IN RESPECT TO   CD3  91 
C             THE NON-ZERO RANGE VALUES.  IF NCWD=BLANK OR 0, OMIT      CD3  92 
C             THESE CARD SETS.                                          CD3  93 
C        12.  DATA CARDS - LEAVE COLUMN 1 BLANK AND PUNCH IN COLUMNS    CD3  94 
C             2-72, RESERVING 73-80 FOR OPTIONAL ID INFORMATION, THE    CD3  95 
C             DATA FOR EACH VARIABLE IN TURN.  EACH SET OF CARDS REPRE- CD3  96 
C             SENTS ONE OBSERVATION.                                    CD3  97 
C        13.  TRAILER CARDS - IF THERE ARE T CARDS PER OBSERVATION, THENCD3  98 
C             T TRAILER CARDS MUST FOLLOW THE DATA SETS, THE FIRST CARD CD3  99 
C             OF WHICH MUST BE PUNCHED WITH A '9' IN COLUMN 1.          CD3 100 
C        14.  TITLE CARD NEXT - PUNCH A '1' IN COLUMN 1 AND ANY BCD TI- CD3 101 
C             TLE DESIRED IN COLUMNS 2-72 WHICH YOU WISH TO HAVE HEAD   CD3 102 
C             THE CORRELATION MATRIX OUTPUT.                            CD3 103 
C        15.  SAME AS ITEM 14 FOR NONMETRIC FACTOR ANALYSIS OUTPUT.     CD3 104 
C        16.  FOR MULTIPLE ANALYSES, REPEAT ITEMS 3-15.                 CD3 105 
C                                                                       CD3 106 
C     *** REFERENCES - LINGOES, J. C.  MULTIVARIATE ANALYSIS OF CONTIN- CD3 107 
C                        GENCIES - AN IBM 7090 PROGRAM FOR ANALYZING    CD3 108 
C                        METRIC/NONMETRIC OR LINEAR/NONLINEAR DATA.     CD3 109 
C                        COMP. RPT., 1963,2,1-24.                       CD3 110 
C                      LINGOES J. C. THE MULTIVARIATE ANALYSIS OF QUALI-CD3 111 
C                        TATIVE DATA. MULT. BEHAV. RES., 1968,          CD3 112 
C                                                                       CD3 113 
C     OBSERVE COMMENT CARDS FOR PROGRAMMING NOTES.                      CD3 114 
C                                                                       CD3 115 
      DIMENSION FMT(180), REC(70), NCAT(70), SM(70), BIG(70), FCAT(70), CD3 116 
     1CODE(70), IRANK(70), PLOT(1000,20), FREQ(70), RECODE(10), NCW(70),CD3 117 
     2 RANGE(70,20)                                                     CD3 118 
      EQUIVALENCE (REC,IRANK,FREQ), (FCAT,CODE)                         CD3 119 
      COMMON PLOT,RANGE                                                 CD3 120 
C                                                                       CD3 122 
C     TAPE ASSIGNMENTS -                                                CD3 123 
      ITAPE=5                                                           CD3 124 
      JTAPE=6                                                           CD3 125 
      CALL REWIND (3)                                                   CD3 126 
      CALL REWIND (4)                                                   CD3 127 
      CALL REWIND (9)                                                   CD3 128 
      READ (ITAPE,36)                                                   CD3 129 
      WRITE (JTAPE,36)                                                  CD3 130 
      READ (ITAPE,37) NV,NREC,NCWD,IFCODE,IFGL,IFTAB,NFMT               CD3 131 
      NFMT=NFMT*18                                                      CD3 132 
      READ (ITAPE,38) (FMT(J),J=1,NFMT)                                 CD3 133 
      READ (ITAPE,39) (NCAT(J),J=1,NV)                                  CD3 134 
      READ (ITAPE,40) (SM(J),J=1,NV)                                    CD3 135 
      READ (ITAPE,40) (BIG(J),J=1,NV)                                   CD3 136 
      IF (NREC) 2,2,1                                                   CD3 137 
1     READ (ITAPE,40) (RECODE(J),J=1,NREC)                              CD3 138 
2     DO 3 J=1,NV                                                       CD3 139 
3     FCAT(J)=NCAT(J)                                                   CD3 140 
      IF (NCWD) 8,8,4                                                   CD3 141 
4     READ (ITAPE,39) (NCW(J),J=1,NV)                                   CD3 142 
      DO 5 J=1,NV                                                       CD3 143 
5     NCW(J)=2*NCW(J)                                                   CD3 144 
      DO 7 I=1,NV                                                       CD3 145 
      IF (NCW(I)) 7,7,6                                                 CD3 146 
6     II=NCW(I)                                                         CD3 147 
      READ (ITAPE,40) (RANGE(I,J),J=1,II)                               CD3 148 
7     CONTINUE                                                          CD3 149 
8     DO 9 J=1,NV                                                       CD3 150 
9     CODE(J)=(BIG(J)-SM(J)+1.)/FCAT(J)                                 CD3 151 
      NS=0                                                              CD3 152 
10    READ (ITAPE,FMT) ITYPE,(REC(J),J=1,NV)                            CD3 153 
      IF (ITYPE-9) 11,26,11                                             CD3 154 
11    NS=NS+1                                                           CD3 155 
      DO 24 J=1,NV                                                      CD3 156 
      IF (NREC) 15,15,12                                                CD3 157 
12    DO 14 M=2,NREC                                                    CD3 158 
      IF (REC(J)-RECODE(M)) 14,13,14                                    CD3 159 
13    REC(J)=RECODE(1)                                                  CD3 160 
14    CONTINUE                                                          CD3 161 
15    IF (NCWD) 21,21,16                                                CD3 162 
16    IF (NCW(J)) 21,21,17                                              CD3 163 
17    II=NCW(J)                                                         CD3 164 
      DO 20 N=1,II,2                                                    CD3 165 
      IF (REC(J)-RANGE(J,N)) 21,18,19                                   CD3 166 
18    REC(J)=RANGE(J,N)                                                 CD3 167 
      GO TO 21                                                          CD3 168 
19    IF (REC(J)-RANGE(J,N+1)) 18,18,20                                 CD3 169 
20    CONTINUE                                                          CD3 170 
21    REC(J)=REC(J)-SM(J)                                               CD3 171 
      DO 23 K=1,20                                                      CD3 172 
      REC(J)=REC(J)-CODE(J)                                             CD3 173 
      IF (REC(J)) 22,23,23                                              CD3 174 
22    IRANK(J)=K                                                        CD3 175 
      GO TO 24                                                          CD3 176 
23    CONTINUE                                                          CD3 177 
24    CONTINUE                                                          CD3 178 
      WRITE (9) (IRANK(J),J=1,NV)                                       CD3 179 
      IF (IFCODE) 25,10,25                                              CD3 180 
25    PUNCH 41, NS,(IRANK(J),J=1,NV)                                    CD3 181 
      GO TO 10                                                          CD3 182 
26    CALL REWIND (9)                                                   CD3 183 
      NVM1=NV-1                                                         CD3 184 
      FNS=NS                                                            CD3 185 
      WRITE (JTAPE,42)                                                  CD3 186 
      WRITE (JTAPE,43) (KK,KK=1,20)                                     CD3 187 
      WRITE (4) NV,NVM1,NS,FNS,IFGL,(NCAT(J),J=1,NV)                    CD3 188 
      NRO=0                                                             CD3 189 
      DO 27 J=1,NV                                                      CD3 190 
27    NRO=NRO+NCAT(J)                                                   CD3 191 
      DO 34 I=1,NVM1                                                    CD3 192 
      IP1=I+1                                                           CD3 193 
      NC=NCAT(I)                                                        CD3 194 
      NRO=NRO-NC                                                        CD3 195 
      DO 28 K=1,NRO                                                     CD3 196 
      DO 28 L=1,NC                                                      CD3 197 
28    PLOT(K,L)=0.                                                      CD3 198 
      DO 29 M=1,NS                                                      CD3 199 
      READ (9) (IRANK(N),N=1,NV)                                        CD3 200 
      NR=-NCAT(I)                                                       CD3 201 
      DO 29 J=IP1,NV                                                    CD3 202 
      NR=NR+NCAT(J-1)                                                   CD3 203 
      INDEXJ=IRANK(I)                                                   CD3 204 
      INDEXI=IRANK(J)+NR                                                CD3 205 
29    PLOT(INDEXI,INDEXJ)=PLOT(INDEXI,INDEXJ)+1.                        CD3 206 
      CALL REWIND (9)                                                   CD3 207 
      NR=NCAT(IP1)                                                      CD3 208 
      DO 30 JJ=1,NC                                                     CD3 209 
      FREQ(JJ)=0.                                                       CD3 210 
      DO 30 II=1,NR                                                     CD3 211 
30    FREQ(JJ)=FREQ(JJ)+PLOT(II,JJ)                                     CD3 212 
      WRITE (JTAPE,46) I,(FREQ(KK),KK=1,NC)                             CD3 213 
      NN=0                                                              CD3 214 
      DO 33 LL=IP1,NV                                                   CD3 215 
      NN=NN+NCAT(LL)                                                    CD3 216 
      MM=NN-NCAT(LL)+1                                                  CD3 217 
      IF (IFTAB) 31,33,31                                               CD3 218 
31    WRITE (JTAPE,44) I,LL,(KK,KK=1,NC)                                CD3 219 
      WRITE (JTAPE,45)                                                  CD3 220 
      KK=0                                                              CD3 221 
      DO 32 III=MM,NN                                                   CD3 222 
      KK=KK+1                                                           CD3 223 
32    WRITE (JTAPE,47) KK,(PLOT(III,JJJ),JJJ=1,NC)                      CD3 224 
33    WRITE (4) ((PLOT(III,JJJ),JJJ=1,NC),III=MM,NN)                    CD3 225 
34    CONTINUE                                                          CD3 226 
      DO 35 II=1,NR                                                     CD3 227 
      FREQ(II)=0.                                                       CD3 228 
      DO 35 JJ=1,NC                                                     CD3 229 
35    FREQ(II)=FREQ(II)+PLOT(II,JJ)                                     CD3 230 
      WRITE (JTAPE,46) NV,(FREQ(KK),KK=1,NR)                            CD3 231 
C     *** INSERT CALL FOR MULTIPLE CORE LOADING HERE.                   CD3 232 
      CALL PUNT ('-CORE2 ',0,0)                                         CD3 233 
C     *** FORMAT STATEMENTS ***                                         CD3 234 
C                                                                       CD3 235 
36    FORMAT (72H                                                       CD3 236 
     1                 )                                                CD3 237 
37    FORMAT (7I4)                                                      CD3 238 
38    FORMAT (18A4)                                                     CD3 239 
39    FORMAT (36I2)                                                     CD3 240 
40    FORMAT (18F4.0)                                                   CD3 241 
41    FORMAT (I4,34I2/(36I2))                                           CD3 242 
42    FORMAT (1H0,43X44HFREQUENCY DISTRIBUTION FOR RANKED CODED DATA)   CD3 243 
43    FORMAT (6H0 VAR.,20I6/1H ,131(1H-))                               CD3 244 
44    FORMAT (8H0TABLE (,I2,1H,,I2,1H)/1H0,4X20I5)                      CD3 245 
45    FORMAT (1H )                                                      CD3 246 
46    FORMAT (1H0,I5,20F6.0)                                            CD3 247 
47    FORMAT (I3,2X20F5.0)                                              CD3 248 
      END                                                               CD3 249-
C     MAC3-CORE 2                                                       SL3   1 
C     GUTTMAN-LINGOES MAXIMIZATION OF AVERAGE ETA**2  9/15/64 - J.C.L.  SL3   2 
C                                                                       SL3   3 
      DIMENSION A(20,20), NCAT(70), SQRTCR(1000), B(1000,20), C(400), V(SL3   4 
     120,20), ETA(20), ISCORE(70), SCORE(400)                           SL3   5 
      COMMON A,SQRTCR,B,V                                               SL3   6 
      EQUIVALENCE (A,C), (NCAT,ISCORE), (V,SCORE)                       SL3   7 
C                                                                       SL3   9 
C     TAPE ASSIGNMENTS -                                                SL3  10 
      JTAPE=6                                                           SL3  11 
      CALL REWIND (4)                                                   SL3  12 
      CALL REWIND (9)                                                   SL3  13 
      READ (4) NV,NVM1,NS,FNS,IFGL,(NCAT(J),J=1,NV)                     SL3  14 
      MIN=22                                                            SL3  15 
      NCT=0                                                             SL3  16 
      DO 2 J=1,NV                                                       SL3  17 
      IF (NCAT(J)-MIN) 1,2,2                                            SL3  18 
1     MIN=NCAT(J)                                                       SL3  19 
2     NCT=NCT+NCAT(J)                                                   SL3  20 
      IF (1000-NCT) 3,4,4                                               SL3  21 
C     INSERT CALL TO RETURN TO SYSTEM OR EXIT, TOO MANY CATEGORIES.     SL3  22 
3     CALL SYSTEM                                                       SL3  23 
4     DO 5 I=1,NCT                                                      SL3  24 
      DO 5 J=1,20                                                       SL3  25 
5     B(I,J)=0.                                                         SL3  26 
      KK=NV                                                             SL3  27 
      NN=0                                                              SL3  28 
      JEND=0                                                            SL3  29 
      FNV=NV                                                            SL3  30 
      FNVM1=NVM1                                                        SL3  31 
      DO 21 II=1,NVM1                                                   SL3  32 
      KK=KK-1                                                           SL3  33 
      NC=NCAT(II)                                                       SL3  34 
      MM=II                                                             SL3  35 
      JBEG=JEND                                                         SL3  36 
      JEND=JEND+NCAT(II)                                                SL3  37 
      IEND=JEND                                                         SL3  38 
      DO 21 JJ=1,KK                                                     SL3  39 
      MM=MM+1                                                           SL3  40 
      NR=NCAT(MM)                                                       SL3  41 
      IBEG=IEND                                                         SL3  42 
      IEND=IEND+NCAT(MM)                                                SL3  43 
      READ (4) ((A(I,J),J=1,NC),I=1,NR)                                 SL3  44 
      IF (II-2) 6,13,13                                                 SL3  45 
6     IF (JJ-2) 7,10,10                                                 SL3  46 
7     DO 9 L=1,NC                                                       SL3  47 
      NN=NN+1                                                           SL3  48 
      SQRTCR(NN)=0.                                                     SL3  49 
      DO 8 K=1,NR                                                       SL3  50 
8     SQRTCR(NN)=SQRTCR(NN)+A(K,L)                                      SL3  51 
9     SQRTCR(NN)=SQRT(SQRTCR(NN))                                       SL3  52 
10    DO 12 I=1,NR                                                      SL3  53 
      NN=NN+1                                                           SL3  54 
      SQRTCR(NN)=0.                                                     SL3  55 
      DO 11 J=1,NC                                                      SL3  56 
11    SQRTCR(NN)=SQRTCR(NN)+A(I,J)                                      SL3  57 
12    SQRTCR(NN)=SQRT(SQRTCR(NN))                                       SL3  58 
13    L=JBEG                                                            SL3  59 
      DO 14 J=1,NC                                                      SL3  60 
      L=L+1                                                             SL3  61 
      K=IBEG                                                            SL3  62 
      DO 14 I=1,NR                                                      SL3  63 
      K=K+1                                                             SL3  64 
      FF=SQRTCR(K)*SQRTCR(L)                                            SL3  65 
14    A(I,J)=A(I,J)/FF                                                  SL3  66 
      L=JBEG                                                            SL3  67 
      IR=L                                                              SL3  68 
      DO 17 I=1,NC                                                      SL3  69 
      L=L+1                                                             SL3  70 
      DO 17 J=I,NC                                                      SL3  71 
      DO 15 K=1,NR                                                      SL3  72 
15    B(L,J)=B(L,J)+A(K,I)*A(K,J)                                       SL3  73 
      IF (J-I) 17,17,16                                                 SL3  74 
16    NROW=IR+J                                                         SL3  75 
      B(NROW,I)=B(L,J)                                                  SL3  76 
17    CONTINUE                                                          SL3  77 
      L=IBEG                                                            SL3  78 
      IR=L                                                              SL3  79 
      DO 20 I=1,NR                                                      SL3  80 
      L=L+1                                                             SL3  81 
      DO 20 J=I,NR                                                      SL3  82 
      DO 18 K=1,NC                                                      SL3  83 
18    B(L,J)=B(L,J)+A(I,K)*A(J,K)                                       SL3  84 
      IF (J-I) 20,20,19                                                 SL3  85 
19    NROW=IR+J                                                         SL3  86 
      B(NROW,I)=B(L,J)                                                  SL3  87 
20    CONTINUE                                                          SL3  88 
21    CONTINUE                                                          SL3  89 
      CALL REWIND (4)                                                   SL3  90 
      IEND=0                                                            SL3  91 
      WRITE (JTAPE,29)                                                  SL3  92 
      DO 25 II=1,NV                                                     SL3  93 
      N=NCAT(II)                                                        SL3  94 
      IBEG=IEND+1                                                       SL3  95 
      IEND=IEND+N                                                       SL3  96 
      NN=0                                                              SL3  97 
      DO 22 I=IBEG,IEND                                                 SL3  98 
      NN=NN+1                                                           SL3  99 
      DO 22 J=1,N                                                       SL3 100 
22    A(NN,J)=B(I,J)/FNVM1                                              SL3 101 
C     CALL ON HOUSEHOLDER SUBROUTINE                                    SL3 102 
      CALL EIGEN (A,V,N,ETA,MIN)                                        SL3 103 
      KK=IBEG-1                                                         SL3 104 
      DO 23 J=1,MIN                                                     SL3 105 
      JJ=KK                                                             SL3 106 
      DO 23 I=1,N                                                       SL3 107 
      JJ=JJ+1                                                           SL3 108 
23    V(I,J)=V(I,J)/SQRTCR(JJ)                                          SL3 109 
      WRITE (JTAPE,30) II,(JJ,JJ=1,N)                                   SL3 110 
      WRITE (JTAPE,31)                                                  SL3 111 
      DO 24 I=1,MIN                                                     SL3 112 
24    WRITE (JTAPE,32) I,ETA(I),(V(J,I),J=1,N)                          SL3 113 
      DO 25 J=1,N                                                       SL3 114 
25    B(II,J)=V(J,2)                                                    SL3 115 
      WRITE (4) NV,NS                                                   SL3 116 
      DO 28 I=1,NS                                                      SL3 117 
      READ (9) (ISCORE(J),J=1,NV)                                       SL3 118 
      DO 26 L=1,NV                                                      SL3 119 
      KK=ISCORE(L)                                                      SL3 120 
26    SCORE(L)=B(L,KK)                                                  SL3 121 
      IF (IFGL) 27,28,27                                                SL3 122 
27    PUNCH 33, I,(SCORE(M),M=1,NV)                                     SL3 123 
28    WRITE (4) (SCORE(M),M=1,NV)                                       SL3 124 
C     INSERT CALL FOR NEXT CORE LOAD.                                   SL3 125 
      CALL PUNT ('-CORE3 ',0,0)                                         SL3 126 
C     *** FORMAT STATEMENTS ***                                         SL3 127 
C                                                                       SL3 128 
29    FORMAT (39H1MULTIVARIATE ANALYSIS OF CONTINGENCIES)               SL3 129 
30    FORMAT (1H0,40X45HGUTTMAN-LINGOES CATEGORY WEIGHTS FOR VARIABLE,I3SL3 130 
     1/1H0,16X15HC A T E G O R Y/6X6HETA**2,20I6)                       SL3 131 
31    FORMAT (1H ,131(1H-)/7H0VECTOR)                                   SL3 132 
32    FORMAT (I5,1XF6.3,3P20F6.0)                                       SL3 133 
33    FORMAT (I4,17F4.0/(18F4.0))                                       SL3 134 
      END                                                               SL3 135-
                                                                                
 *** INSERT SUBROUTINE EIGEN (EG1), PROPERLY DIMENSIONED. SEE FOLLOWING         
 CARDS                                                                          
      DIMENSION A(20,20),B(20,20),VALU(20),T(20,3),DIAG(20),SUPERD(20),         
     .WVEC(20),PVEC(20),QVEC(20),VALL(20),Q(20),U(20),INDEX(20),FACTOR          
     .(20),V(20)                                                                
                                                                                
 --- INSERT CORES 3 AND 4 OF MAC I ---                                          
                                                                                
 *** PARAMETER CARDS FOR MAC III ANALYSIS OF MSA DATA ***                       
1MAC III OF 8 MSA SCALES + PARTY MEMBERSHIP.                                    
   9                   1   1                                                    
(I1,3X9F2.0)                                                                    
 8181311 9 8 9 8 4                                                              
   1   1   1   1   1   1   1   1   1                                            
   8  18  13  11   9   8   9   8   4                                            
9                                                                               
1CORRELATIONS FROM MAC III SCALING.                                             
1FACTORS FROM MAC III.                                                          
                                                                                
C     FACT                                                              FAC   1 
C     PROGRAM TO SCORE FOR NONMETRIC FACTOR ANALYSIS - CORES 3 AND 4 OF FAC   2 
C     MAC-I.                                                            FAC   3 
C                                                                       FAC   4 
      DIMENSION NCAT(48), MATR(500,48), GUT(48,20), SCORE(48)           FAC   5 
      COMMON MATR,GUT                                                   FAC   6 
      DEFINE FILE 14(3000,255,L,KT)                                     FAC   7 
C                                                                       FAC   8 
C     TAPE ASSIGNMENTS -                                                FAC   9 
      ITAPE=5                                                           FAC  10 
      JTAPE=6                                                           FAC  11 
      KT=1                                                              FAC  12 
      READ (ITAPE,5) NS,NV,NF                                           FAC  13 
      READ (ITAPE,6) (NCAT(I),I=1,NV)                                   FAC  14 
      DO 1 I=1,NS                                                       FAC  15 
1     READ (ITAPE,7) (MATR(I,J),J=1,NV)                                 FAC  16 
      DO 4 N=1,NF                                                       FAC  17 
      DO 2 I=1,NV                                                       FAC  18 
      LL=NCAT(I)                                                        FAC  19 
2     READ (ITAPE,8) (GUT(I,J),J=1,LL)                                  FAC  20 
      WRITE (14'KT) NV,NS                                               FAC  21 
      DO 4 I=1,NS                                                       FAC  22 
      DO 3 J=1,NV                                                       FAC  23 
      LL=MATR(I,J)                                                      FAC  24 
3     SCORE(J)=GUT(J,LL)                                                FAC  25 
4     WRITE (14'KT) (SCORE(K),K=1,NV)                                   FAC  26 
C     INSERT CALL FOR SUBROUTINE TO HANDLE MULTIPLE CORE JOBS.          FAC  27 
      CALL PUNT ('-CORE3 ',0,0)                                         FAC  28 
C     *** FORMAT STATEMENTS ***                                         FAC  29 
C                                                                       FAC  30 
5     FORMAT (3I4)                                                      FAC  31 
6     FORMAT (36I2)                                                     FAC  32 
7     FORMAT (4X34I2/(36I2))                                            FAC  33 
8     FORMAT (18F4.0)                                                   FAC  34 
      END                                                               FAC  35-
C     FREQ                                                              FRQ   1 
C     PROGRAM TO COMPUTE FREQUENCY DISTRIBUTIONS FOR MAC I AND II.      FRQ   2 
C     CAN BE REDIMENSIONED FOR I=NV AND J=NS.                           FRQ   3 
C                                                                       FRQ   4 
      DIMENSION R(21,1000), MATR(21,1000), MP(21), FMT(18)              FRQ   5 
      EQUIVALENCE (R,MATR)                                              FRQ   6 
      COMMON R                                                          FRQ   7 
C                                                                       FRQ   8 
C     TAPE ASSIGNMENTS -                                                FRQ   9 
      ITAPE=5                                                           FRQ  10 
      JTAPE=6                                                           FRQ  11 
1     READ (ITAPE,62)                                                   FRQ  12 
      WRITE (JTAPE,62)                                                  FRQ  13 
      READ (ITAPE,63) NV,NS,IFCODE,MAX,NCAT,IFCDS,CODE                  FRQ  14 
      READ (ITAPE,64) (FMT(I),I=1,18)                                   FRQ  15 
      DO 2 I=1,NS                                                       FRQ  16 
2     READ (ITAPE,FMT) (R(I,J),J=1,NV)                                  FRQ  17 
      FNS=NS                                                            FRQ  18 
      NSP1=NS+1                                                         FRQ  19 
      IFCODE=IFCODE+1                                                   FRQ  20 
      GO TO (3,21), IFCODE                                              FRQ  21 
C     CHECK FOR MISSING DATA AND SUBSTITUTE MEANS IF THEY EXIST         FRQ  22 
3     IF (CODE) 4,12,4                                                  FRQ  23 
4     DO 11 J=1,NV                                                      FRQ  24 
      COUNT=0.                                                          FRQ  25 
      SUM=0.                                                            FRQ  26 
      DO 7 I=1,NS                                                       FRQ  27 
      IF (R(I,J)-CODE) 6,5,6                                            FRQ  28 
5     COUNT=COUNT+1.                                                    FRQ  29 
      GO TO 7                                                           FRQ  30 
6     SUM=SUM+R(I,J)                                                    FRQ  31 
7     CONTINUE                                                          FRQ  32 
      IF (COUNT) 8,11,8                                                 FRQ  33 
8     SUM=SUM/(FNS-COUNT)                                               FRQ  34 
      DO 10 I=1,NS                                                      FRQ  35 
      IF (R(I,J)-CODE) 10,9,10                                          FRQ  36 
9     R(I,J)=SUM                                                        FRQ  37 
10    CONTINUE                                                          FRQ  38 
11    CONTINUE                                                          FRQ  39 
C     COMPUTE CODED SCORES FOR EACH VARIABLE                            FRQ  40 
12    WRITE (JTAPE,65)                                                  FRQ  41 
      PGRPS=MAX                                                         FRQ  42 
      DO 20 J=1,NV                                                      FRQ  43 
      BIG=0.                                                            FRQ  44 
      SMALL=10000.                                                      FRQ  45 
      DO 16 I=1,NS                                                      FRQ  46 
      IF (BIG-R(I,J)) 13,14,14                                          FRQ  47 
13    BIG=R(I,J)                                                        FRQ  48 
14    IF (R(I,J)-SMALL) 15,16,16                                        FRQ  49 
15    SMALL=R(I,J)                                                      FRQ  50 
16    CONTINUE                                                          FRQ  51 
      CODE=(BIG-SMALL+1.)/PGRPS                                         FRQ  52 
      WRITE (JTAPE,66) J,SMALL,BIG,CODE                                 FRQ  53 
      DO 19 I=1,NS                                                      FRQ  54 
      R(I,J)=R(I,J)-SMALL                                               FRQ  55 
      DO 18 K=1,21                                                      FRQ  56 
      R(I,J)=R(I,J)-CODE                                                FRQ  57 
      IF (R(I,J)) 17,18,18                                              FRQ  58 
17    MATR(I,J)=K                                                       FRQ  59 
      GO TO 19                                                          FRQ  60 
18    CONTINUE                                                          FRQ  61 
      MATR(I,J)=21                                                      FRQ  62 
19    CONTINUE                                                          FRQ  63 
20    CONTINUE                                                          FRQ  64 
C     SET FREQUENCIES FOR EACH CATEGORY ACCORDING TO PARAMETER          FRQ  65 
21    IF (NCAT) 51,51,22                                                FRQ  66 
22    DO 50 J=1,NV                                                      FRQ  67 
      DO 23 K=1,21                                                      FRQ  68 
23    MP(K)=0                                                           FRQ  69 
      DO 24 I=1,NS                                                      FRQ  70 
      KK=MATR(I,J)                                                      FRQ  71 
24    MP(KK)=1                                                          FRQ  72 
      KK=0                                                              FRQ  73 
      DO 26 L=1,21                                                      FRQ  74 
      IF (MP(L)) 26,26,25                                               FRQ  75 
25    KK=KK+1                                                           FRQ  76 
      MP(L)=KK                                                          FRQ  77 
26    CONTINUE                                                          FRQ  78 
      LL=KK-1                                                           FRQ  79 
      DO 27 M=1,NS                                                      FRQ  80 
      INDEXI=MATR(M,J)                                                  FRQ  81 
27    MATR(M,J)=MP(INDEXI)                                              FRQ  82 
      DO 28 K=1,21                                                      FRQ  83 
28    MP(K)=0                                                           FRQ  84 
      DO 29 I=1,NS                                                      FRQ  85 
      INDEXI=MATR(I,J)                                                  FRQ  86 
29    MP(INDEXI)=MP(INDEXI)+1                                           FRQ  87 
      DO 39 K=2,LL                                                      FRQ  88 
      KM1=K                                                             FRQ  89 
      IF (MP(K)-NCAT) 30,39,39                                          FRQ  90 
30    KM1=KM1-1                                                         FRQ  91 
      IF (MP(KM1)) 31,30,31                                             FRQ  92 
31    KP1=K+1                                                           FRQ  93 
      IF (MP(KM1)-MP(KP1)) 32,35,35                                     FRQ  94 
32    MP(KM1)=MP(KM1)+MP(K)                                             FRQ  95 
      DO 34 I=1,NS                                                      FRQ  96 
      IF (MATR(I,J)-K) 34,33,34                                         FRQ  97 
33    MATR(I,J)=KM1                                                     FRQ  98 
34    CONTINUE                                                          FRQ  99 
      GO TO 38                                                          FRQ 100 
35    MP(KP1)=MP(KP1)+MP(K)                                             FRQ 101 
      DO 37 I=1,NS                                                      FRQ 102 
      IF (MATR(I,J)-K) 37,36,37                                         FRQ 103 
36    MATR(I,J)=KP1                                                     FRQ 104 
37    CONTINUE                                                          FRQ 105 
38    MP(K)=0                                                           FRQ 106 
39    CONTINUE                                                          FRQ 107 
      IF (MP(1)-NCAT) 40,45,45                                          FRQ 108 
40    K=1                                                               FRQ 109 
41    K=K+1                                                             FRQ 110 
      IF (MP(K)) 42,41,42                                               FRQ 111 
42    DO 44 I=1,NS                                                      FRQ 112 
      IF (MATR(I,J)-1) 44,43,44                                         FRQ 113 
43    MATR(I,J)=K                                                       FRQ 114 
44    CONTINUE                                                          FRQ 115 
45    LL=LL+1                                                           FRQ 116 
      IF (MP(LL)-NCAT) 46,50,50                                         FRQ 117 
46    LL=LL-1                                                           FRQ 118 
      IF (MP(LL)) 47,46,47                                              FRQ 119 
47    DO 49 I=1,NS                                                      FRQ 120 
      IF (MATR(I,J)-KK) 49,48,49                                        FRQ 121 
48    MATR(I,J)=LL                                                      FRQ 122 
49    CONTINUE                                                          FRQ 123 
50    CONTINUE                                                          FRQ 124 
C     REPLACE CODED SCORES WITH COMPACT RANKS                           FRQ 125 
51    DO 56 J=1,NV                                                      FRQ 126 
      DO 52 K=1,21                                                      FRQ 127 
52    MP(K)=0                                                           FRQ 128 
      DO 53 I=1,NS                                                      FRQ 129 
      KK=MATR(I,J)                                                      FRQ 130 
53    MP(KK)=1                                                          FRQ 131 
      KK=0                                                              FRQ 132 
      DO 55 L=1,21                                                      FRQ 133 
      IF (MP(L)) 55,55,54                                               FRQ 134 
54    KK=KK+1                                                           FRQ 135 
      MP(L)=KK                                                          FRQ 136 
55    CONTINUE                                                          FRQ 137 
      MATR(NSP1,J)=KK                                                   FRQ 138 
      DO 56 M=1,NS                                                      FRQ 139 
      KK=MATR(M,J)                                                      FRQ 140 
56    MATR(M,J)=MP(KK)                                                  FRQ 141 
      NVM1=NV-1                                                         FRQ 142 
      WRITE (JTAPE,67)                                                  FRQ 143 
      WRITE (JTAPE,68) (KK,KK=1,21)                                     FRQ 144 
      DO 59 I=1,NV                                                      FRQ 145 
      LL=MATR(NSP1,I)                                                   FRQ 146 
      DO 57 J=1,LL                                                      FRQ 147 
57    MP(J)=0                                                           FRQ 148 
      DO 58 K=1,NS                                                      FRQ 149 
      INDEXI=MATR(K,I)                                                  FRQ 150 
58    MP(INDEXI)=MP(INDEXI)+1                                           FRQ 151 
59    WRITE (JTAPE,69) I,(MP(L),L=1,LL)                                 FRQ 152 
      IF (IFCDS) 1,1,60                                                 FRQ 153 
60    DO 61 I=1,NS                                                      FRQ 154 
61    PUNCH 70, I,(MATR(I,K),K=1,NV)                                    FRQ 155 
      GO TO 1                                                           FRQ 156 
C     *** FORMAT STATEMENTS ***                                         FRQ 157 
C                                                                       FRQ 158 
62    FORMAT (72H                                                       FRQ 159 
     1                 )                                                FRQ 160 
63    FORMAT (6I4,F8.4)                                                 FRQ 161 
64    FORMAT (18A4)                                                     FRQ 162 
65    FORMAT (10H0 VARIABLE,10X13HSCORE   RANGE,10X14HCODED INTERVAL/1H FRQ 163 
     1,57(1H-)/1H )                                                     FRQ 164 
66    FORMAT (I7,E17.6,4H TO ,E12.6,E16.6)                              FRQ 165 
67    FORMAT (1H1,43X44HFREQUENCY DISTRIBUTION FOR RANKED CODED DATA)   FRQ 166 
68    FORMAT (6H0 VAR.,21I6/1H ,131(1H-)/1H )                           FRQ 167 
69    FORMAT (22I6)                                                     FRQ 168 
70    FORMAT (I4,34I2/(36I2))                                           FRQ 169 
      END                                                               FRQ 170-
