C     MSA1-CORE 1                                                       COD   1 
C     LINGOES MULTIVARIATE ANALYSIS OF CONTINGENCIES - CORE 1 (3/15/63).COD   2 
C                                                                       COD   3 
C     DECK SET-UP FOR G-L(MSA-I) -                                      COD   4 
C                                                                       COD   5 
C        1.  SYSTEM ID CARD/S.                                          COD   6 
C        2.  BINARY PROGRAM.                                            COD   7 
C        3.  TITLE CARD  (PUNCH A 1 IN COLUMN 1 AND ANY BCD TITLE IN COLCOD   8 
C            -UMNS 2 TO 72, WHICH WILL BE PRINTED OUT FOR EACH PAGE OF  COD   9 
C            OUTPUT).                                                   COD  10 
C        4.  CONTROL CARD 1, 7 4-COLUMN FIELDS AND 1 8-COLUMN FIELD CON COD  11 
C            -TAINING THE FOLLOWING INFORMATION SERIATUM -              COD  12 
C            A)  NV=NUMBER OF VARIABLES OR ITEMS .LE. 50,               COD  13 
C            B)  NS=NUMBER OF SUBJECTS .LE. 100 OR TYPES .LE. 80,       COD  14 
C            C)  IFCODE=1, IF DATA HAS BEEN PRECODED, I.E., ALL VALUES  COD  15 
C                MUST BE INTEGERS IN THE RANGE 1-20, OTHERWISE LEAVE    COD  16 
C                BLANK OR SET TO 0,                                     COD  17 
C            D)  MAX=THE NUMBER OF EQUAL INTERVALS INTO WHICH THE DATA  COD  18 
C                IS TO BE CODED, ASSUMING THAT COLUMN 12 HAS BEEN LEFT  COD  19 
C                BLANK.  IF THE DATA IS PRECODED LEAVE THESE COLUMNS    COD  20 
C                BLANK OR SET TO 0.  MAX .LE. 20 BUT .G. 1,             COD  21 
C            E)  NCAT=THE SMALLEST FREQUENCY .G. 1 TO BE PERMITTED IN   COD  22 
C                ANY CATEGORY AFTER CODING.  IF NO LOWER LIMITS ARE DE- COD  23 
C                SIRED SET TO 0 OR LEAVE BLANK,                         COD  24 
C            F)  IFCDS=1, IF CARD OUTPUT OF THE CODED DATA IS DESIRED,  COD  25 
C                OTHERWISE SET TO ZERO OR LEAVE BLANK,                  COD  26 
C            G)  IFT=NUMBER OF TYPES IF NON-REDUNDANT PROFILES ARE TO BECOD  27 
C                INPUT .LE. 80, OTHERWISE SET TO ZERO OR LEAVE BLANK IF COD  28 
C                PROGRAM IS TO DETERMINE REDUNDANCIES AMONG THE NS SUB- COD  29 
C                JECTS.  IF IFT .G. 0 THEN SET NS=IFT,                  COD  30 
C            H)  CODE=A NUMERIC VALUE WHICH IS CONSTANT FOR ALL VARIA-  COD  31 
C                BLES HAVING MISSING INFORMATION FOR WHICH IT IS REASON-COD  32 
C                ABLE TO SUBSTITUTE A MEAN.  DO NOT USE A VALUE WHICH   COD  33 
C                REPRESENTS A LEGITIMATE SCORE FOR ANY VARIABLE.  WHEN  COD  34 
C                THERE IS NO MISSING DATA OR WHEN THE DATA HAS BEEN PRE-COD  35 
C                CODED, LEAVE THESE COLUMNS BLANK OR SET TO 0.  A DECI- COD  36 
C                MAL POINT MUST BE PUNCHED AND THE FIELD WIDTHS FOR THE COD  37 
C                DATA MUST BE ABLE TO ACCOMODATE THE VALUE FOR CODE.    COD  38 
C        5.  IF IFT .G. 0, PUNCH THE FREQUENCY (.G. 0) FOR EACH OF THE  COD  39 
C            IFT TYPES IN 2 COLUMN FIELDS (1 TO 72).  IF THERE ARE MORE COD  40 
C            THAN 36 TYPES, CONTINUE ONTO A SECOND CARD.                COD  41 
C        6.  FORMAT CARD  (DESCRIBING IN F-NOTATION FOR UNCODED DATA ANDCOD  42 
C            IN I-NOTATION FOR PRECODED DATA WHERE THE DATA APPEARS).   COD  43 
C        7.  DATA  (PUNCH IN COLUMNS 1-72, RESERVING 73-80 FOR IDENTIFI-COD  44 
C            CATION (IF DESIRED),  ALL MEASUREMENTS FOR ONE OBSERVATION,COD  45 
C            CONTINUING ONTO AS MANY CARDS AS NECESSARY,  WITHOUT SPLIT-COD  46 
C            TING A FIELD FOR A VARIABLE OVER 2 CARDS.  EACH OBSERVATIONCOD  47 
C            BEGINS ON A NEW CARD.  SINCE THE CODING PROCEDURE IS LINEARCOD  48 
C            ONE SHOULD AVOID HAVING OBSERVATIONS REPRESENTING EXTREME  COD  49 
C            DEVIATIONS FROM THE MAJORITY,  OTHERWISE IN THE LIMIT ONE  COD  50 
C            WILL GET ALL OBSERVATIONS IN A SINGLE CATEGORY).           COD  51 
C        8.  TITLE CARD FOR G-L(MSA-I) OUTPUT HEADING.  PUNCH 1 IN COL- COD  52 
C            UMN 1 AND ANY BCD TITLE IN 2 TO 72.                        COD  53 
C        9.  CONTROL CARD 2, 5 4-COLUMN FIELDS CONTAINING THE FOLLOWING COD  54 
C            INFORMATION -                                              COD  55 
C            A)  MIND= 2-3 FOR NUMBER OF DIMENSIONS DESIRED ,  IF LEFT  COD  56 
C                BLANK OR SET TO 0 MIND=1,                              COD  57 
C            B)  MAXD = MAXIMUM NUMBER OF DIMENSIONS DESIRED (MAXD .GE. COD  58 
C                MIND),                                                 COD  59 
C            C)  NIT=NUMBER OF ITERATIONS, IF BLANK OR ZERO NIT=25,     COD  60 
C            D)  IFP=1 IF ITEM PLOTS ARE TO BE PRINTED FOR EACH ITEM,   COD  61 
C                OTHERWISE SET TO ZERO OR LEAVE BLANK,                  COD  62 
C            E)  CCON=CUT-OUT CRITERION FOR COEFFICIENT OF CONTIGUITY   COD  63 
C                (.G.0 BUT .LE. 1.00), WHICH MUST INCLUDE DECIMAL POINT.COD  64 
C       10.  REPEAT 3-9 FOR ADDITIONAL RUNS.                            COD  65 
C                                                                       COD  66 
C     *** REFERENCES - GUTTMAN, L. A GENERAL NONMETRIC TECHNIQUE FOR    COD  67 
C                                  FINDING THE SMALLEST EUCLIDEAN SPACE COD  68 
C                                  FOR A CONFIGURATION OF POINTS.  PSY- COD  69 
C                                  CHOMETRIKA, 1968,                    COD  70 
C                      LINGOES, J. C.  MULTIVARIATE ANALYSIS OF CONTIN- COD  71 
C                                  GENCIES - AN IBM 7090 PROGRAM FOR AN-COD  72 
C                                  ALYZING METRIC/NONMETRIC OR LINEAR/  COD  73 
C                                  NONLINEAR DATA.  COMP. RPT., 1963,2, COD  74 
C                                  1-24.  (A DITTO COPY IS AVAILABLE    COD  75 
C                                  FROM AUTHOR UPON WRITTEN REQUEST).   COD  76 
C                      LINGOES, J. C.  SIMULTANEOUS LINEAR REGRESSIONS -COD  77 
C                                  AN IBM 7090 PROGRAM FOR ANALYZING    COD  78 
C                                  METRIC/NONMETRIC OR LINEAR/NONLINEAR COD  79 
C                                  DATA.  BEHAV. SCI., 1964,9, 87-88.   COD  80 
C                      LINGOES, J. C.  AN IBM-7090 PROGRAM FOR GUTTMAN- COD  81 
C                                  LINGOES SMALLEST SPACE ANALYSIS - I. COD  82 
C                                  BEHAV. SCI., 1965,10,183-184.        COD  83 
C                      LINGOES, J. C.  NEW COMPUTER DEVELOPMENTS IN PAT-COD  84 
C                                  TERN ANALYSIS AND NONMETRIC TECH-    COD  85 
C                                  NIQUES.  IN - USES OF COMPUTERS IN   COD  86 
C                                  PSYCHOLOGICAL RESEARCH. GAUTHIER-    COD  87 
C                                  VILLARS, PARIS, 1966,1-22.           COD  88 
C                      LINGOES, J. C.  AN IBM-7090 PROGRAM FOR GUTTMAN- COD  89 
C                                  LINGOES MULTIDIMENSIONAL SCALOGRAM   COD  90 
C                                  ANALYSIS - I.  BEHAV. SCI., 1966, 11,COD  91 
C                                  76-78.                               COD  92 
C                      LINGOES, J. C.  THE MULTIVARIATE ANALYSIS OF     COD  93 
C                                  QUALITATIVE DATA.  MULT. BEHAV. RES.,COD  94 
C                                  1968,                                COD  95 
C                                                                       COD  96 
      DIMENSION R(101,51), MATR(101,51), MP(21), A(100,100), FCAT(50,20)COD  97 
     1, FMT(18), IA(100,100)                                            COD  98 
      EQUIVALENCE (R,MATR), (A,IA)                                      COD  99 
      COMMON R,A,FCAT                                                   COD 100 
C                                                                       COD 101 
C     *** SUBROUTINES NEEDED=PLOT (CORE 3).                             COD 102 
C                                                                       COD 103 
C     TAPE ASSIGNMENTS                                                  COD 105 
      ITAPE=5                                                           COD 106 
      JTAPE=6                                                           COD 107 
C     READ IN TITLE, PARAMETERS, FORMAT, AND DATA                       COD 108 
      READ (ITAPE,82)                                                   COD 109 
      READ (ITAPE,83) NV,NS,IFCODE,MAX,NCAT,IFCDS,IFT,CODE              COD 110 
      IF (IFT) 1,2,1                                                    COD 111 
1     READ (ITAPE,85) (MATR(I,51),I=1,IFT)                              COD 112 
2     READ (ITAPE,84) (FMT(I),I=1,18)                                   COD 113 
      DO 5 I=1,NS                                                       COD 114 
      IF (IFT) 3,4,3                                                    COD 115 
3     READ (ITAPE,FMT) (R(I,J),J=1,NV)                                  COD 116 
      GO TO 5                                                           COD 117 
4     A(I,51)=0.                                                        COD 118 
      READ (ITAPE,FMT) (A(I,J),J=1,NV)                                  COD 119 
5     CONTINUE                                                          COD 120 
      CALL REWIND (3)                                                   COD 121 
      CALL REWIND (4)                                                   COD 122 
      NSM1=NS-1                                                         COD 123 
      IF (IFT) 16,6,16                                                  COD 124 
C     CHECK FOR TYPES AND ELIMINATE REPITITIONS                         COD 125 
6     WRITE (JTAPE,82)                                                  COD 126 
      KK=0                                                              COD 127 
      DO 12 I=1,NSM1                                                    COD 128 
      IF (A(I,51)) 12,7,7                                               COD 129 
7     NWT=1                                                             COD 130 
      IP1=I+1                                                           COD 131 
      DO 10 J=IP1,NS                                                    COD 132 
      IF (A(J,51)) 10,8,8                                               COD 133 
8     DO 9 K=1,NV                                                       COD 134 
      IF (IA(I,K)-IA(J,K)) 10,9,10                                      COD 135 
9     CONTINUE                                                          COD 136 
      A(J,51)=-1.                                                       COD 137 
      NWT=NWT+1                                                         COD 138 
      WRITE (JTAPE,86) J,I                                              COD 139 
10    CONTINUE                                                          COD 140 
      KK=KK+1                                                           COD 141 
      DO 11 L=1,NV                                                      COD 142 
11    R(KK,L)=A(I,L)                                                    COD 143 
      MATR(KK,51)=NWT                                                   COD 144 
      WRITE (JTAPE,87) I,KK                                             COD 145 
12    CONTINUE                                                          COD 146 
      IF (A(NS,51)) 15,13,13                                            COD 147 
13    KK=KK+1                                                           COD 148 
      DO 14 L=1,NV                                                      COD 149 
14    R(KK,L)=A(NS,L)                                                   COD 150 
      MATR(KK,51)=1                                                     COD 151 
      WRITE (JTAPE,87) NS,KK                                            COD 152 
15    NS=KK                                                             COD 153 
16    FNS=NS                                                            COD 154 
      WRITE (JTAPE,82)                                                  COD 155 
      NSP1=NS+1                                                         COD 156 
      IFCODE=IFCODE+1                                                   COD 157 
      GO TO (17,35), IFCODE                                             COD 158 
C     CHECK FOR MISSING DATA AND SUBSTITUTE MEANS IF THEY EXIST         COD 159 
17    IF (CODE) 18,26,18                                                COD 160 
18    DO 25 J=1,NV                                                      COD 161 
      COUNT=0.                                                          COD 162 
      SUM=0.                                                            COD 163 
      DO 21 I=1,NS                                                      COD 164 
      IF (R(I,J)-CODE) 20,19,20                                         COD 165 
19    COUNT=COUNT+1.                                                    COD 166 
      GO TO 21                                                          COD 167 
20    SUM=SUM+R(I,J)                                                    COD 168 
21    CONTINUE                                                          COD 169 
      IF (COUNT) 22,25,22                                               COD 170 
22    SUM=SUM/(FNS-COUNT)                                               COD 171 
      DO 24 I=1,NS                                                      COD 172 
      IF (R(I,J)-CODE) 24,23,24                                         COD 173 
23    R(I,J)=SUM                                                        COD 174 
24    CONTINUE                                                          COD 175 
25    CONTINUE                                                          COD 176 
C     COMPUTE CODED SCORES FOR EACH VARIABLE                            COD 177 
26    WRITE (JTAPE,88)                                                  COD 178 
      PGRPS=MAX                                                         COD 179 
      DO 34 J=1,NV                                                      COD 180 
      BIG=0.                                                            COD 181 
      SMALL=10000.                                                      COD 182 
      DO 30 I=1,NS                                                      COD 183 
      IF (BIG-R(I,J)) 27,28,28                                          COD 184 
27    BIG=R(I,J)                                                        COD 185 
28    IF (R(I,J)-SMALL) 29,30,30                                        COD 186 
29    SMALL=R(I,J)                                                      COD 187 
30    CONTINUE                                                          COD 188 
      CODE=(BIG-SMALL+1.)/PGRPS                                         COD 189 
      WRITE (JTAPE,89) J,SMALL,BIG,CODE                                 COD 190 
      DO 33 I=1,NS                                                      COD 191 
      R(I,J)=R(I,J)-SMALL                                               COD 192 
      DO 32 K=1,21                                                      COD 193 
      R(I,J)=R(I,J)-CODE                                                COD 194 
      IF (R(I,J)) 31,32,32                                              COD 195 
31    MATR(I,J)=K                                                       COD 196 
      GO TO 33                                                          COD 197 
32    CONTINUE                                                          COD 198 
      MATR(I,J)=21                                                      COD 199 
33    CONTINUE                                                          COD 200 
34    CONTINUE                                                          COD 201 
C     SET FREQUENCIES FOR EACH CATEGORY ACCORDING TO PARAMETER          COD 202 
35    IF (NCAT) 65,65,36                                                COD 203 
36    DO 64 J=1,NV                                                      COD 204 
      DO 37 K=1,21                                                      COD 205 
37    MP(K)=0                                                           COD 206 
      DO 38 I=1,NS                                                      COD 207 
      KK=MATR(I,J)                                                      COD 208 
38    MP(KK)=1                                                          COD 209 
      KK=0                                                              COD 210 
      DO 40 L=1,21                                                      COD 211 
      IF (MP(L)) 40,40,39                                               COD 212 
39    KK=KK+1                                                           COD 213 
      MP(L)=KK                                                          COD 214 
40    CONTINUE                                                          COD 215 
      LL=KK-1                                                           COD 216 
      DO 41 M=1,NS                                                      COD 217 
      INDEXI=MATR(M,J)                                                  COD 218 
41    MATR(M,J)=MP(INDEXI)                                              COD 219 
      DO 42 K=1,21                                                      COD 220 
42    MP(K)=0                                                           COD 221 
      DO 43 I=1,NS                                                      COD 222 
      INDEXI=MATR(I,J)                                                  COD 223 
43    MP(INDEXI)=MP(INDEXI)+1                                           COD 224 
      DO 53 K=2,LL                                                      COD 225 
      KM1=K                                                             COD 226 
      IF (MP(K)-NCAT) 44,53,53                                          COD 227 
44    KM1=KM1-1                                                         COD 228 
      IF (MP(KM1)) 45,44,45                                             COD 229 
45    KP1=K+1                                                           COD 230 
      IF (MP(KM1)-MP(KP1)) 46,49,49                                     COD 231 
46    MP(KM1)=MP(KM1)+MP(K)                                             COD 232 
      DO 48 I=1,NS                                                      COD 233 
      IF (MATR(I,J)-K) 48,47,48                                         COD 234 
47    MATR(I,J)=KM1                                                     COD 235 
48    CONTINUE                                                          COD 236 
      GO TO 52                                                          COD 237 
49    MP(KP1)=MP(KP1)+MP(K)                                             COD 238 
      DO 51 I=1,NS                                                      COD 239 
      IF (MATR(I,J)-K) 51,50,51                                         COD 240 
50    MATR(I,J)=KP1                                                     COD 241 
51    CONTINUE                                                          COD 242 
52    MP(K)=0                                                           COD 243 
53    CONTINUE                                                          COD 244 
      IF (MP(1)-NCAT) 54,59,59                                          COD 245 
54    K=1                                                               COD 246 
55    K=K+1                                                             COD 247 
      IF (MP(K)) 56,55,56                                               COD 248 
56    DO 58 I=1,NS                                                      COD 249 
      IF (MATR(I,J)-1) 58,57,58                                         COD 250 
57    MATR(I,J)=K                                                       COD 251 
58    CONTINUE                                                          COD 252 
59    LL=LL+1                                                           COD 253 
      IF (MP(LL)-NCAT) 60,64,64                                         COD 254 
60    LL=LL-1                                                           COD 255 
      IF (MP(LL)) 61,60,61                                              COD 256 
61    DO 63 I=1,NS                                                      COD 257 
      IF (MATR(I,J)-KK) 63,62,63                                        COD 258 
62    MATR(I,J)=LL                                                      COD 259 
63    CONTINUE                                                          COD 260 
64    CONTINUE                                                          COD 261 
C     REPLACE CODED SCORES WITH COMPACT RANKS                           COD 262 
65    DO 70 J=1,NV                                                      COD 263 
      DO 66 K=1,21                                                      COD 264 
66    MP(K)=0                                                           COD 265 
      DO 67 I=1,NS                                                      COD 266 
      KK=MATR(I,J)                                                      COD 267 
67    MP(KK)=1                                                          COD 268 
      KK=0                                                              COD 269 
      DO 69 L=1,21                                                      COD 270 
      IF (MP(L)) 69,69,68                                               COD 271 
68    KK=KK+1                                                           COD 272 
      MP(L)=KK                                                          COD 273 
69    CONTINUE                                                          COD 274 
      MATR(NSP1,J)=KK                                                   COD 275 
      DO 70 M=1,NS                                                      COD 276 
      KK=MATR(M,J)                                                      COD 277 
70    MATR(M,J)=MP(KK)                                                  COD 278 
      NVM1=NV-1                                                         COD 279 
      WRITE (JTAPE,90)                                                  COD 280 
      WRITE (JTAPE,91) (KK,KK=1,21)                                     COD 281 
      DO 74 I=1,NV                                                      COD 282 
      LL=MATR(NSP1,I)                                                   COD 283 
      DO 71 J=1,LL                                                      COD 284 
71    MP(J)=0                                                           COD 285 
      DO 72 K=1,NS                                                      COD 286 
      INDEXI=MATR(K,I)                                                  COD 287 
72    MP(INDEXI)=MP(INDEXI)+1                                           COD 288 
      DO 73 KK=1,LL                                                     COD 289 
73    FCAT(I,KK)=MP(KK)                                                 COD 290 
74    WRITE (JTAPE,92) I,(MP(L),L=1,LL)                                 COD 291 
      WRITE (3) NV,NVM1,NS,NSP1,(MATR(NSP1,J),J=1,NV)                   COD 292 
      DO 75 I=1,NV                                                      COD 293 
      LL=MATR(NSP1,I)                                                   COD 294 
75    WRITE (3) (FCAT(I,J),J=1,LL)                                      COD 295 
      DO 79 I=1,NS                                                      COD 296 
      DO 78 J=I,NS                                                      COD 297 
      A(I,J)=0.                                                         COD 298 
      DO 77 K=1,NV                                                      COD 299 
      IF (MATR(I,K)-MATR(J,K)) 77,76,77                                 COD 300 
76    KK=MATR(I,K)                                                      COD 301 
      COUNT=1./FCAT(K,KK)                                               COD 302 
      A(I,J)=A(I,J)+COUNT                                               COD 303 
77    CONTINUE                                                          COD 304 
78    A(J,I)=A(I,J)                                                     COD 305 
79    WRITE (3) (A(I,L),L=1,NS)                                         COD 306 
      WRITE (4) NV,NS                                                   COD 307 
      DO 81 I=1,NS                                                      COD 308 
      IF (IFCDS) 81,81,80                                               COD 309 
80    PUNCH 93, I,(MATR(I,K),K=1,NV)                                    COD 310 
81    WRITE (4) (MATR(I,J),J=1,NV)                                      COD 311 
      WRITE (4) (MATR(I,51),I=1,NS)                                     COD 312 
C                                                                       COD 313 
C     SUBSTITUTE YOUR OWN PROGRAM VERSION FOR MULTIPLE CORE LOADS OR    COD 314 
C     CHAIN JOBS.                                                       COD 315 
      CALL PUNT ('-CORE2 ')                                             COD 316 
C     *** FORMAT STATEMENTS ***                                         COD 317 
C                                                                       COD 318 
82    FORMAT (72H                                                       COD 319 
     1                 )                                                COD 320 
83    FORMAT (7I4,F8.4)                                                 COD 321 
84    FORMAT (18A4)                                                     COD 322 
85    FORMAT (36I2)                                                     COD 323 
86    FORMAT (8H SUBJECT,I4,24H IS IDENTICAL TO SUBJECT,I4,22H AND HAS BCOD 324 
     1EEN DELETED.)                                                     COD 325 
87    FORMAT (8H SUBJECT,I4,14H IS RENUMBERED,I4)                       COD 326 
88    FORMAT (10H0 VARIABLE,10X13HSCORE   RANGE,10X14HCODED INTERVAL/1H COD 327 
     1,57(1H-)/1H )                                                     COD 328 
89    FORMAT (I7,E17.6,4H TO ,E12.6,E16.6)                              COD 329 
90    FORMAT (1H1,43X44HFREQUENCY DISTRIBUTION FOR RANKED CODED DATA)   COD 330 
91    FORMAT (6H0 VAR.,21I6/1H ,131(1H-)/1H )                           COD 331 
92    FORMAT (22I6)                                                     COD 332 
93    FORMAT (I4,34I2/(36I2))                                           COD 333 
      END                                                               COD 334-
C     MSA1 - CORE 2                                                     SLR   1 
C     LINGOES-GUTTMAN SIMULTANEOUS LINEARIZATION PROGRAM.               SLR   2 
C                                                                       SLR   3 
      DIMENSION A(100,100), MAT(100,100), C(100,100), FCAT(50,20), SCORESLR   4 
     1(50,20), ETA(4), NCAT(50)                                         SLR   5 
      COMMON A,B                                                        SLR   6 
      EQUIVALENCE (A,MAT)                                               SLR   7 
C                                                                       SLR   8 
C     TAPE ASSIGNMENTS                                                  SLR  10 
      JTAPE=6                                                           SLR  11 
      CALL REWIND (3)                                                   SLR  12 
      CALL REWIND (4)                                                   SLR  13 
      CALL REWIND (9)                                                   SLR  14 
      READ (3) NV,NVM1,NS,NSP1,(NCAT(J),J=1,NV)                         SLR  15 
      FNVM1=NVM1                                                        SLR  16 
      DO 1 I=1,NV                                                       SLR  17 
      LL=NCAT(I)                                                        SLR  18 
1     READ (3) (FCAT(I,J),J=1,LL)                                       SLR  19 
      DO 2 I=1,NS                                                       SLR  20 
2     READ (3) (C(I,J),J=1,NS)                                          SLR  21 
C     CALL HOUSEHOLDER SUBROUTINE                                       SLR  22 
      CALL EIGEN (C,A,NS,ETA,4)                                         SLR  23 
      KK=0                                                              SLR  24 
      DO 4 J=2,4                                                        SLR  25 
      ETA(J-1)=(ETA(J)-1.)/FNVM1                                        SLR  26 
      IF (ETA(J-1)) 5,5,3                                               SLR  27 
3     KK=KK+1                                                           SLR  28 
4     CONTINUE                                                          SLR  29 
5     NR=KK                                                             SLR  30 
      DO 6 J=1,NR                                                       SLR  31 
      DO 6 I=1,NS                                                       SLR  32 
6     C(I,J)=A(I,J+1)                                                   SLR  33 
      WRITE (JTAPE,16) (II,II=1,3)                                      SLR  34 
      DO 7 I=1,NS                                                       SLR  35 
7     WRITE (JTAPE,19) I,(C(I,J),J=1,NR)                                SLR  36 
      WRITE (JTAPE,17)                                                  SLR  37 
      READ (4) NV,NS                                                    SLR  38 
      DO 8 I=1,NS                                                       SLR  39 
8     READ (4) (MAT(I,J),J=1,NV)                                        SLR  40 
      DO 13 J=1,NR                                                      SLR  41 
      DO 11 K=1,NV                                                      SLR  42 
      LL=NCAT(K)                                                        SLR  43 
      DO 11 M=1,LL                                                      SLR  44 
      SCORE(K,M)=0.                                                     SLR  45 
      DO 10 L=1,NS                                                      SLR  46 
      IF (MAT(L,K)-M) 10,9,10                                           SLR  47 
9     SCORE(K,M)=SCORE(K,M)+C(L,J)                                      SLR  48 
10    CONTINUE                                                          SLR  49 
11    SCORE(K,M)=SCORE(K,M)/FCAT(K,M)                                   SLR  50 
      WRITE (JTAPE,18) J,ETA(J),(MMM,MMM=1,20)                          SLR  51 
      DO 12 N=1,NV                                                      SLR  52 
      II=NCAT(N)                                                        SLR  53 
12    WRITE (JTAPE,19) N,(SCORE(N,JJ),JJ=1,II)                          SLR  54 
13    CONTINUE                                                          SLR  55 
      DO 14 J=1,NR                                                      SLR  56 
      FF=SQRT(ETA(J))                                                   SLR  57 
      DO 14 I=1,NS                                                      SLR  58 
14    C(I,J)=C(I,J)*FF                                                  SLR  59 
      DO 15 J=1,NR                                                      SLR  60 
15    WRITE (9) (C(I,J),I=1,NS)                                         SLR  61 
C     *** SEE NOTES RE CHAINING.                                        SLR  62 
      CALL PUNT ('-CORE3 ')                                             SLR  63 
C     *** FORMAT STATEMENTS ***                                         SLR  64 
C                                                                       SLR  65 
16    FORMAT (39H1SCORES FOR EACH SUBJECT ON EACH VECTOR/7H0VECTOR,5X3I6SLR  66 
     1/1H ,30(1H-)/8H SUBJECT)                                          SLR  67 
17    FORMAT (1H1,42X46HLINGOES MULTIVARIATE ANALYSIS OF CONTINGENCIES/1SLR  68 
     17H0CATEGORY WEIGHTS/1H ,16(1H-))                                  SLR  69 
18    FORMAT (7H0VECTOR,I4,1H.,5X5HETA =,F4.3/9H CATEGORY,3X20I6/1H ,131SLR  70 
     1(1H-)/9H VARIABLE)                                                SLR  71 
19    FORMAT (I6,6X3P20F6.0)                                            SLR  72 
      END                                                               SLR  73-
C     EIGEN-MSA-I                                                       EGN   1 
C     EIGENVALUES AND NORMALIZED EIGENVECTORS OF A REAL SYMMETRIC MATRIXEGN   2 
C     PROGRAMMED BY GARBOW, ARGONNE, 1965 AND MODIFIED BY LINGOES, U OF EGN   3 
C     M, 1966 USING HOUSEHOLDER'S TRIDIAGONALIZATION PROCEDURE AND      EGN   4 
C     INVERSE ITERATIONS TO OBTAIN EIGENVECTORS.  COMPLETE MULTIPLICITY EGN   5 
C     OF EIGENSYSTEM IS DETERMINED.                                     EGN   6 
C     EIGENVALUES ARE RETURNED IN VALU AND NORMALIZED EIGENVECTORS ARE  EGN   7 
C     STORED IN B.  NSUB IS ORDER OF MATRICES A AND B AND MSUB IS THE   EGN   8 
C     NUMBER OF ROOTS AND VECTORS DESIRED.                              EGN   9 
C                                                                       EGN  10 
      SUBROUTINE EIGEN (A,B,NSUB,VALU,MSUB)                             EGN  11 
      DIMENSION A(100,100), B(100,100), VALU(4), T(100,3), DIAG(100), SUEGN  12 
     1PERD(100), WVEC(100), PVEC(100), QVEC(100), VALL(100), Q(100), U(1EGN  13 
     200), INDEX(100), FACTOR(100), V(100)                              EGN  14 
      EQUIVALENCE (WVEC,VALL,FACTOR,U),(PVEC,QVEC,Q,V), (I1,T1),(I2,T2),EGN  15 
     1 (TEMP,T0), (SUM,MATCH), (I,P), (DIV,SCALAR,TAU), (ANORM2,ANORM), EGN  16 
     2 (VTEMP,VNORM2,VNORM)                                             EGN  17 
C                                                                       EGN  18 
C     INITIALIZATION                                                    EGN  19 
      N=NSUB                                                            EGN  20 
      M=MSUB                                                            EGN  21 
      NP1=N+1                                                           EGN  22 
      NM1=N-1                                                           EGN  23 
      E1=1.E-6                                                          EGN  24 
C     GENERATE IDENTITY MATRIX                                          EGN  25 
      DO 3 I=1,N                                                        EGN  26 
      DO 3 J=1,N                                                        EGN  27 
      IF (I-J) 2,1,2                                                    EGN  28 
1     B(I,J)=1.                                                         EGN  29 
      GO TO 3                                                           EGN  30 
2     B(I,J)=0.                                                         EGN  31 
3     CONTINUE                                                          EGN  32 
C     HOUSEHOLDER SIMILARITY TRANSFORMATION TO CO-DIAGONAL FORM         EGN  33 
C     REDUCE COLUMN OF MATRIX                                           EGN  34 
      DO 14 I=1,NM1                                                     EGN  35 
      IF (I-NM1) 4,13,4                                                 EGN  36 
4     I1=I+1                                                            EGN  37 
      I2=I1+1                                                           EGN  38 
      SUM=0.                                                            EGN  39 
      DO 5 J=I2,N                                                       EGN  40 
5     SUM=SUM+A(J,I)**2                                                 EGN  41 
      IF (SUM) 6,13,6                                                   EGN  42 
6     J=I1                                                              EGN  43 
      TEMP=A(J,I)                                                       EGN  44 
      SUM=SQRT(SUM+TEMP**2)                                             EGN  45 
      A(J,I)=-SIGN(SUM,TEMP)                                            EGN  46 
      WVEC(J)=SQRT(1.+ABS(TEMP)/SUM)                                    EGN  47 
      DIV=SIGN(WVEC(J)*SUM,TEMP)                                        EGN  48 
      DO 7 J=I2,N                                                       EGN  49 
7     WVEC(J)=A(J,I)/DIV                                                EGN  50 
      SCALAR=0.                                                         EGN  51 
      DO 9 J=I1,N                                                       EGN  52 
      PVEC(J)=0.                                                        EGN  53 
      DO 8 K=I1,N                                                       EGN  54 
8     PVEC(J)=PVEC(J)+A(K,J)*WVEC(K)                                    EGN  55 
      SCALAR=SCALAR+PVEC(J)*WVEC(J)                                     EGN  56 
9     CONTINUE                                                          EGN  57 
      SCALAR=SCALAR/2.                                                  EGN  58 
      DO 10 J=I1,N                                                      EGN  59 
      QVEC(J)=PVEC(J)-SCALAR*WVEC(J)                                    EGN  60 
      DO 10 K=I1,J                                                      EGN  61 
      A(K,J)=A(K,J)-(WVEC(K)*QVEC(J)+WVEC(J)*QVEC(K))                   EGN  62 
      A(J,K)=A(K,J)                                                     EGN  63 
10    CONTINUE                                                          EGN  64 
C     SAVE ROTATION FOR LATER APPLICATION TO CO-DIAGONAL VECTORS        EGN  65 
      DO 12 K=2,N                                                       EGN  66 
      TEMP=0.                                                           EGN  67 
      DO 11 J=I1,N                                                      EGN  68 
11    TEMP=TEMP+WVEC(J)*B(J,K)                                          EGN  69 
      DO 12 J=I1,N                                                      EGN  70 
      B(J,K)=B(J,K)-WVEC(J)*TEMP                                        EGN  71 
12    CONTINUE                                                          EGN  72 
C     MOVE CO-DIAGONAL FORM ELEMENTS FOR ITERATIVE PROCEDURE            EGN  73 
13    J=I                                                               EGN  74 
      DIAG(I)=A(J,I)                                                    EGN  75 
      SUPERD(I)=A(J+1,I)                                                EGN  76 
14    CONTINUE                                                          EGN  77 
      DIAG(N)=A(N,N)                                                    EGN  78 
C     DETERMINE EIGENVALUES FROM STURM CHAIN OF CO-DIAGONAL MINORS      EGN  79 
C     CALCULATE NORM OF MATRIX AND INITIALIZE EIGENVALUE BOUNDS         EGN  80 
      ANORM2=DIAG(1)**2                                                 EGN  81 
      DO 15 L=2,N                                                       EGN  82 
      Q(L-1)=SUPERD(L-1)**2                                             EGN  83 
      ANORM2=DIAG(L)**2+Q(L-1)+Q(L-1)+ANORM2                            EGN  84 
15    CONTINUE                                                          EGN  85 
      ANORM=SQRT(ANORM2)                                                EGN  86 
      DO 16 L=1,M                                                       EGN  87 
      VALU(L)=ANORM                                                     EGN  88 
      VALL(L)=-ANORM                                                    EGN  89 
16    CONTINUE                                                          EGN  90 
      EPS1=ANORM*E1                                                     EGN  91 
      IF (EPS1) 17,72,17                                                EGN  92 
C     CHOOSE NEW TRIAL VALUE WHILE TESTING BOUNDS FOR CONVERGENCE       EGN  93 
17    DO 35 L=1,M                                                       EGN  94 
      ITER=0                                                            EGN  95 
      VTEMP=EPS1                                                        EGN  96 
18    TAU=(VALU(L)+VALL(L))/2.                                          EGN  97 
      IF (ITER-10) 20,19,20                                             EGN  98 
19    VTEMP=VTEMP*10.                                                   EGN  99 
      ITER=0                                                            EGN 100 
20    IF (2.*(TAU-VALL(L))-VTEMP) 35,35,21                              EGN 101 
C     DETERMINE SIGNS OF PRINCIPAL MINORS                               EGN 102 
21    MATCH=0                                                           EGN 103 
      ITER=ITER+1                                                       EGN 104 
      T2=0.                                                             EGN 105 
      T1=1.                                                             EGN 106 
      DO 30 L1=1,N                                                      EGN 107 
      P=DIAG(L1)-TAU                                                    EGN 108 
      IF (T2) 23,22,23                                                  EGN 109 
22    T1=SIGN(1.,T1)                                                    EGN 110 
23    IF (T1) 25,24,25                                                  EGN 111 
24    T0=-SIGN(1.,T2)                                                   EGN 112 
      T2=0.                                                             EGN 113 
      IF (Q(L1-1)) 26,22,26                                             EGN 114 
25    T0=P-Q(L1-1)*T2/T1                                                EGN 115 
      T2=1.                                                             EGN 116 
C     COUNT AGREEMENTS IN SIGN (ZERO CONSIDERED POSITIVE)               EGN 117 
26    IF (T0) 29,27,28                                                  EGN 118 
27    T2=T1                                                             EGN 119 
      IF (T2) 29,28,28                                                  EGN 120 
28    MATCH=MATCH+1                                                     EGN 121 
29    T1=T0                                                             EGN 122 
30    CONTINUE                                                          EGN 123 
C     ESTABLISH TIGHTER BOUNDS ON EIGENVALUES                           EGN 124 
      DO 34 L1=L,M                                                      EGN 125 
      IF (L1-MATCH) 33,33,31                                            EGN 126 
31    IF (VALU(L1)-TAU) 18,18,32                                        EGN 127 
32    VALU(L1)=TAU                                                      EGN 128 
      GO TO 34                                                          EGN 129 
33    VALL(L1)=TAU                                                      EGN 130 
34    CONTINUE                                                          EGN 131 
      GO TO 18                                                          EGN 132 
35    CONTINUE                                                          EGN 133 
C     EIGENVECTORS OF CO-DIAGONAL SYMMETRIC MATRIX -- INVERSE ITERATION EGN 134 
C     CHECK FOR REPEATED VALUE                                          EGN 135 
      DO 68 I=1,M                                                       EGN 136 
      IF (I-2) 37,36,36                                                 EGN 137 
36    IF (VALU(I-1)-VALU(I)-EPS1) 38,37,37                              EGN 138 
37    I1=-1                                                             EGN 139 
38    I1=I1+1                                                           EGN 140 
C     TRIANGULARIZE CO-DIAGONAL FORM AFTER EIGENVALUE SUBTRACTION       EGN 141 
      DO 43 L=1,N                                                       EGN 142 
      V(L)=EPS1                                                         EGN 143 
      T(L,2)=DIAG(L)-VALU(I)                                            EGN 144 
      IF (L-N) 40,39,40                                                 EGN 145 
39    T(L,3)=0.                                                         EGN 146 
      GO TO 43                                                          EGN 147 
40    T(L,3)=SUPERD(L)                                                  EGN 148 
      IF (T(L,3)) 42,41,42                                              EGN 149 
41    T(L,3)=EPS1                                                       EGN 150 
42    T(L+1,1)=T(L,3)                                                   EGN 151 
43    CONTINUE                                                          EGN 152 
      DO 50 J=1,N                                                       EGN 153 
      T(J,1)=T(J,2)                                                     EGN 154 
      T(J,2)=T(J,3)                                                     EGN 155 
      T(J,3)=0.                                                         EGN 156 
      VTEMP=ABS(T(J,1))                                                 EGN 157 
      IF (J-N) 46,44,46                                                 EGN 158 
44    IF (VTEMP) 50,45,50                                               EGN 159 
45    T(J,1)=EPS1                                                       EGN 160 
      GO TO 50                                                          EGN 161 
46    INDEX(J)=0                                                        EGN 162 
      IF (ABS(T(J+1,1))-VTEMP) 49,49,47                                 EGN 163 
47    INDEX(J)=1                                                        EGN 164 
      DO 48 K=1,3                                                       EGN 165 
      VTEMP=T(J,K)                                                      EGN 166 
      T(J,K)=T(J+1,K)                                                   EGN 167 
      T(J+1,K)=VTEMP                                                    EGN 168 
48    CONTINUE                                                          EGN 169 
49    VTEMP=T(J+1,1)/T(J,1)                                             EGN 170 
      FACTOR(J)=VTEMP                                                   EGN 171 
      T(J+1,2)=T(J+1,2)-VTEMP*T(J,2)                                    EGN 172 
      T(J+1,3)=T(J+1,3)-VTEMP*T(J,3)                                    EGN 173 
50    CONTINUE                                                          EGN 174 
      ITER=1                                                            EGN 175 
      IF (I1) 58,51,58                                                  EGN 176 
C     BACK SUBSTITUTE TO OBTAIN EIGENVECTOR                             EGN 177 
51    DO 52 L1=1,N                                                      EGN 178 
      L=NP1-L1                                                          EGN 179 
      V(L)=(V(L)-T(L,2)*V(L+1)-T(L,3)*V(L+2))/T(L,1)                    EGN 180 
52    CONTINUE                                                          EGN 181 
      GO TO (53,58), ITER                                               EGN 182 
C     PERFORM SECOND ITERATION                                          EGN 183 
53    ITER=2                                                            EGN 184 
54    DO 57 L=2,N                                                       EGN 185 
      IF (INDEX(L-1)) 55,56,55                                          EGN 186 
55    VTEMP=V(L-1)                                                      EGN 187 
      V(L-1)=V(L)                                                       EGN 188 
      V(L)=VTEMP                                                        EGN 189 
56    V(L)=V(L)-FACTOR(L-1)*V(L-1)                                      EGN 190 
57    CONTINUE                                                          EGN 191 
      GO TO 51                                                          EGN 192 
C     ORTHOGONALIZE VECTOR TO OTHERS ASSOCIATED WITH REPEATED ROOT      EGN 193 
58    IF (I1) 59,62,59                                                  EGN 194 
59    DO 61 L1=1,I1                                                     EGN 195 
      K=I-L1                                                            EGN 196 
      VTEMP=0.                                                          EGN 197 
      DO 60 J=1,N                                                       EGN 198 
60    VTEMP=VTEMP+A(J,K)*V(J)                                           EGN 199 
      DO 61 J=1,N                                                       EGN 200 
61    V(J)=V(J)-A(J,K)*VTEMP                                            EGN 201 
62    GO TO (54,63), ITER                                               EGN 202 
C     NORMALIZE VECTOR TO UNIT LENGTH                                   EGN 203 
63    VNORM2=0.                                                         EGN 204 
      SUM=0.                                                            EGN 205 
      DO 65 L=1,N                                                       EGN 206 
      IF (SUM-ABS(V(L))) 64,65,65                                       EGN 207 
64    SUM=ABS(V(L))                                                     EGN 208 
65    CONTINUE                                                          EGN 209 
      DO 66 L=1,N                                                       EGN 210 
      V(L)=V(L)/SUM                                                     EGN 211 
66    VNORM2=VNORM2+V(L)**2                                             EGN 212 
      VNORM=SQRT(VNORM2)                                                EGN 213 
      DO 67 J=1,N                                                       EGN 214 
67    A(J,I)=V(J)/VNORM                                                 EGN 215 
68    CONTINUE                                                          EGN 216 
C     ROTATION OF CO-DIAGONAL VECTORS INTO MATRIX EIGENVECTORS          EGN 217 
      DO 70 I=1,M                                                       EGN 218 
      DO 69 K=2,N                                                       EGN 219 
      U(K)=0.                                                           EGN 220 
      DO 69 J=2,N                                                       EGN 221 
69    U(K)=U(K)+B(J,K)*A(J,I)                                           EGN 222 
      DO 70 J=2,N                                                       EGN 223 
70    A(J,I)=U(J)                                                       EGN 224 
      DO 71 J=1,M                                                       EGN 225 
      DO 71 I=1,N                                                       EGN 226 
71    B(I,J)=A(I,J)                                                     EGN 227 
72    RETURN                                                            EGN 228 
      END                                                               EGN 229-
C     MSA1 - CORE 3                                                     MS1   1 
C     GUTTMAN-LINGOES MULTIDIMENSIONAL SCALOGRAM ANALYSIS BY OUTER      MS1   2 
C     BOUNDARIES - G-L(MSA-I) - PROGRAMMED IN FORTRAN II BY J.C.LINGOES,MS1   3 
C     MAY 15,1965.                                                      MS1   4 
C                                                                       MS1   5 
      DIMENSION ISCORE(80,50), DIST(80,80), FMAT(80,80), STARM(80,80), SMS1   6 
     1S(3), CORD(80,3), FREQ(80), RFREQ(80), IFREQ(80), MAT(80,80)      MS1   7 
      COMMON ISCORE,CORD,DIST,FMAT,STARM                                MS1   8 
      EQUIVALENCE (FMAT,MAT)                                            MS1   9 
C                                                                       MS1  10 
C     TAPE ASSIGNMENTS                                                  MS1  12 
      ITAPE=5                                                           MS1  13 
      JTAPE=6                                                           MS1  14 
C     SUBROUTINE DIMENSIONING                                           MS1  15 
      MD=80                                                             MS1  16 
      ND=3                                                              MS1  17 
      CALL REWIND (4)                                                   MS1  18 
      CALL REWIND (9)                                                   MS1  19 
      READ (ITAPE,72)                                                   MS1  20 
      READ (ITAPE,74) M,MAXD,NIT,IFP,CCON                               MS1  21 
      READ (4) NV,NS                                                    MS1  22 
      IF (NS-80) 1,1,71                                                 MS1  23 
1     NSM1=NS-1                                                         MS1  24 
      NSP1=NS+1                                                         MS1  25 
      NVP1=NV+1                                                         MS1  26 
      DO 2 I=1,NS                                                       MS1  27 
2     READ (4) (ISCORE(I,J),J=1,NV)                                     MS1  28 
      READ (4) (IFREQ(J),J=1,NS)                                        MS1  29 
      IF (MAXD-4) 4,3,3                                                 MS1  30 
3     MAXD=3                                                            MS1  31 
4     A=0.                                                              MS1  32 
      DO 5 J=1,NS                                                       MS1  33 
      FREQ(J)=IFREQ(J)                                                  MS1  34 
      RFREQ(J)=1./FREQ(J)                                               MS1  35 
5     A=A+FREQ(J)                                                       MS1  36 
      DO 6 J=1,MAXD                                                     MS1  37 
6     READ (9) (CORD(I,J),I=1,NS)                                       MS1  38 
      CALL REWIND (9)                                                   MS1  39 
      DO 9 K=1,MAXD                                                     MS1  40 
      SS(K)=0.                                                          MS1  41 
      B=0.                                                              MS1  42 
      DO 7 I=1,NS                                                       MS1  43 
7     B=B+CORD(I,K)*FREQ(I)                                             MS1  44 
      B=B/A                                                             MS1  45 
      DO 8 J=1,NS                                                       MS1  46 
      CORD(J,K)=(CORD(J,K)-B)*10.                                       MS1  47 
8     SS(K)=SS(K)+CORD(J,K)**2*FREQ(J)                                  MS1  48 
9     CONTINUE                                                          MS1  49 
      ASS=0.                                                            MS1  50 
      IF (NIT) 11,10,11                                                 MS1  51 
10    NIT=25                                                            MS1  52 
11    IF (M) 12,14,12                                                   MS1  53 
12    M=M-1                                                             MS1  54 
      DO 13 I=1,M                                                       MS1  55 
13    ASS=ASS+SS(I)                                                     MS1  56 
14    II=MAXD-1                                                         MS1  57 
      DO 15 J=1,II                                                      MS1  58 
15    WRITE (9) (CORD(I,J),I=1,NS)                                      MS1  59 
      CALL REWIND (9)                                                   MS1  60 
      NC=0                                                              MS1  61 
      DO 16 J=1,NV                                                      MS1  62 
      DO 16 I=1,NS                                                      MS1  63 
      IF (ISCORE(I,J).GT.NC) NC=ISCORE(I,J)                             MS1  64 
16    CONTINUE                                                          MS1  65 
      GO TO 19                                                          MS1  66 
C     REJUVENATE INITIAL CONFIGURATION                                  MS1  67 
17    DO 18 J=1,M                                                       MS1  68 
18    READ (9) (CORD(I,J),I=1,NS)                                       MS1  69 
      CALL REWIND (9)                                                   MS1  70 
19    M=M+1                                                             MS1  71 
      WRITE (JTAPE,72)                                                  MS1  72 
      ASS=ASS+SS(M)                                                     MS1  73 
      ITER=0                                                            MS1  74 
C     BEGIN MSA-I ITERATIONS                                            MS1  75 
20    ITER=ITER+1                                                       MS1  76 
C     COMPUTE D**2                                                      MS1  77 
      DO 22 I=1,NSM1                                                    MS1  78 
      DIST(I,I)=0.                                                      MS1  79 
      IP1=I+1                                                           MS1  80 
      STARM(I,I)=0.                                                     MS1  81 
      DO 22 J=IP1,NS                                                    MS1  82 
      STARM(I,J)=0.                                                     MS1  83 
      STARM(J,I)=0.                                                     MS1  84 
      DIST(I,J)=0.                                                      MS1  85 
      DO 21 K=1,M                                                       MS1  86 
21    DIST(I,J)=DIST(I,J)+(CORD(I,K)-CORD(J,K))**2                      MS1  87 
22    DIST(J,I)=DIST(I,J)                                               MS1  88 
      STARM(NS,NS)=0.                                                   MS1  89 
      DIST(NS,NS)=0.                                                    MS1  90 
C     CONSTRUCT OUTER-POINT MATRIX (ALPHA(PI))                          MS1  91 
      DO 23 J=1,NV                                                      MS1  92 
      DO 23 I=1,NS                                                      MS1  93 
23    ISCORE(I,J)=IABS(ISCORE(I,J))                                     MS1  94 
      DO 31 J=1,NV                                                      MS1  95 
      DO 27 I=1,NS                                                      MS1  96 
      DO 24 K=1,NC                                                      MS1  97 
24    MAT(I,K)=0                                                        MS1  98 
      MAT(I,ISCORE(I,J))=-1                                             MS1  99 
      DO 27 K=1,NS                                                      MS1 100 
      IF (ISCORE(I,J).EQ.ISCORE(K,J)) GO TO 27                          MS1 101 
      II=ISCORE(K,J)                                                    MS1 102 
      IF (MAT(I,II)) 26,25,26                                           MS1 103 
25    MAT(I,II)=K                                                       MS1 104 
      GO TO 27                                                          MS1 105 
26    IF (DIST(I,MAT(I,II)).GT.DIST(I,K)) GO TO 25                      MS1 106 
27    CONTINUE                                                          MS1 107 
      DO 30 K=1,NC                                                      MS1 108 
      DO 30 I=1,NS                                                      MS1 109 
      IF (MAT(I,K)) 30,30,28                                            MS1 110 
28    II=MAT(I,K)                                                       MS1 111 
      IF (ISCORE(II,J)) 30,30,29                                        MS1 112 
29    ISCORE(II,J)=-ISCORE(II,J)                                        MS1 113 
30    CONTINUE                                                          MS1 114 
31    CONTINUE                                                          MS1 115 
      DO 32 I=1,NSM1                                                    MS1 116 
      MAT(I,I)=0                                                        MS1 117 
      IP1=I+1                                                           MS1 118 
      DO 32 J=IP1,NS                                                    MS1 119 
      MAT(I,J)=0                                                        MS1 120 
32    MAT(J,I)=0                                                        MS1 121 
      MAT(NS,NS)=0                                                      MS1 122 
C     COMPUTE N(P,Q),N(P,R),N*(P,Q),AND N*(P,R)                         MS1 123 
      DO 38 J=1,NV                                                      MS1 124 
      DO 37 I=1,NS                                                      MS1 125 
      IF (ISCORE(I,J)) 37,33,33                                         MS1 126 
33    II=ISCORE(I,J)                                                    MS1 127 
      A=10000.                                                          MS1 128 
      B=10000.                                                          MS1 129 
      DO 36 K=1,NS                                                      MS1 130 
      IF (II+ISCORE(K,J)) 35,34,35                                      MS1 131 
34    IF (DIST(I,K).GE.A) GO TO 36                                      MS1 132 
      A=DIST(I,K)                                                       MS1 133 
      JJ=K                                                              MS1 134 
      GO TO 36                                                          MS1 135 
35    IF (ISCORE(K,J).GT.0) GO TO 36                                    MS1 136 
      IF (DIST(I,K).GE.B) GO TO 36                                      MS1 137 
      B=DIST(I,K)                                                       MS1 138 
      KK=K                                                              MS1 139 
36    CONTINUE                                                          MS1 140 
      A=FREQ(I)*FREQ(JJ)*FREQ(KK)                                       MS1 141 
      B=SIGN(A,DIST(I,KK)-DIST(I,JJ))                                   MS1 142 
      FMAT(I,JJ)=FMAT(I,JJ)+A                                           MS1 143 
      FMAT(I,KK)=FMAT(I,KK)-A                                           MS1 144 
      STARM(I,JJ)=STARM(I,JJ)+B                                         MS1 145 
      STARM(I,KK)=STARM(I,KK)-B                                         MS1 146 
37    CONTINUE                                                          MS1 147 
38    CONTINUE                                                          MS1 148 
C     COMPUTE M AND M*                                                  MS1 149 
      DO 39 I=1,NSM1                                                    MS1 150 
      IP1=I+1                                                           MS1 151 
      DO 39 J=IP1,NS                                                    MS1 152 
      A=FREQ(I)*FREQ(J)                                                 MS1 153 
      FMAT(I,J)=(-FMAT(I,J)-FMAT(J,I))/A                                MS1 154 
      FMAT(J,I)=FMAT(I,J)                                               MS1 155 
      STARM(I,J)=(-STARM(I,J)-STARM(J,I))/A                             MS1 156 
      STARM(J,I)=STARM(I,J)                                             MS1 157 
39    CONTINUE                                                          MS1 158 
C     COMPUTE M(P,P) AND M*(P,P)                                        MS1 159 
      DO 42 I=1,NS                                                      MS1 160 
      DO 41 J=1,NS                                                      MS1 161 
      IF (I-J) 40,41,40                                                 MS1 162 
40    FMAT(I,I)=FMAT(I,I)-FMAT(I,J)*FREQ(J)                             MS1 163 
      STARM(I,I)=STARM(I,I)-STARM(I,J)*FREQ(J)                          MS1 164 
41    CONTINUE                                                          MS1 165 
      FMAT(I,I)=RFREQ(I)*FMAT(I,I)                                      MS1 166 
      STARM(I,I)=RFREQ(I)*STARM(I,I)                                    MS1 167 
42    CONTINUE                                                          MS1 168 
C     CALCULATE COEFFICIENT OF CONTIGUITY                               MS1 169 
      DO 43 J=1,M                                                       MS1 170 
      DO 43 I=1,NS                                                      MS1 171 
43    DIST(I,J)=CORD(I,J)*FREQ(I)                                       MS1 172 
      A=0.                                                              MS1 173 
      B=0.                                                              MS1 174 
      DO 46 J=1,M                                                       MS1 175 
      DO 44 K=1,NS                                                      MS1 176 
      DIST(K,J+3)=0.                                                    MS1 177 
      DIST(K,J+6)=0.                                                    MS1 178 
      DO 44 I=1,NS                                                      MS1 179 
      DIST(K,J+6)=DIST(K,J+6)+DIST(I,J)*STARM(I,K)                      MS1 180 
44    DIST(K,J+3)=DIST(K,J+3)+DIST(I,J)*FMAT(I,K)                       MS1 181 
      DO 45 L=1,NS                                                      MS1 182 
      A=A+DIST(L,J+3)*DIST(L,J)                                         MS1 183 
45    B=B+DIST(L,J+6)*DIST(L,J)                                         MS1 184 
46    CONTINUE                                                          MS1 185 
      CF=A/B                                                            MS1 186 
C     COMPUTE MODULATING MULTIPLICATIVE SCALAR                          MS1 187 
      A=0.                                                              MS1 188 
      DO 47 J=1,M                                                       MS1 189 
      DO 47 L=1,NS                                                      MS1 190 
      DIST(L,J)=DIST(L,J+3)-CF*DIST(L,J+6)                              MS1 191 
47    A=A+DIST(L,J)**2*FREQ(L)                                          MS1 192 
      IF (ITER-1) 48,48,49                                              MS1 193 
48    CC=.25*(1.-CF)                                                    MS1 194 
      CS=.5*(1.-CF)                                                     MS1 195 
      GO TO 53                                                          MS1 196 
49    IF ((A/PB)-1.) 50,50,51                                           MS1 197 
50    CC=A/PB                                                           MS1 198 
      GO TO 52                                                          MS1 199 
51    CC=1.                                                             MS1 200 
52    CS=PC*PS                                                          MS1 201 
53    PS=CS                                                             MS1 202 
      PC=CC                                                             MS1 203 
      PB=A                                                              MS1 204 
      A=A*(1.-CC*CS)                                                    MS1 205 
      IF (A) 54,60,54                                                   MS1 206 
54    C=SQRT((ASS*CC*CS)/A)                                             MS1 207 
      WRITE (JTAPE,73) CF,C                                             MS1 208 
C     TEST FOR CONVERGENCE OR SUFFICIENT ITERATIONS                     MS1 209 
      IF (CF-CCON) 55,60,60                                             MS1 210 
55    IF (ITER-NIT) 56,60,60                                            MS1 211 
C     COMPUTE NEW TRIAL COORDINATES                                     MS1 212 
56    DO 57 J=1,M                                                       MS1 213 
      DO 57 I=1,NS                                                      MS1 214 
57    CORD(I,J)=CORD(I,J)-C*DIST(I,J)                                   MS1 215 
C     NORMALIZE COORDINATES TO TOTAL LENGTH OF STARTING VECTORS         MS1 216 
      A=0.                                                              MS1 217 
      DO 58 J=1,M                                                       MS1 218 
      DO 58 I=1,NS                                                      MS1 219 
58    A=A+CORD(I,J)**2*FREQ(I)                                          MS1 220 
      A=SQRT(ASS/A)                                                     MS1 221 
      DO 59 J=1,M                                                       MS1 222 
      DO 59 I=1,NS                                                      MS1 223 
59    CORD(I,J)=CORD(I,J)*A                                             MS1 224 
      GO TO 20                                                          MS1 225 
C     PRINT OUT RESULTS                                                 MS1 226 
60    WRITE (JTAPE,72)                                                  MS1 227 
      WRITE (JTAPE,75) M,(MM,MM=1,M)                                    MS1 228 
      WRITE (JTAPE,76)                                                  MS1 229 
C     NORMALIZE COORDINATES TO LIE IN RANGE +1 TO -1                    MS1 230 
      A=0.                                                              MS1 231 
      DO 62 K=1,M                                                       MS1 232 
      DIST(1,K)=CORD(1,K)                                               MS1 233 
      DIST(2,K)=CORD(1,K)                                               MS1 234 
      DO 61 I=2,NS                                                      MS1 235 
      DIST(1,K)=AMIN1(DIST(1,K),CORD(I,K))                              MS1 236 
61    DIST(2,K)=AMAX1(DIST(2,K),CORD(I,K))                              MS1 237 
62    A=AMAX1(A,(DIST(2,K)-DIST(1,K)))                                  MS1 238 
      A=2./A                                                            MS1 239 
      DO 63 K=1,M                                                       MS1 240 
      DO 63 I=1,NS                                                      MS1 241 
63    CORD(I,K)=A*(CORD(I,K)-DIST(1,K))-1.                              MS1 242 
      DO 64 I=1,NS                                                      MS1 243 
64    WRITE (JTAPE,77) I,(CORD(I,K),K=1,M)                              MS1 244 
      WRITE (JTAPE,78) CF,ITER                                          MS1 245 
      WRITE (JTAPE,79)                                                  MS1 246 
      WRITE (JTAPE,80)                                                  MS1 247 
      DO 65 I=1,NS                                                      MS1 248 
65    WRITE (JTAPE,81) I,IFREQ(I),(ISCORE(I,J),J=1,NV)                  MS1 249 
      IF (M-2) 70,66,66                                                 MS1 250 
C     PLOT COORDINATES                                                  MS1 251 
66    JJ=NVP1                                                           MS1 252 
      IF (IFP) 68,67,68                                                 MS1 253 
67    JJ=1                                                              MS1 254 
68    DO 69 I=1,JJ                                                      MS1 255 
69    CALL PLOT (CORD,DIST(1,1),DIST(1,2),DIST(1,3),DIST(1,4),DIST(1,5),MS1 256 
     1NS,M,MD,ND)                                                       MS1 257 
70    IF (MAXD-M) 71,71,17                                              MS1 258 
C     *** SEE NOTES REGARDING CHAIN JOBS.                               MS1 259 
71    CALL PUNT ('-CORE1 ')                                             MS1 260 
C     *** FORMAT STATEMENTS ***                                         MS1 261 
C                                                                       MS1 262 
72    FORMAT (72H                                                       MS1 263 
     1                 )                                                MS1 264 
73    FORMAT (2E13.6)                                                   MS1 265 
74    FORMAT (4I4,F4.0)                                                 MS1 266 
75    FORMAT (67H0GUTTMAN-LINGOES OUTER-POINT SCALOGRAM ANALYSIS COORDINMS1 267 
     1ATES FOR M =,I3,1H./1H0,9HDIMENSION,3I10)                         MS1 268 
76    FORMAT (1H ,130(1H-)/1H0,5X4HTYPE)                                MS1 269 
77    FORMAT (I9,1X2P3F10.3)                                            MS1 270 
78    FORMAT (28H0COEFFICIENT OF CONTIGUITY =,E12.6,4H FOR,I4,12H ITERATMS1 271 
     1IONS.)                                                            MS1 272 
79    FORMAT (1H1,56X18HOUTER-POINT MATRIX)                             MS1 273 
80    FORMAT (1H ,55X20(1H-)/1H0)                                       MS1 274 
81    FORMAT (7H0TYPE =,I3,2H (,I2,1H)/5X(25I4))                        MS1 275 
      END                                                               MS1 276-
1TEST FOR G-L(MSA-I) FOR A PERFECT UNIDIMENSIONAL SCALE OF 3 CATEGORIES.        
   3   7       3           7                                                    
 4 1 1 2 1 1 1                                                                  
(3F1.0)                                                                         
333                                                                             
332                                                                             
322                                                                             
222                                                                             
221                                                                             
211                                                                             
111                                                                             
1G-L(MSA-I) OF PERFECT GUTTMAN SCALE OF 3 TRICHOTOMOUS ITEMS.                   
   2   2       1 1.0                                                            
1MSA-I OF BELL-SIRJAMAKI STUDY OF GROUP CHARACTERISTICS (GUTTMAN).              
   5   7   1                                                                    
(7I1)                                                                           
11122                                                                           
22222                                                                           
11211                                                                           
42423                                                                           
44423                                                                           
33312                                                                           
23322                                                                           
1BELL-SIRJAMAKI STUDY OF 7 SOCIAL GROUPS ON 5 CHARACTERISTICS.                  
   2   2        1.00                                                            
1G-L(MSA-I) OF MEASUREMENT AND PREDICTION FEAR SYMPTOMS.                        
   9 100       2                                                                
(9F1.0)                                                                         
222222222                                                                       
222222222                                                                       
222222222                                                                       
222222222                                                                       
222222222                                                                       
222222222                                                                       
022222222                                                                       
022222222                                                                       
022222222                                                                       
022222222                                                                       
022222222                                                                       
022222222                                                                       
022222222                                                                       
002222222                                                                       
002222222                                                                       
002222222                                                                       
002222222                                                                       
002222222                                                                       
002202222                                                                       
002202022                                                                       
000222222                                                                       
000222222                                                                       
000222222                                                                       
000222222                                                                       
000222222                                                                       
000222222                                                                       
000022222                                                                       
000022222                                                                       
000202222                                                                       
000202022                                                                       
000202022                                                                       
000002222                                                                       
000002222                                                                       
000020222                                                                       
000020222                                                                       
000020222                                                                       
000000222                                                                       
000000222                                                                       
000000222                                                                       
000202022                                                                       
000002022                                                                       
000002022                                                                       
000000022                                                                       
000000022                                                                       
000000022                                                                       
000000022                                                                       
000000022                                                                       
000000022                                                                       
000000022                                                                       
000000202                                                                       
000000002                                                                       
000000002                                                                       
000000002                                                                       
000000002                                                                       
000000000                                                                       
000000002                                                                       
000000002                                                                       
000000002                                                                       
000000000                                                                       
000000000                                                                       
000000000                                                                       
000000000                                                                       
000000000                                                                       
000000000                                                                       
220222222                                                                       
022222022                                                                       
002222202                                                                       
002222002                                                                       
002220222                                                                       
002022222                                                                       
002022202                                                                       
200222222                                                                       
020222222                                                                       
000220222                                                                       
020022202                                                                       
002022022                                                                       
002022020                                                                       
000022220                                                                       
000022022                                                                       
000022022                                                                       
002002222                                                                       
002002222                                                                       
000200222                                                                       
000000220                                                                       
220002022                                                                       
022002022                                                                       
002002022                                                                       
002020022                                                                       
000020020                                                                       
000200022                                                                       
000000020                                                                       
020000002                                                                       
002000002                                                                       
000020002                                                                       
000002002                                                                       
000020020                                                                       
000202000                                                                       
000200000                                                                       
002000000                                                                       
020020202                                                                       
1G-L(MSA-I) OF MEASUREMENT AND PREDICTION FEAR SYMPTOM SCALOGRAM.               
   2   2  12    .999                                                            
