C     SSAP1                                                             SP1   1 
C     A GENERAL NONMETRIC TECHNIQUE FOR FINDING THE SMALLEST EUCLIDEAN  SP1   2 
C     SPACE FOR A CONFIGURATION OF POINTS IN A JOINT SPACE, WHERE THE   SP1   3 
C     MATRIX IS PARTITIONED INTO TWO DIAGONAL SYMMETRIC SUBMATRICES     SP1   4 
C     (CORRESPONDING TO THE ASSOCIATIONS AMONG OBJECTS AND VARIABLES/   SP1   5 
C     CATEGORIES, RESPECTIVELY) AND AN OFF-DIAGONAL SUBMATRIX CONTAININGSP1   6 
C     THE RELATIONSHIPS BETWEEN A SET OF OBJECTS AND A SET OF VARIABLES/SP1   7 
C     CATEGORIES.  ORDINAL INFORMATION IS ASSUMED TO EXIST WITHIN EACH  SP1   8 
C     PARTITION SEPARATELY AND OVER ALL ELEMENTS IN THAT PARTITION.     SP1   9 
C     PROGRAMMED IN FORTRAN IV FOR THE UNIV. OF MICHIGAN IBM-360/67 BY  SP1  10 
C     J.C.LINGOES (1/15/69).  THE PRESENT PROGRAM INCLUDES OPTIONS FOR: SP1  11 
C     1) ANALYZING AN INDEFINITE NUMBER OF SUBJECTS OR VARIABLES/CATE-  SP1  12 
C     GORIES GIVEN A FIXED CONFIGURATION AND, 2) INPUT OF A CONFIGURA-  SP1  13 
C     TION OF ONE'S CHOICE.  ALGORITHMS EMPLOYED:  G-L "SOFT-SQUEEZE",  SP1  14 
C     DOUBLE-PHASE FOLLOWED BY SINGLE-PHASE (RANK-IMAGES) FOR SEMI-     SP1  15 
C     STRONG MONOTONICITY.                                              SP1  16 
C                                                                       SP1  17 
C     DECK SET-UP FOR G-L(SSAP-I):                                      SP1  18 
C                                                                       SP1  19 
C        1.   SYSTEM ID CARD/S.                                         SP1  20 
C        2.   BINARY PROGRAM.                                           SP1  21 
C        3.   TITLE CARD (PUNCH A 1 IN COLUMN 1 AND ANY BCD TITLE IN COLSP1  22 
C             -UMNS 2 TO 72, WHICH WILL BE PRINTED OUT FOR EACH PAGE OF SP1  23 
C             OUTPUT).                                                  SP1  24 
C        4.   PARAMETER CARD, 10 4-COLUMN FIELDS CONTAINING THE FOLLOW- SP1  25 
C             ING INFORMATION SERIATUM:                                 SP1  26 
C             A)  NS=THE NUMBER OF OBJECTS (V.I., RE CAPACITY),         SP1  27 
C             B)  NR=THE NUMBER OF VARIABLES/CATEGORIES.  NS+NR .LE. 100SP1  28 
C             C)  MIND=0 OR BLANK IF THE PROGRAM IS TO DETERMINE THE MINSP1  29 
C                 -IMUM NUMBER OF DIMENSIONS FOR THE PROBLEM, OTHERWISE SP1  30 
C                 ANY NUMBER BETWEEN 1 AND 10 PROVIDED MIND .LE. MAXD,  SP1  31 
C                 IN WHICH CASE ALL SOLUTIONS FROM MIND TO MAXD WILL BE SP1  32 
C                 PRINTED OUT, UNLESS COEFFICIENT OF ALIENATION < .0001 SP1  33 
C                 FOR A GIVEN M, THE NUMBER OF DIMENSIONS.  UNLESS YOU  SP1  34 
C                 KNOW M, SET MIND=0, IN GENERAL,                       SP1  35 
C             D)  MAXD=THE LARGEST NUMBER OF DIMENSIONS DESIRED .LE.    SP1  36 
C                 (NV-1,10)MIN BUT .GE. 1,                              SP1  37 
C             E)  ISIM=0 OR BLANK FOR DISTANCE COEFFICIENTS OR DISSIMI- SP1  38 
C                 LARITY DATA AND 1 IF SIMILARITY DATA, E.G., CORRELA-  SP1  39 
C                 TIONS.  ALL ELEMENTS ARE ASSUMED TO BE IN SAME ORDER, SP1  40 
C             F)  IFD=1 IF DISTANCE MATRIX IS TO BE PRINTED FOR 2 OR    SP1  41 
C                 MORE DIMENSIONS, OTHERWISE SET TO ZERO OR LEAVE BLANK,SP1  42 
C             G)  IFC=1 IF COORDINATES ARE TO BE PUNCHED FOR 2 OR MORE  SP1  43 
C                 DIMENSIONS, OTHERWISE SET TO ZERO OR LEAVE BLANK.     SP1  44 
C                 CARDS WILL BE AUTOMATICALLY PUNCHED IF MORE THAN 100  SP1  45 
C                 ITERATIONS ARE REQUIRED FOR CONVERGENCE OF 2 OR MORE  SP1  46 
C                 DIMENSIONS.  THESE CARDS CAN BE USED FOR SUBSEQUENT   SP1  47 
C                 INPUT TO CONTINUE THE ITERATIONS,                     SP1  48 
C             H)  IFCONF=1 IF A CONFIGURATION IS TO BE INPUT FOR CON-   SP1  49 
C                 TINUED ITERATIONS OR FOR ADDING POINTS TO A FIXED CON-SP1  50 
C                 FIGURATION, OTHERWISE LEAVE BLANK OR SET TO ZERO.     SP1  51 
C                 MAXD MUST BE THE NUMBER OF DIMENSIONS INPUT,          SP1  52 
C             I)  IFFIX=1 IF INPUT CONFIGURATION IS TO REMAIN FIXED AND SP1  53 
C                 ADDITIONAL POINTS ARE TO BE FITTED TO THIS SPACE,     SP1  54 
C                 OTHERWISE LEAVE BLANK OR SET TO ZERO.  MIND=MAXD.     SP1  55 
C                 TO ACCOMPLISH ANALYSIS OF NS+NR > 100: 1) ANALYZE SOMESP1  56 
C                 REPRESENTATIVE SAMPLE OF OBJECTS OR VARIABLES, SPECI- SP1  57 
C                 FYING IFC=1;  2) USE THE OUTPUT SOLUTION AS INPUT FOR SP1  58 
C                 IFFIX=1.  NS(ASSOCIATION COEFFICIENTS) + NR(VARIABLE/ SP1  59 
C                 CATEGORY SCORES) IS THE ORIGINAL NUMBER OF OBJECTS    SP1  60 
C                 PLUS VARIABLES/CATEGORIES.  ITEMS F) AND G) ABOVE ARE SP1  61 
C                 DISABLED WHEN IFFIX=1.  A CONDITIONAL APPROACH IS IN- SP1  62 
C                 VOKED FOR PRESERVING ORDER WITHIN THE SET OF NS AND   SP1  63 
C                 NR ELEMENTS SEPARATELY VIS-A-VIS THE ORIGINAL SET OF  SP1  64 
C                 NS OBJECT POINTS AND NR VARIABLE OR CATEGORY POINTS.  SP1  65 
C                 IF VARIABLES/CATEGORIES, RATHER THAN OBJECTS, ARE TO  SP1  66 
C                 BE ADDED, THEN NS SHOULD BE THE NUMBER OF VARIABLES/  SP1  67 
C                 CATEGORIES AND NR, THE NUMBER OF OBJECTS.  ONE INPUTS SP1  68 
C                 A NS+NR VECTOR OF VALUES IN ANY EVENT,                SP1  69 
C             J)  IFSR=1 IF EITHER ITEM 7. OR 8. IS TO BE GENERATED BY ASP1  70 
C                 SUBROUTINE (WHICH THE USER SUBSTITUTES FOR THE DUMMY  SP1  71 
C                 SUBROUTINES PROVIDED), OTHERWISE SET TO ZERO OR LEAVE SP1  72 
C                 BLANK.                                                SP1  73 
C        5.   FORMAT CARD (DESCRIBING IN F-NOTATION WHERE THE DATA      SP1  74 
C             APPEARS ON THE CARDS).                                    SP1  75 
C        6.   IF IFCONF=1, PUNCH CONFIGURATION TO BE INPUT (OR USE OUT- SP1  76 
C             PUT CONFIGURATION) ACCORDING TO FORMAT: 10F8.3.  THERE    SP1  77 
C             MUST BE NS+NR SETS OF CARDS, EACH SET OF WHICH SHOULD HAVESP1  78 
C             MAXD COORDINATES, OTHERWISE OMIT THIS SET WHEN IFCONF=0.  SP1  79 
C        7.   DATA (PUNCH LOWER-HALF OF THE SQUARE-SYMMETRIC MATRIX WITHSP1  80 
C             -OUT THE DIAGONAL ELEMENTS, STARTING A NEW ROW ON A NEW   SP1  81 
C             CARD.  IN TOTAL YOU SHOULD HAVE NS+NR-1 SETS OF CARDS WITHSP1  82 
C             1 ELEMENT IN THE FIRST SET FOR THE SECOND ROW, 2 ELEMENTS SP1  83 
C             IN THE SECOND SET FOR THE THIRD ROW,..., AND NS+NR-1 COEF-SP1  84 
C             FICIENTS IN THE LAST OR NS+NR-1'ST SET).  ALL ROWS MUST BESP1  85 
C             LEFT-ADJUSTED.  OMIT WHEN IFFIX=1.                        SP1  86 
C        8.   FOR EACH VARIABLE TO BE ADDED (WHEN IFFFIX=1) PUNCH NS+NR SP1  87 
C             COEFFICIENTS ON AS MANY CARDS AS NECESSARY TO SATISFY NS+ SP1  88 
C             NR ACCORDING TO THE FORMAT IN ITEM 5.  WHEN IFFIX=0, OMIT SP1  89 
C             THIS SET OF CARDS.                                        SP1  90 
C        9.   REPEAT ITEMS 3-8 FOR ADDITIONAL RUNS.  ONLY 1 RUN OF A    SP1  91 
C             FIXED CONFIGURATION CAN BE MADE AT A TIME AND THIS SHOULD SP1  92 
C             APPEAR AS THE LAST JOB RUN IN A DECK OF JOBS.             SP1  93 
C                                                                       SP1  94 
C     *** USERS OF THIS PROGRAM ARE EXPECTED TO PROPERLY CREDIT SOURCE  SP1  95 
C     FROM REFERENCES LISTED BELOW. ***                                 SP1  96 
C                                                                       SP1  97 
C     *** REFERENCES - GUTTMAN, L. A GENERAL NONMETRIC TECHNIQUE FOR    SP1  98 
C                                  FINDING THE SMALLEST COORDINATE SPACESP1  99 
C                                  FOR A CONFIGURATION OF POINTS.  PSY- SP1 100 
C                                  CHOMETRIKA, 1968, 33, 469-506.       SP1 101 
C                      LINGOES, J. C. A GENERAL NONPARAMETRIC MODEL FOR SP1 102 
C                                  REPRESENTING OBJECTS AND ATTRIBUTES  SP1 103 
C                                  IN A JOINT METRIC SPACE.  MULTIV.    SP1 104 
C                                  BEHAV. RES.,1969, 4,                 SP1 105 
C                      LINGOES, J. C.  AN IBM 360/67 PROGRAM FOR GUTTMANSP1 106 
C                                  -LINGOES SMALLEST SPACE ANALYSIS - PISP1 107 
C                                  BEHAV. SCI., 1969, 14,               SP1 108 
C                      LINGOES, J.C., ROSKAM, E.E.C.I., & GUTTMAN, L.   SP1 109 
C                                  AN EMPIRICAL STUDY OF TWO MULTIDIMEN-SP1 110 
C                                  SIONAL SCALING ALGORITHMS.  MULTIV.  SP1 111 
C                                  BEHAV. RES., 1969, 4,                SP1 112 
C                                                                       SP1 113 
C                                                                       SP1 114 
      DIMENSION RHO(100,100), RHO1(100,100), C(100,100), EVAL(10000), X(SP1 115 
     1101,10), X2(101,11), INDI(5050), INDJ(5050), DIST(5050), PHI(11), SP1 116 
     2FMT(18), PROX(5050), CMEAN(10), NOTIE1(998), NOTIE2(998), NOTIE3(9SP1 117 
     398)                                                               SP1 118 
      EQUIVALENCE (RHO1,C), (RHO,EVAL), (DIST,PROX)                     SP1 119 
C                                                                       SP1 120 
C     *** SUBROUTINES CALLED:  MXOUT, SORT, EIGEN, AND PLOT ***         SP1 121 
C     ***** USES SORT & EIGEN FROM SSA-I *****                                  
C     *** DUMMY SUBROUTINES:  COR3 & COR4 ***                           SP1 122 
C                                                                       SP1 123 
C     *** TAPE ASSIGNMENTS                                              SP1 124 
      ITAPE=5                                                           SP1 125 
      JTAPE=6                                                           SP1 126 
C     *** SUBROUTINE DIMENSIONING                                       SP1 127 
      MD=100                                                            SP1 128 
      LD=MD+1                                                           SP1 129 
      ND=11                                                             SP1 130 
C     READ IN TITLE, PARAMETERS, AND FORMAT                             SP1 131 
1     WRITE (JTAPE,210)                                                 SP1 132 
      READ (ITAPE,211)                                                  SP1 133 
      READ (ITAPE,212) NS,NR,MIND,MAXD,ISIM,IFD,IFC,IFCONF,IFFIX,IFSR   SP1 134 
      READ (ITAPE,213) (FMT(J),J=1,18)                                  SP1 135 
C     INITIALIZATION                                                    SP1 136 
      ISW=0                                                             SP1 137 
      NIT=5                                                             SP1 138 
      ITER=100                                                          SP1 139 
      NSP1=NS+1                                                         SP1 140 
      NSNR=NS+NR                                                        SP1 141 
      NSNRP1=NSNR+1                                                     SP1 142 
      FNR=NSNR                                                          SP1 143 
      IF (IFCONF) 2,7,2                                                 SP1 144 
C     INPUT CONFIGURATION                                               SP1 145 
2     DO 3 I=1,NSNR                                                     SP1 146 
3     READ (ITAPE,214) (X(I,J),J=1,MAXD)                                SP1 147 
C     SET COORDINATE MEANS TO ZERO                                      SP1 148 
      DO 6 J=1,MAXD                                                     SP1 149 
      CMEAN(J)=0.                                                       SP1 150 
      DO 4 I=1,NSNR                                                     SP1 151 
4     CMEAN(J)=CMEAN(J)+X(I,J)                                          SP1 152 
      CMEAN(J)=CMEAN(J)/FNR                                             SP1 153 
      DO 5 K=1,NSNR                                                     SP1 154 
5     X(K,J)=X(K,J)-CMEAN(J)                                            SP1 155 
6     CONTINUE                                                          SP1 156 
7     IF (IFFIX) 8,15,8                                                 SP1 157 
C     INITIALIZE FOR FIXED-CONFIGURATION OPTION                         SP1 158 
8     NEL1=NS                                                           SP1 159 
      NEL2=NR                                                           SP1 160 
      FNR=NSNRP1                                                        SP1 161 
      I1=NSP1                                                           SP1 162 
      I2=NSNR                                                           SP1 163 
      I4=I2                                                             SP1 164 
      IND=NS                                                            SP1 165 
      MIND=MAXD                                                         SP1 166 
      WRITE (JTAPE,211)                                                 SP1 167 
      WRITE (JTAPE,215) MAXD,(MM,MM=1,MAXD)                             SP1 168 
      WRITE (JTAPE,225)                                                 SP1 169 
      WRITE (JTAPE,216)                                                 SP1 170 
      WRITE (JTAPE,217)                                                 SP1 171 
C     INPUT COEFFICIENTS FOR ADDED VARIABLE                             SP1 172 
9     IF (IFSR) 10,11,10                                                SP1 173 
10    CALL COR4 (NSNR,FMT,PROX)                                         SP1 174 
      GO TO 12                                                          SP1 175 
11    READ (ITAPE,FMT) (PROX(J),J=1,NSNR)                               SP1 176 
12    DO 13 J=1,MAXD                                                    SP1 177 
13    X(101,J)=0.                                                       SP1 178 
      DO 14 J=1,NSNR                                                    SP1 179 
14    EVAL(J)=PROX(J)                                                   SP1 180 
      GO TO 23                                                          SP1 181 
C     INPUT SIMILARITIES/DISSIMILARITIES                                SP1 182 
15    IF (IFSR) 16,17,16                                                SP1 183 
16    CALL COR3 (MD,NS,NR,FMT,C,PROX,PROX(LD))                          SP1 184 
      GO TO 19                                                          SP1 185 
17    DO 18 I=2,NSNR                                                    SP1 186 
      IP1=I-1                                                           SP1 187 
18    READ (ITAPE,FMT) (C(I,J),J=1,IP1)                                 SP1 188 
19    NSM1=NS-1                                                         SP1 189 
      NSNRM1=NSNR-1                                                     SP1 190 
      JJ=0                                                              SP1 191 
      DO 20 I=1,NSM1                                                    SP1 192 
      IP1=I+1                                                           SP1 193 
      C(I,I)=0.                                                         SP1 194 
      DO 20 J=IP1,NS                                                    SP1 195 
      JJ=JJ+1                                                           SP1 196 
      PROX(JJ)=C(J,I)                                                   SP1 197 
20    EVAL(JJ)=PROX(JJ)                                                 SP1 198 
      C(NS,NS)=0.                                                       SP1 199 
      NEL1=JJ                                                           SP1 200 
      I1=JJ+1                                                           SP1 201 
      DO 21 J=1,NS                                                      SP1 202 
      DO 21 I=NSP1,NSNR                                                 SP1 203 
      JJ=JJ+1                                                           SP1 204 
      PROX(JJ)=C(I,J)                                                   SP1 205 
21    EVAL(JJ)=PROX(JJ)                                                 SP1 206 
      I2=JJ                                                             SP1 207 
      I3=JJ+1                                                           SP1 208 
      NEL2=JJ-NEL1                                                      SP1 209 
      DO 22 I=NSP1,NSNRM1                                               SP1 210 
      C(I,I)=0.                                                         SP1 211 
      IP1=I+1                                                           SP1 212 
      DO 22 J=IP1,NSNR                                                  SP1 213 
      JJ=JJ+1                                                           SP1 214 
      PROX(JJ)=C(J,I)                                                   SP1 215 
22    EVAL(JJ)=PROX(JJ)                                                 SP1 216 
      C(NSNR,NSNR)=0.                                                   SP1 217 
      I4=JJ                                                             SP1 218 
      NEL3=JJ-I2                                                        SP1 219 
      FNEL1=NEL1                                                        SP1 220 
      FNEL2=NEL2                                                        SP1 221 
      FNEL3=NEL3                                                        SP1 222 
      LFACT=MIND                                                        SP1 223 
C     PRINT OUT INPUT COEFFICIENTS                                      SP1 224 
      CALL MXOUT (RHO1,NSNR,0,MD)                                       SP1 225 
C     SORT SUBSCRIPTS OF INDI ACCORDING TO VALUES IN DIST AND DIREC-    SP1 226 
C     TION OF ISIM                                                      SP1 227 
      CALL SORT (0,NEL3,PROX(I3),ISIM,INDI(I3))                         SP1 228 
23    CALL SORT (ISW,NEL1,PROX,ISIM,INDI)                               SP1 229 
      CALL SORT (ISW,NEL2,PROX(I1),ISIM,INDI(I1))                       SP1 230 
      IF (IFFIX) 35,24,35                                               SP1 231 
C     SUBSTITUTE RANKS FOR SIMILARITIES/DISSIMILARITIES                 SP1 232 
24    S=0.                                                              SP1 233 
      DO 25 J=1,NEL1                                                    SP1 234 
      MM=INDI(J)                                                        SP1 235 
      S=S+1.                                                            SP1 236 
25    PROX(MM)=S                                                        SP1 237 
      S=0.                                                              SP1 238 
      DO 26 J=I1,I2                                                     SP1 239 
      MM=INDI(J)+NEL1                                                   SP1 240 
      S=S+1.                                                            SP1 241 
26    PROX(MM)=S                                                        SP1 242 
      S=0.                                                              SP1 243 
      DO 27 J=I3,I4                                                     SP1 244 
      MM=INDI(J)+I2                                                     SP1 245 
      S=S+1.                                                            SP1 246 
27    PROX(MM)=S                                                        SP1 247 
C     CHECK FOR TIES IN INPUT VALUES                                    SP1 248 
      NOTIE3(1)=0                                                       SP1 249 
      J=I3                                                              SP1 250 
      II=-1                                                             SP1 251 
      K=J                                                               SP1 252 
      NT3=0                                                             SP1 253 
28    LL=1                                                              SP1 254 
      MM=INDI(J)+I2                                                     SP1 255 
      D1=PROX(MM)                                                       SP1 256 
29    K=K+1                                                             SP1 257 
      NN=INDI(K)+I2                                                     SP1 258 
      IF (EVAL(MM)-EVAL(NN)) 31,30,31                                   SP1 259 
30    LL=LL+1                                                           SP1 260 
      D1=D1+PROX(NN)                                                    SP1 261 
      IF (K-I4) 29,32,29                                                SP1 262 
31    IF (LL-1) 32,34,32                                                SP1 263 
32    II=II+2                                                           SP1 264 
      NT3=NT3+2                                                         SP1 265 
C     *** IF NOTIE3 IS RE-DIMENSIONED, ALSO ADJUST FOLLOWING TEST       SP1 266 
      IF (NT3.GT.998) GO TO 207                                         SP1 267 
      NOTIE3(II)=LL                                                     SP1 268 
      NOTIE3(II+1)=J                                                    SP1 269 
      D1=D1/FLOAT(LL)                                                   SP1 270 
      JJ=J                                                              SP1 271 
      DO 33 KK=1,LL                                                     SP1 272 
      MM=INDI(JJ)+I2                                                    SP1 273 
      PROX(MM)=D1                                                       SP1 274 
33    JJ=JJ+1                                                           SP1 275 
34    J=K                                                               SP1 276 
      IF (J-I4) 28,35,28                                                SP1 277 
35    NOTIE1(1)=0                                                       SP1 278 
      J=1                                                               SP1 279 
      II=-1                                                             SP1 280 
      K=J                                                               SP1 281 
      NT1=0                                                             SP1 282 
36    LL=1                                                              SP1 283 
      MM=INDI(J)                                                        SP1 284 
      D1=PROX(MM)                                                       SP1 285 
37    K=K+1                                                             SP1 286 
      NN=INDI(K)                                                        SP1 287 
      IF (EVAL(MM)-EVAL(NN)) 39,38,39                                   SP1 288 
38    LL=LL+1                                                           SP1 289 
      D1=D1+PROX(NN)                                                    SP1 290 
      IF (K-NEL1) 37,40,37                                              SP1 291 
39    IF (LL-1) 40,43,40                                                SP1 292 
40    II=II+2                                                           SP1 293 
      NT1=NT1+2                                                         SP1 294 
C     *** IF NOTIE1 IS RE-DIMENSIONED, ALSO ADJUST FOLLOWING TEST       SP1 295 
      IF (NT1.GT.998) GO TO 207                                         SP1 296 
      NOTIE1(II)=LL                                                     SP1 297 
      NOTIE1(II+1)=J                                                    SP1 298 
      IF (IFFIX) 43,41,43                                               SP1 299 
41    D1=D1/FLOAT(LL)                                                   SP1 300 
      JJ=J                                                              SP1 301 
      DO 42 KK=1,LL                                                     SP1 302 
      MM=INDI(JJ)                                                       SP1 303 
      PROX(MM)=D1                                                       SP1 304 
42    JJ=JJ+1                                                           SP1 305 
43    J=K                                                               SP1 306 
      IF (J-NEL1) 36,44,36                                              SP1 307 
44    NOTIE2(1)=0                                                       SP1 308 
      J=I1                                                              SP1 309 
      II=-1                                                             SP1 310 
      K=J                                                               SP1 311 
      NT2=0                                                             SP1 312 
45    LL=1                                                              SP1 313 
      MM=INDI(J)+NEL1                                                   SP1 314 
      D1=PROX(MM)                                                       SP1 315 
46    K=K+1                                                             SP1 316 
      NN=INDI(K)+NEL1                                                   SP1 317 
      IF (EVAL(MM)-EVAL(NN)) 48,47,48                                   SP1 318 
47    LL=LL+1                                                           SP1 319 
      D1=D1+PROX(NN)                                                    SP1 320 
      IF (K-I2) 46,49,46                                                SP1 321 
48    IF (LL-1) 49,52,49                                                SP1 322 
49    II=II+2                                                           SP1 323 
      NT2=NT2+2                                                         SP1 324 
C     *** IF NOTIE2 IS RE-DIMENSIONED, ALSO ADJUST FOLLOWING TEST       SP1 325 
      IF (NT2.GT.998) GO TO 207                                         SP1 326 
      NOTIE2(II)=LL                                                     SP1 327 
      NOTIE2(II+1)=J                                                    SP1 328 
      IF (IFFIX) 52,50,52                                               SP1 329 
50    D1=D1/FLOAT(LL)                                                   SP1 330 
      JJ=J                                                              SP1 331 
      DO 51 KK=1,LL                                                     SP1 332 
      MM=INDI(JJ)+NEL1                                                  SP1 333 
      PROX(MM)=D1                                                       SP1 334 
51    JJ=JJ+1                                                           SP1 335 
52    J=K                                                               SP1 336 
      IF (J-I2) 45,53,45                                                SP1 337 
53    IF (IFFIX+IFCONF) 69,54,69                                        SP1 338 
C     FORM C-MATRIX BASED ON RANKS                                      SP1 339 
54    II=0                                                              SP1 340 
      DO 55 I=1,NSM1                                                    SP1 341 
      IP1=I+1                                                           SP1 342 
      DO 55 J=IP1,NS                                                    SP1 343 
      II=II+1                                                           SP1 344 
      RHO1(I,J)=1.-PROX(II)/FNEL1                                       SP1 345 
55    RHO1(J,I)=RHO1(I,J)                                               SP1 346 
      DO 56 I=1,NS                                                      SP1 347 
      DO 56 J=NSP1,NSNR                                                 SP1 348 
      II=II+1                                                           SP1 349 
      RHO1(I,J)=1.-PROX(II)/FNEL2                                       SP1 350 
56    RHO1(J,I)=RHO1(I,J)                                               SP1 351 
      DO 57 I=NSP1,NSNRM1                                               SP1 352 
      IP1=I+1                                                           SP1 353 
      DO 57 J=IP1,NSNR                                                  SP1 354 
      II=II+1                                                           SP1 355 
      RHO1(I,J)=1.-PROX(II)/FNEL3                                       SP1 356 
57    RHO1(J,I)=RHO1(I,J)                                               SP1 357 
      DO 60 I=1,NSNR                                                    SP1 358 
      RHO1(I,I)=FNR                                                     SP1 359 
      DO 59 J=1,NSNR                                                    SP1 360 
      IF (I-J) 58,59,58                                                 SP1 361 
58    RHO1(I,I)=RHO1(I,I)-RHO1(I,J)                                     SP1 362 
59    CONTINUE                                                          SP1 363 
60    CONTINUE                                                          SP1 364 
C     OBTAIN INITIAL CONFIGURATION                                      SP1 365 
C     CALL HOUSEHOLDER SUBROUTINE                                       SP1 366 
      KK=MAXD+1                                                         SP1 367 
      CALL EIGEN (C,RHO,NSNR,PHI,KK,MD,X(1,1),X(1,4),X(1,5),X(1,6),X(1,7SP1 368 
     1),X(1,8),1)                                                       SP1 369 
      DO 61 J=2,KK                                                      SP1 370 
      PHI(J-1)=PHI(J)                                                   SP1 371 
      DO 61 I=1,NSNR                                                    SP1 372 
61    X(I,J-1)=RHO(I,J)                                                 SP1 373 
C     DETERMINE WHETHER TO GO UP OR DOWN                                SP1 374 
      IF (MIND) 69,62,69                                                SP1 375 
62    DIM=FNR/2.+1./(FNR-1.)                                            SP1 376 
      KK=0                                                              SP1 377 
      DO 64 J=1,MAXD                                                    SP1 378 
      IF (PHI(J)-DIM) 65,63,63                                          SP1 379 
63    KK=KK+1                                                           SP1 380 
64    CONTINUE                                                          SP1 381 
65    IF (KK) 67,66,67                                                  SP1 382 
66    MAXD=1                                                            SP1 383 
      GO TO 68                                                          SP1 384 
67    MAXD=KK                                                           SP1 385 
68    MIND=MAXD                                                         SP1 386 
      ITER=25                                                           SP1 387 
69    M=MIND-1                                                          SP1 388 
      ASSIGN 86 TO N1                                                   SP1 389 
C     INITIALIZATION                                                    SP1 390 
70    M=M+1                                                             SP1 391 
      IF (M.EQ.1) NIT=1                                                 SP1 392 
      STRLST=1.                                                         SP1 393 
      IFBU=0                                                            SP1 394 
      NN=0                                                              SP1 395 
      II=5                                                              SP1 396 
71    ITCT=0                                                            SP1 397 
72    NN=NN+1                                                           SP1 398 
C     CALCULATE DISTANCES                                               SP1 399 
73    IF (IFFIX) 74,77,74                                               SP1 400 
74    DO 76 I=1,NSNR                                                    SP1 401 
      DIST(I)=0.                                                        SP1 402 
      DO 75 J=1,M                                                       SP1 403 
75    DIST(I)=DIST(I)+(X(I,J)-X(101,J))**2                              SP1 404 
76    DIST(I)=SQRT(DIST(I))                                             SP1 405 
      GO TO 84                                                          SP1 406 
77    JJ=0                                                              SP1 407 
      DO 79 I=1,NSM1                                                    SP1 408 
      IP1=I+1                                                           SP1 409 
      DO 79 J=IP1,NS                                                    SP1 410 
      JJ=JJ+1                                                           SP1 411 
      DIST(JJ)=0.                                                       SP1 412 
      DO 78 K=1,M                                                       SP1 413 
78    DIST(JJ)=DIST(JJ)+(X(I,K)-X(J,K))**2                              SP1 414 
79    DIST(JJ)=SQRT(DIST(JJ))                                           SP1 415 
      DO 81 I=1,NS                                                      SP1 416 
      DO 81 J=NSP1,NSNR                                                 SP1 417 
      JJ=JJ+1                                                           SP1 418 
      DIST(JJ)=0.                                                       SP1 419 
      DO 80 K=1,M                                                       SP1 420 
80    DIST(JJ)=DIST(JJ)+(X(I,K)-X(J,K))**2                              SP1 421 
81    DIST(JJ)=SQRT(DIST(JJ))                                           SP1 422 
      DO 83 I=NSP1,NSNRM1                                               SP1 423 
      IP1=I+1                                                           SP1 424 
      DO 83 J=IP1,NSNR                                                  SP1 425 
      JJ=JJ+1                                                           SP1 426 
      DIST(JJ)=0.                                                       SP1 427 
      DO 82 K=1,M                                                       SP1 428 
82    DIST(JJ)=DIST(JJ)+(X(I,K)-X(J,K))**2                              SP1 429 
83    DIST(JJ)=SQRT(DIST(JJ))                                           SP1 430 
84    IF (ITCT) 134,85,134                                              SP1 431 
85    GO TO N1, (86,89)                                                 SP1 432 
C     SORT DISTANCES LOW TO HIGH                                        SP1 433 
86    IF (IFFIX) 88,87,88                                               SP1 434 
87    CALL SORT (0,NEL3,DIST(I3),0,INDJ(I3))                            SP1 435 
88    CALL SORT (0,NEL1,DIST,0,INDJ)                                    SP1 436 
      CALL SORT (0,NEL2,DIST(I1),0,INDJ(I1))                            SP1 437 
      ASSIGN 89 TO N1                                                   SP1 438 
      GO TO 92                                                          SP1 439 
89    IF (IFFIX) 91,90,91                                               SP1 440 
90    CALL SORT (1,NEL3,DIST(I3),0,INDJ(I3))                            SP1 441 
91    CALL SORT (1,NEL1,DIST,0,INDJ)                                    SP1 442 
      CALL SORT (1,NEL2,DIST(I1),0,INDJ(I1))                            SP1 443 
C     IF TIES EXIST IN INPUT, OPTIMALLY PERMUTE INDICES OF INDI TO      SP1 444 
C     CONFORM WITH ORDER OF CORRESPONDING DISTANCES.  PRIMARY APPROACH. SP1 445 
92    IF (IFFIX) 96,93,96                                               SP1 446 
93    IF (NOTIE3(1)) 94,96,94                                           SP1 447 
94    DO 95 J=1,NT3,2                                                   SP1 448 
      KK=NOTIE3(J)                                                      SP1 449 
      LL=NOTIE3(J+1)                                                    SP1 450 
95    CALL SORT (1,KK,DIST(I3),0,INDI(LL))                              SP1 451 
96    IF (NOTIE1(1)) 97,99,97                                           SP1 452 
97    DO 98 J=1,NT1,2                                                   SP1 453 
      KK=NOTIE1(J)                                                      SP1 454 
      LL=NOTIE1(J+1)                                                    SP1 455 
98    CALL SORT (1,KK,DIST,0,INDI(LL))                                  SP1 456 
99    IF (NOTIE2(1)) 100,102,100                                        SP1 457 
100   DO 101 J=1,NT2,2                                                  SP1 458 
      KK=NOTIE2(J)                                                      SP1 459 
      LL=NOTIE2(J+1)                                                    SP1 460 
101   CALL SORT (1,KK,DIST(I1),0,INDI(LL))                              SP1 461 
C     CELL-WISE PERMUTE D TO D* (RANK-IMAGES)                           SP1 462 
102   S=0.                                                              SP1 463 
      STR3=0.                                                           SP1 464 
      IF (IFFIX) 106,103,106                                            SP1 465 
103   DO 104 I=I3,I4                                                    SP1 466 
104   EVAL(INDI(I)+I2)=DIST(INDJ(I)+I2)                                 SP1 467 
      DO 105 I=I3,I4                                                    SP1 468 
      S=S+DIST(I)**2                                                    SP1 469 
105   STR3=STR3+DIST(I)*EVAL(I)                                         SP1 470 
106   DO 107 I=1,NEL1                                                   SP1 471 
107   EVAL(INDI(I))=DIST(INDJ(I))                                       SP1 472 
      DO 108 I=I1,I2                                                    SP1 473 
108   EVAL(INDI(I)+NEL1)=DIST(INDJ(I)+NEL1)                             SP1 474 
C     CALCULATE NORMALIZED PHI                                          SP1 475 
      STRESS=0.                                                         SP1 476 
      D1=0.                                                             SP1 477 
      DO 109 I=1,NEL1                                                   SP1 478 
      D1=D1+DIST(I)**2                                                  SP1 479 
109   STRESS=STRESS+DIST(I)*EVAL(I)                                     SP1 480 
      STR1=STRESS/D1                                                    SP1 481 
      D1=D1+S                                                           SP1 482 
      STRESS=STRESS+STR3                                                SP1 483 
      STR3=STR3/S                                                       SP1 484 
      S=0.                                                              SP1 485 
      STR2=0.                                                           SP1 486 
      DO 110 I=I1,I2                                                    SP1 487 
      S=S+DIST(I)**2                                                    SP1 488 
110   STR2=STR2+DIST(I)*EVAL(I)                                         SP1 489 
      D1=D1+S                                                           SP1 490 
      STRESS=STRESS+STR2                                                SP1 491 
      STR2=STR2/S                                                       SP1 492 
      STRESS=1.-STRESS/D1                                               SP1 493 
      IF (STRESS.GT.STRLST) GO TO 116                                   SP1 494 
C     SAVE BEST CONFIGURATION                                           SP1 495 
      IF (IFFIX) 111,113,111                                            SP1 496 
111   DO 112 J=1,MAXD                                                   SP1 497 
112   X2(101,J)=X(101,J)                                                SP1 498 
      GO TO 115                                                         SP1 499 
113   DO 114 I=1,NSNR                                                   SP1 500 
      DO 114 J=1,M                                                      SP1 501 
114   X2(I,J)=X(I,J)                                                    SP1 502 
      SWO=STR1                                                          SP1 503 
      SBOA=STR2                                                         SP1 504 
      SWA=STR3                                                          SP1 505 
115   STRLST=STRESS                                                     SP1 506 
C     TEST FOR TERMINATION                                              SP1 507 
116   IF (STRESS.LT..000001) GO TO 168                                  SP1 508 
      IF (NN.GE.6) GO TO 117                                            SP1 509 
      PHI(NN)=STRESS                                                    SP1 510 
      GO TO 127                                                         SP1 511 
117   IF (II.EQ.5) II=0                                                 SP1 512 
      II=II+1                                                           SP1 513 
      IF (STRESS.LE.PHI(II)) GO TO 124                                  SP1 514 
      IFBU=IFBU+1                                                       SP1 515 
C     RESTORE BEST CONFIGURATION                                        SP1 516 
118   IF (IFFIX) 119,121,119                                            SP1 517 
119   DO 120 J=1,MAXD                                                   SP1 518 
120   X(101,J)=X2(101,J)                                                SP1 519 
      GO TO 123                                                         SP1 520 
121   DO 122 I=1,NSNR                                                   SP1 521 
      DO 122 J=1,M                                                      SP1 522 
122   X(I,J)=X2(I,J)                                                    SP1 523 
      STR1=SWO                                                          SP1 524 
      STR2=SBOA                                                         SP1 525 
      STR3=SWA                                                          SP1 526 
123   STRESS=STRLST                                                     SP1 527 
      IF (IFBU.EQ.2) GO TO 168                                          SP1 528 
      II=II-1                                                           SP1 529 
      GO TO 71                                                          SP1 530 
124   IF (NN-ITER) 126,125,126                                          SP1 531 
125   IFBU=2                                                            SP1 532 
      GO TO 118                                                         SP1 533 
126   PHI(II)=STRESS                                                    SP1 534 
127   IF (IFBU-1) 134,128,134                                           SP1 535 
C     SWITCH TO SINGLE-PHASE ALGORITHM (RANK-IMAGES)                    SP1 536 
128   IF (IFFIX) 131,129,131                                            SP1 537 
129   DO 130 J=I3,I4                                                    SP1 538 
130   EVAL(INDJ(J)+I2)=(DIST(INDI(J)+I2)+EVAL(INDJ(J)+I2))/2.           SP1 539 
131   DO 132 J=1,NEL1                                                   SP1 540 
132   EVAL(INDJ(J))=(DIST(INDI(J))+EVAL(INDJ(J)))/2.                    SP1 541 
      DO 133 J=I1,I2                                                    SP1 542 
133   EVAL(INDJ(J)+NEL1)=(DIST(INDI(J)+NEL1)+EVAL(INDJ(J)+NEL1))/2.     SP1 543 
134   IF (IFFIX) 135,144,135                                            SP1 544 
C     DETERMINE CORRECTIONS FOR ADDED VARIABLE                          SP1 545 
135   DO 140 I=1,NSNR                                                   SP1 546 
      IF (EVAL(I)+DIST(I)) 137,136,137                                  SP1 547 
136   X2(I,11)=0.                                                       SP1 548 
      GO TO 140                                                         SP1 549 
137   IF (DIST(I)) 139,138,139                                          SP1 550 
138   X2(I,11)=1.-EVAL(I)/.0001                                         SP1 551 
      GO TO 140                                                         SP1 552 
139   X2(I,11)=1.-EVAL(I)/DIST(I)                                       SP1 553 
140   CONTINUE                                                          SP1 554 
      X2(101,11)=FNR                                                    SP1 555 
      DO 141 I=1,NSNR                                                   SP1 556 
141   X2(101,11)=X2(101,11)-X2(I,11)                                    SP1 557 
C     MODIFY COORDINATES OF ADDED VARIABLE                              SP1 558 
      DO 143 J=1,MAXD                                                   SP1 559 
      X2(101,J)=0.                                                      SP1 560 
      DO 142 I=1,NSNR                                                   SP1 561 
142   X2(101,J)=X2(101,J)+X(I,J)*X2(I,11)                               SP1 562 
      X2(101,J)=(X2(101,J)+X(101,J)*X2(101,11))/FNR                     SP1 563 
143   X(101,J)=X2(101,J)                                                SP1 564 
      GO TO 166                                                         SP1 565 
C     COMPUTE C-MATRIX                                                  SP1 566 
144   JJ=0                                                              SP1 567 
      DO 149 I=1,NSM1                                                   SP1 568 
      IP1=I+1                                                           SP1 569 
      DO 149 J=IP1,NS                                                   SP1 570 
      JJ=JJ+1                                                           SP1 571 
      IF (DIST(JJ)+EVAL(JJ)) 146,145,146                                SP1 572 
145   C(I,J)=0.                                                         SP1 573 
      GO TO 149                                                         SP1 574 
146   IF (DIST(JJ)) 148,147,148                                         SP1 575 
147   C(I,J)=1.-EVAL(JJ)/.0001                                          SP1 576 
      GO TO 149                                                         SP1 577 
148   C(I,J)=1.-EVAL(JJ)/DIST(JJ)                                       SP1 578 
149   C(J,I)=C(I,J)                                                     SP1 579 
      DO 154 I=1,NS                                                     SP1 580 
      DO 154 J=NSP1,NSNR                                                SP1 581 
      JJ=JJ+1                                                           SP1 582 
      IF (DIST(JJ)+EVAL(JJ)) 151,150,151                                SP1 583 
150   C(I,J)=0.                                                         SP1 584 
      GO TO 154                                                         SP1 585 
151   IF (DIST(JJ)) 153,152,153                                         SP1 586 
152   C(I,J)=1.-EVAL(JJ)/.0001                                          SP1 587 
      GO TO 154                                                         SP1 588 
153   C(I,J)=1.-EVAL(JJ)/DIST(JJ)                                       SP1 589 
154   C(J,I)=C(I,J)                                                     SP1 590 
      DO 159 I=NSP1,NSNRM1                                              SP1 591 
      IP1=I+1                                                           SP1 592 
      DO 159 J=IP1,NSNR                                                 SP1 593 
      JJ=JJ+1                                                           SP1 594 
      IF (DIST(JJ)+EVAL(JJ)) 156,155,156                                SP1 595 
155   C(I,J)=0.                                                         SP1 596 
      GO TO 159                                                         SP1 597 
156   IF (DIST(JJ)) 158,157,158                                         SP1 598 
157   C(I,J)=1.-EVAL(JJ)/.0001                                          SP1 599 
      GO TO 159                                                         SP1 600 
158   C(I,J)=1.-EVAL(JJ)/DIST(JJ)                                       SP1 601 
159   C(J,I)=C(I,J)                                                     SP1 602 
      DO 162 I=1,NSNR                                                   SP1 603 
      C(I,I)=FNR                                                        SP1 604 
      DO 161 J=1,NSNR                                                   SP1 605 
      IF (I-J) 160,161,160                                              SP1 606 
160   C(I,I)=C(I,I)-C(I,J)                                              SP1 607 
161   CONTINUE                                                          SP1 608 
162   CONTINUE                                                          SP1 609 
C     APPLY CORRECTIONS TO X                                            SP1 610 
      DO 165 K=1,M                                                      SP1 611 
      DO 164 I=1,NSNR                                                   SP1 612 
      X2(I,11)=0.                                                       SP1 613 
      DO 163 J=1,NSNR                                                   SP1 614 
163   X2(I,11)=X2(I,11)+X(J,K)*C(I,J)                                   SP1 615 
164   X2(I,11)=X2(I,11)/FNR                                             SP1 616 
      DO 165 L=1,NSNR                                                   SP1 617 
165   X(L,K)=X2(L,11)                                                   SP1 618 
166   IF (IFBU) 72,167,72                                               SP1 619 
C     TEST FOR TERMINATION OF PHASE-I ITERATIONS                        SP1 620 
167   ITCT=ITCT+1                                                       SP1 621 
      IF (NIT-ITCT) 73,71,73                                            SP1 622 
168   STRESS=SQRT(1.-(1.-STRESS)**2)                                    SP1 623 
      IF (IFFIX) 208,169,208                                            SP1 624 
169   WRITE (JTAPE,211)                                                 SP1 625 
      WRITE (JTAPE,215) M,(MM,MM=1,M)                                   SP1 626 
      WRITE (JTAPE,216)                                                 SP1 627 
      IF (M-1) 170,175,170                                              SP1 628 
C     PERFORM PRINCIPAL AXIS ROTATION                                   SP1 629 
170   DO 172 I=1,M                                                      SP1 630 
      DO 172 J=I,M                                                      SP1 631 
      C(I,J)=0.                                                         SP1 632 
      DO 171 K=1,NSNR                                                   SP1 633 
171   C(I,J)=C(I,J)+X(K,I)*X(K,J)                                       SP1 634 
172   C(J,I)=C(I,J)                                                     SP1 635 
C     CALL HOUSEHOLDER SUBROUTINE                                       SP1 636 
      CALL EIGEN (C,RHO,M,PHI,M,MD,X2(1,1),X2(1,4),X2(1,5),X2(1,6),X2(1,SP1 637 
     17),X2(1,8),0)                                                     SP1 638 
      DO 174 I=1,NSNR                                                   SP1 639 
      DO 173 J=1,M                                                      SP1 640 
      X2(I,J)=0.                                                        SP1 641 
      DO 173 K=1,M                                                      SP1 642 
173   X2(I,J)=X2(I,J)+X(I,K)*RHO(K,J)                                   SP1 643 
      DO 174 L=1,M                                                      SP1 644 
174   X(I,L)=X2(I,L)                                                    SP1 645 
C     NORMALIZE COORDINATES TO LIE IN RANGE OF +1 TO -1                 SP1 646 
175   DIM=0.                                                            SP1 647 
      DO 177 K=1,M                                                      SP1 648 
      RHO(1,K)=0.                                                       SP1 649 
      RHO(2,K)=0.                                                       SP1 650 
      DO 176 I=1,NSNR                                                   SP1 651 
      RHO(1,K)=AMIN1(RHO(1,K),X(I,K))                                   SP1 652 
176   RHO(2,K)=AMAX1(RHO(2,K),X(I,K))                                   SP1 653 
177   DIM=AMAX1(DIM,(RHO(2,K)-RHO(1,K)))                                SP1 654 
      DIM=2./DIM                                                        SP1 655 
      DO 178 K=1,M                                                      SP1 656 
      DO 178 I=1,NSNR                                                   SP1 657 
178   X2(I,K)=DIM*(X(I,K)-RHO(1,K))-1.                                  SP1 658 
C     COMPUTE CENTRALITY INDEX, I.E., DISTANCE FROM TRUE ORIGIN         SP1 659 
      MM=M+1                                                            SP1 660 
      DO 180 I=1,NSNR                                                   SP1 661 
      X2(I,MM)=0.                                                       SP1 662 
      DO 179 K=1,M                                                      SP1 663 
179   X2(I,MM)=X2(I,MM)+X(I,K)**2                                       SP1 664 
      X2(I,MM)=DIM*(SQRT(X2(I,MM)))                                     SP1 665 
180   CONTINUE                                                          SP1 666 
C     PRINT OUT FINAL CONFIGURATION                                     SP1 667 
      WRITE (JTAPE,217)                                                 SP1 668 
      DO 181 I=1,NS                                                     SP1 669 
181   WRITE (JTAPE,219) I,(X2(I,K),K=1,MM)                              SP1 670 
      WRITE (JTAPE,218)                                                 SP1 671 
      DO 182 I=NSP1,NSNR                                                SP1 672 
182   WRITE (JTAPE,219) I,(X2(I,K),K=1,MM)                              SP1 673 
      WRITE (JTAPE,220) STRESS,NN                                       SP1 674 
      IF (LFACT.EQ.0.AND.M.GT.1) GO TO 200                              SP1 675 
183   IF (M-1) 184,206,184                                              SP1 676 
C     CALL ON PLOT SUBROUTINE                                           SP1 677 
184   CALL PLOT (X2,RHO(1,1),RHO(1,2),RHO(1,3),RHO(1,4),RHO(1,5),NSNR,M,SP1 678 
     1LD,ND)                                                            SP1 679 
C     RESCALE COORDINATES WITHIN OBJECTS AND WITHIN ATTRIBUTES          SP1 680 
      S=0.                                                              SP1 681 
      DO 186 K=1,M                                                      SP1 682 
      RHO(1,K)=10000.                                                   SP1 683 
      RHO(2,K)=-10000.                                                  SP1 684 
      DO 185 I=1,NS                                                     SP1 685 
      RHO(1,K)=AMIN1(RHO(1,K),X(I,K))                                   SP1 686 
185   RHO(2,K)=AMAX1(RHO(2,K),X(I,K))                                   SP1 687 
186   S=AMAX1(S,(RHO(2,K)-RHO(1,K)))                                    SP1 688 
      S=2./S                                                            SP1 689 
      DO 187 K=1,M                                                      SP1 690 
      DO 187 I=1,NS                                                     SP1 691 
187   X2(I,K)=S*(X(I,K)-RHO(1,K))-1.                                    SP1 692 
      WRITE (JTAPE,211)                                                 SP1 693 
      WRITE (JTAPE,221) (MM,MM=1,M)                                     SP1 694 
      WRITE (JTAPE,216)                                                 SP1 695 
      WRITE (JTAPE,217)                                                 SP1 696 
      DO 188 I=1,NS                                                     SP1 697 
188   WRITE (JTAPE,219) I,(X2(I,K),K=1,M)                               SP1 698 
      STR1=SQRT(1.-STR1**2)                                             SP1 699 
      WRITE (JTAPE,222) STR1                                            SP1 700 
      CALL PLOT (X2,RHO(1,1),RHO(1,2),RHO(1,3),RHO(1,4),RHO(1,5),NS,M,LDSP1 701 
     1,ND)                                                              SP1 702 
      S=0.                                                              SP1 703 
      DO 190 K=1,M                                                      SP1 704 
      RHO(1,K)=10000.                                                   SP1 705 
      RHO(2,K)=-10000.                                                  SP1 706 
      DO 189 I=NSP1,NSNR                                                SP1 707 
      RHO(1,K)=AMIN1(RHO(1,K),X(I,K))                                   SP1 708 
189   RHO(2,K)=AMAX1(RHO(2,K),X(I,K))                                   SP1 709 
190   S=AMAX1(S,(RHO(2,K)-RHO(1,K)))                                    SP1 710 
      S=2./S                                                            SP1 711 
      DO 191 K=1,M                                                      SP1 712 
      DO 191 I=NSP1,NSNR                                                SP1 713 
191   X2(I-NS,K)=S*(X(I,K)-RHO(1,K))-1.                                 SP1 714 
      WRITE (JTAPE,211)                                                 SP1 715 
      WRITE (JTAPE,221) (MM,MM=1,M)                                     SP1 716 
      WRITE (JTAPE,216)                                                 SP1 717 
      WRITE (JTAPE,218)                                                 SP1 718 
      DO 192 I=1,NR                                                     SP1 719 
192   WRITE (JTAPE,219) I,(X2(I,K),K=1,M)                               SP1 720 
      STR3=SQRT(1.-STR3**2)                                             SP1 721 
      WRITE (JTAPE,223) STR3                                            SP1 722 
      STR2=SQRT(1.-STR2**2)                                             SP1 723 
      WRITE (JTAPE,224) STR2                                            SP1 724 
      CALL PLOT (X2,RHO(1,1),RHO(1,2),RHO(1,3),RHO(1,4),RHO(1,5),NR,M,LDSP1 725 
     1,ND)                                                              SP1 726 
      IF (NN.LT.ITER) GO TO 193                                         SP1 727 
      WRITE (JTAPE,228)                                                 SP1 728 
      GO TO 194                                                         SP1 729 
193   IF (IFC) 194,196,194                                              SP1 730 
C     PUNCH COORDINATES                                                 SP1 731 
194   DO 195 I=1,NSNR                                                   SP1 732 
195   PUNCH 214, (X(I,J),J=1,M)                                         SP1 733 
196   IF (IFD) 197,206,197                                              SP1 734 
C     COMPUTE FINAL DISTANCES                                           SP1 735 
197   DO 199 I=1,NSNRM1                                                 SP1 736 
      IP1=I+1                                                           SP1 737 
      C(I,I)=0.                                                         SP1 738 
      DO 199 J=IP1,NSNR                                                 SP1 739 
      C(J,I)=0.                                                         SP1 740 
      DO 198 K=1,M                                                      SP1 741 
198   C(J,I)=C(J,I)+(X(I,K)-X(J,K))**2                                  SP1 742 
199   C(J,I)=SQRT(C(J,I))*DIM                                           SP1 743 
      C(NSNR,NSNR)=0.                                                   SP1 744 
      CALL MXOUT (C,NSNR,1,MD)                                          SP1 745 
      GO TO 206                                                         SP1 746 
C     DETERMINE HOW MANY DIMENSIONS TO DROP WHEN MIND=0                 SP1 747 
200   KK=1                                                              SP1 748 
      MM=M                                                              SP1 749 
      DO 201 J=2,MM                                                     SP1 750 
      IF (PHI(J)/PHI(1).LE..3) GO TO 202                                SP1 751 
      KK=KK+1                                                           SP1 752 
201   CONTINUE                                                          SP1 753 
202   M=KK-1                                                            SP1 754 
      MAXD=KK                                                           SP1 755 
      IF (ITER-100) 203,204,203                                         SP1 756 
203   ITER=ITER+25                                                      SP1 757 
204   IF (MM-KK) 70,205,70                                              SP1 758 
205   M=M+1                                                             SP1 759 
      GO TO 183                                                         SP1 760 
C     TEST FOR END                                                      SP1 761 
206   IF (STRESS.LE..0001) GO TO 1                                      SP1 762 
      IF (M-MAXD) 70,1,70                                               SP1 763 
207   WRITE (JTAPE,227)                                                 SP1 764 
      GO TO 1                                                           SP1 765 
C     PRINT COORDINATES OF ADDED VARIABLE                               SP1 766 
208   IND=IND+1                                                         SP1 767 
      DO 209 J=1,MAXD                                                   SP1 768 
209   X(101,J)=X(101,J)+CMEAN(J)                                        SP1 769 
      WRITE (JTAPE,219) IND,(X(101,J),J=1,MAXD)                         SP1 770 
      ISW=1                                                             SP1 771 
      WRITE (JTAPE,226) STRESS,NN                                       SP1 772 
      GO TO 9                                                           SP1 773 
C     *** FORMAT STATEMENTS ***                                         SP1 774 
C                                                                       SP1 775 
210   FORMAT ('1')                                                      SP1 776 
211   FORMAT (72H                                                       SP1 777 
     1                 )                                                SP1 778 
212   FORMAT (10I4)                                                     SP1 779 
213   FORMAT (18A4)                                                     SP1 780 
214   FORMAT (10F8.3)                                                   SP1 781 
215   FORMAT ('0GUTTMAN-LINGOES'' SMALLEST SPACE COORDINATES FOR M =',I3SP1 782 
     1,' (SEMI-STRONG MONOTONICITY).'/'0DIMENSION',10I10)               SP1 783 
216   FORMAT (1H ,130(1H-))                                             SP1 784 
217   FORMAT ('0 OBJECT')                                               SP1 785 
218   FORMAT ('0ATTRIBUTE')                                             SP1 786 
219   FORMAT (I5,5X2P11F10.3)                                           SP1 787 
220   FORMAT ('0GUTTMAN-LINGOES'' COEFFICIENT OF ALIENATION =',F8.5,' INSP1 788 
     1',I4,' ITERATIONS.')                                              SP1 789 
221   FORMAT ('0RE-SCALED COORDINATES WITHIN OBJECTS/ATTRIBUTES'/'0DIMENSP1 790 
     1SION',10I10)                                                      SP1 791 
222   FORMAT ('0G-L''S K FOR WITHIN-OBJECTS FIT =',F8.5)                SP1 792 
223   FORMAT ('0G-L''S K FOR WITHIN-ATTRIBUTES FIT =',F8.5)             SP1 793 
224   FORMAT ('0G-L''S K FOR BETWEEN OBJECTS & ATTRIBUTES FIT =',F8.5)  SP1 794 
225   FORMAT ('+',111X,'G-L''S K  ITERATIONS')                          SP1 795 
226   FORMAT ('+',109XF9.5,I8)                                          SP1 796 
227   FORMAT ('1***** YOU HAVE MORE THAN 499 TIED BLOCKS.  ADJUST NOTIE1SP1 797 
     1,NOTIE2, AND NOTIE3.')                                            SP1 798 
228   FORMAT ('1***** FURTHER ITERATIONS MAY BE NEEDED IN CURRENT DIMENSSP1 799 
     1IONALITY.')                                                       SP1 800 
      END                                                               SP1 801-
C     COR3                                                              CR3   1 
C     SUBROUTINE TO COMPUTE GUTTMAN-LINGOES ASSOCIATION COEFFICIENTS    CR3   2 
C     AMONG OBJECTS AND AMONG CATEGORIES FOR QUALITATIVE DATA AS INPUT  CR3   3 
C     TO SSAP-I.  WRITTEN IN FORTRAN IV (G) BY LINGOES (1/20/69).  DATA CR3   4 
C     ARRANGEMENT:  NS SETS OF CARDS HAVING NR BINARY ELEMENTS/SET      CR3   5 
C     ACCORDING TO FORMAT FMT.                                          CR3   6 
C                                                                       CR3   7 
      SUBROUTINE COR3 (MD,NS,NR,FMT,C,CAT,SRCAT)                        CR3   8 
      DIMENSION FMT(1), C(MD,MD), CAT(1), SRCAT(1)                      CR3   9 
C                                                                       CR3  10 
C     *** TAPE ASSIGNMENT:                                              CR3  11 
C                                                                       CR3  12 
      ITAPE=5                                                           CR3  13 
C     INITIALIZATION                                                    CR3  14 
      NSP1=NS+1                                                         CR3  15 
      NSNR=NS+NR                                                        CR3  16 
      NSM1=NS-1                                                         CR3  17 
      NSNRM1=NSNR-1                                                     CR3  18 
C     INPUT NS SETS OF CATEGORY SCORES (BINARY)                         CR3  19 
      DO 1 J=1,NS                                                       CR3  20 
1     READ (ITAPE,FMT) (C(I,J),I=NSP1,NSNR)                             CR3  21 
C     DETERMINE NUMBER OF SS FALLING IN A GIVEN CATEGORY                CR3  22 
      II=0                                                              CR3  23 
      DO 3 I=NSP1,NSNR                                                  CR3  24 
      II=II+1                                                           CR3  25 
      CAT(II)=0.                                                        CR3  26 
      DO 2 J=1,NS                                                       CR3  27 
2     CAT(II)=CAT(II)+C(I,J)                                            CR3  28 
      CAT(II)=1./CAT(II)                                                CR3  29 
3     SRCAT(II)=SQRT(CAT(II))                                           CR3  30 
C     COMPUTE G-L COEFFICIENTS OF ASSOCIATION AMONG OBJECTS             CR3  31 
      DO 4 J=1,NSM1                                                     CR3  32 
      JP1=J+1                                                           CR3  33 
      DO 4 I=JP1,NS                                                     CR3  34 
      C(I,J)=0.                                                         CR3  35 
      JJ=0                                                              CR3  36 
      DO 4 K=NSP1,NSNR                                                  CR3  37 
      JJ=JJ+1                                                           CR3  38 
      IF ((C(K,J)+C(K,I)).EQ.2.) C(I,J)=C(I,J)+CAT(JJ)                  CR3  39 
4     CONTINUE                                                          CR3  40 
C     COMPUTE G-L COEFFICIENTS OF ASSOCIATION AMONG CATEGORIES          CR3  41 
      II=0                                                              CR3  42 
      DO 6 I=NSP1,NSNRM1                                                CR3  43 
      II=II+1                                                           CR3  44 
      JP1=I+1                                                           CR3  45 
      JJ=II                                                             CR3  46 
      DO 6 J=JP1,NSNR                                                   CR3  47 
      JJ=JJ+1                                                           CR3  48 
      C(J,I)=0.                                                         CR3  49 
      DO 5 K=1,NS                                                       CR3  50 
5     C(J,I)=C(J,I)+C(I,K)*C(J,K)                                       CR3  51 
6     C(J,I)=C(J,I)*SRCAT(II)*SRCAT(JJ)                                 CR3  52 
      RETURN                                                            CR3  53 
      END                                                               CR3  54-
C     COR3                                                              CR3   1 
C     SUBROUTINE TO COMPUTE NORMALIZED AGREEMENT SCORES WITHIN OBJECTS  CR3   2 
C     AND WITHIN ATTRIBUTES/VARIABLES FOR SSAP-I.  CODED IN FORTRAN IV  CR3   3 
C     (G) BY J. C. LINGOES (1/15/69).  DATA ARRANGEMENT:  NS SETS OF    CR3   4 
C     CARDS HAVING NR ELEMENTS PER SET.                                 CR3   5 
C                                                                       CR3   6 
      SUBROUTINE COR3 (MD,NS,NR,FMT,C,A,B)                              CR3   7 
      DIMENSION FMT(1), C(MD,MD), A(1), B(1)                            CR3   8 
C                                                                       CR3   9 
C     *** TAPE ASSIGNMENT:                                              CR3  10 
      ITAPE=5                                                           CR3  11 
C     INITIALIZATION                                                    CR3  12 
      NSP1=NS+1                                                         CR3  13 
      NSNR=NS+NR                                                        CR3  14 
      NSM1=NS-1                                                         CR3  15 
      NSNRM1=NSNR-1                                                     CR3  16 
      FNS=NS                                                            CR3  17 
      FNR=NR                                                            CR3  18 
C     INPUT SCORE MATRIX ACCORDING TO FORMAT FMT                        CR3  19 
      DO 1 J=1,NS                                                       CR3  20 
1     READ (ITAPE,FMT) (C(I,J),I=NSP1,NSNR)                             CR3  21 
C     COMPUTE AGREEMENT COEFFICIENTS FOR OBJECTS                        CR3  22 
      DO 3 J=1,NSM1                                                     CR3  23 
      JP1=J+1                                                           CR3  24 
      DO 3 I=JP1,NS                                                     CR3  25 
      C(I,J)=0.                                                         CR3  26 
      DO 2 K=NSP1,NSNR                                                  CR3  27 
      IF (C(K,J).EQ.C(K,I)) C(I,J)=C(I,J)+1.                            CR3  28 
2     CONTINUE                                                          CR3  29 
3     C(I,J)=C(I,J)/FNR                                                 CR3  30 
C     COMPUTE AGREEMENT COEFFICIENTS FOR ATTRIBUTES/VARIABLES           CR3  31 
      DO 5 I=NSP1,NSNRM1                                                CR3  32 
      JP1=I+1                                                           CR3  33 
      DO 5 J=JP1,NSNR                                                   CR3  34 
      C(J,I)=0.                                                         CR3  35 
      DO 4 K=1,NS                                                       CR3  36 
      IF (C(I,K).EQ.C(J,K)) C(J,I)=C(J,I)+1.                            CR3  37 
4     CONTINUE                                                          CR3  38 
5     C(J,I)=C(J,I)/FNS                                                 CR3  39 
      RETURN                                                            CR3  40 
      END                                                               CR3  41-
C     COR4                                                              CR4   1 
C     *** DUMMY SUBROUTINE TO GENERATE NS+NR COEFFICIENTS BETWEEN NS+NR CR4   2 
C     FIXED VARIABLES/OBJECTS AND AN ADDED VARIABLE/OBJECT FOR SSAP *** CR4   3 
C                                                                       CR4   4 
      SUBROUTINE COR4 (NSNR,FMT,PROX)                                   CR4   5 
      DIMENSION PROX(1), FMT(18)                                        CR4   6 
C                                                                       CR4   7 
C     GENERATE NS+NR COEFFICIENTS (E.G., CORRELATIONS+SCORES)           CR4   8 
      DO 1 J=1,NR                                                       CR4   9 
1     PROX(J)=PROX(J)                                                   CR4  10 
      RETURN                                                            CR4  11 
      END                                                               CR4  12-
1G-L(SSAP-I) OF MACRAE SIMULATED VOTES BY HYPOTHETICAL LEGISLATORS.             
  30  26   2   2   1   1               1                                        
(26F1.0)                                                                        
22221122211122211112211111                                                      
12221112211112211111211111                                                      
11221111211111211111211111                                                      
11121111111111111111111111                                                      
11111111111111111111111111                                                      
22221222211222211122211112                                                      
12221122211122211112211112                                                      
11221112211112211112211112                                                      
11121111211111211111211112                                                      
11111111111111111111211112                                                      
22221222212222211222211122                                                      
12221122211222211122211122                                                      
11221112211122211122211122                                                      
11121111211112211112211122                                                      
11111111111111211112211122                                                      
22222222222222212222211222                                                      
12221222212222211222211222                                                      
11221122211222211222211222                                                      
11121112211122211122211222                                                      
11111111211112211122211222                                                      
22222222222222222222212222                                                      
12221222222222212222212222                                                      
11221122212222212222212222                                                      
11121112211222211222212222                                                      
11111111211122211222212222                                                      
22222222222222222222222222                                                      
12222222222222222222222222                                                      
11221222222222222222222222                                                      
11121122212222212222222222                                                      
11111112211222212222222222                                                      
