1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 PAGE: 1 0REQUESTED OPTIONS (EXECUTE): OPT(2) XREF SXM 0OPTIONS IN EFFECT: NOLIST NOMAP XREF GOSTMT NODECK SOURCE TERM OBJECT FIXED TRMFLG SRCFLG NOSYM NORENT SDUMP(ISN) SXM NOVECTOR IL(DIM) NOTEST SC(*) NODC NOEC NOEMODE NOICA NODIRECTIVE NODBCS NOSAA NOPARALLEL NOSAVE NOTABS OPT(2) LANGLVL(77) NOFIPS FLAG(I) AUTODBL(NONE) LINECOUNT(60) CHARLEN(500) 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C CLUSPAC: Computer Programs for Mixture-Model Clustering C C C C COPYRIGHT 1991, 1992 STANLEY L. SCLOVE C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C CMS NAME OF PROGRAM: MIXPCM CLUSPAC C C VERSION 7.7 7-APR-92 C C C C PROGRAMMED BY: C C C C DR. STANLEY L. SCLOVE 312/996-2681 C C DEPARTMENT C C OF INFORMATION AND DECISION SCIENCES M/C 294 C C COLLEGE OF BUSINESS ADMINISTRATION C C UNIVERSITY OF ILLINOIS AT CHICAGO C C BOX 4348, CHICAGO, IL 60680 C C C C C C COPYRIGHT 1991 STANLEY LOUIS SCLOVE. C C C C C C ISOPAC is a set of programs implementing clustering C C algorithms derived under the assumption of Gaussian C C class-conditional distributions. The ISDT* programs in C C ISOPAC are based on the so-called "classification" C C likelihood. The MIX* programs are based on the mixture- C C model likelihood. C C C C Program MIXPCM (MIXture model, P-variate data, CoMmon C C *** * * * C C covariance matrix) in the ISOPAC package is one of the C C mixture-model programs for clustering multivariate data. C C (For univariate data the "MIX1" programs may be used.) C C MIXPCM assumes a common covariance matrix across C C distributions. MIXPDT allows different covariance C C matrices. C C C C Input: C C ----- C C Number of clusters (K), initial values of means, prior C C probabilities, and common covariance matrix. If desired, C C program ISDTPCM.ISOPAC can be used to obtain these initial C C values. Use program MIXPCMA.ISOPAC to try a range of C 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 2 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C numbers of clusters (values of K), with automatic setting C C of initial values. C C C C Program restrictions (can be modified): C C -------------------------------------- C C N, sample size, at most 1000; C C IP, number of variables, at most 20; C C K, number of clusters, at most 29; C C ITER, maximum number of iterations, 20. C C C C C C Subroutines called: C C MATEQ, which calls MATDT C C C C IV is a work array for subroutine MATEQ. C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C C C CONTROL CARDS: C C C C DATASET TITLE C C N, IN FORMAT (2X,I4) C C IP, IN FORMAT (3X,I2) C C DATFMT, IN FORMAT (18A4), E.G., (4F4.1) C C "DATFMT" WILL ALSO BE USED FOR OUTPUT, SO ALLOW AT LEAST C C ONE BLANK AT THE BEGINNING FOR CARRIAGE CONTROL. C C DATA, ONE CASE AT A TIME, IN FORMAT SPECIFIED BY DATFMT C C K, NUMBER OF CLUSTERS, IN FORMAT (2X,I2) C C MEANFT, in format (18A4) C C K INITIAL MEANS, IN FORMAT SPECIFIED BY MEANFT C C C C K INITIAL VALUES OF PRIOR PROBABILITIES, C C IN FORMAT (5X,F3.2). C C C C COVFMT, in format (18A4). C C Initial value of VARHAT, the common covariance matrix. C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 1 DIMENSION X(1000,20),SUM(29,20) 2 DIMENSION F(1000,29),PP(29,1000) 3 DIMENSION ICLUS(1000),ICLSOL(1000) 4 DIMENSION DENOM(1000),XMXPR(1000) 5 DIMENSION DSQ(29) 6 DIMENSION TITLE(18) 7 DIMENSION NG(29),XBAR(29,20) 8 DIMENSION DATFMT(18) 9 DIMENSION MEANFT(18) 10 DIMENSION COVFMT(18) 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 3 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 11 DIMENSION SSD(29,20,20) 12 DIMENSION WGSS(20,20) 13 DIMENSION VARHAT(20,20) 14 DIMENSION XMIN(20),XMAX(20) 15 DIMENSION IV(20,20) 16 DIMENSION P(20,20) 17 DIMENSION PR(29) C 18 DOUBLE PRECISION SUM 19 DOUBLE PRECISION WGSS,SSD 20 DOUBLE PRECISION VARHAT 21 DOUBLE PRECISION P 22 DOUBLE PRECISION DET,TRUDET 23 DOUBLE PRECISION DSQ 24 DOUBLE PRECISION XBAR 25 DOUBLE PRECISION DEVV,DEVW 26 DOUBLE PRECISION F C C C C FLOW OF PROGRAM: C C C READ DATA AND INITIAL PARAMETER ESTIMATES. C INVERT COVARIANCE MATRIX. C PRINT INITIAL PARAMETER ESTIMATES. C C ITERATION: C COMPUTE ESTIMATED VALUES OF PROBABILITY DENSITY FUNCTIONS. C COMPUTE LIKELIHOOD AND VALUES OF MODEL-SELECTION CRITERIA. C COMPUTE CLUSTER-MEMBERSHIP PROBABILITIES. C UPDATE PARAMETER ESTIMATES (INCLUDING C INVERSE COVARIANCE MATRIX). C CLUSTER BY MAXIMUM PROBABILITY OF CLUSTER MEMBERSHIP. C IF CLUSTERING HASN'T CHANGED, STOP AND PRINT RESULTS. C OTHERWISE DO ANOTHER ITERATION (UNLESS 20 HAVE C ALREADY BEEN DONE). C C C 27 DATA PI/3.141593/ C 28 READ (5,36000) TITLE C C WRITE PROGRAM INFORMATION. 29 WRITE (6,10000) 30 WRITE (6,10050) 31 WRITE (6,40000) TITLE C C READ SAMPLE SIZE, N. 32 READ (5,12000) N 33 XN = N 34 WRITE (6,38000) N C READ NUMBER OF VARIABLES, IP. 35 READ (5,54000) IP 36 WRITE (6,56000) IP 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 4 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C C READ DATA FORMAT. 37 READ (5,36000) DATFMT C C READ DATA. 38 DO 500 I = 1,N 1 39 READ (5,DATFMT) (X(I,JV), JV = 1,IP) 1 40 IF (I .EQ. 1) GO TO 100 1 41 GO TO 300 1 42 100 CONTINUE C COMPUTE MINIMA AND MAXIMA: 1 43 DO 200 JV = 1,IP 2 44 XMAX(JV) = X(1,JV) 2 45 XMIN(JV) = X(1,JV) 2 46 200 CONTINUE 1 47 300 CONTINUE 1 48 DO 400 JV = 1,IP 2 49 IF (X(I,JV) .LT. XMIN(JV)) XMIN(JV)=X(I,JV) 2 51 IF (X(I,JV) .GT. XMAX(JV)) XMAX(JV)=X(I,JV) 2 53 400 CONTINUE 1 54 500 CONTINUE C WRITE MINIMA AND MAXIMA: 55 WRITE (6,64000) 56 WRITE (6,DATFMT) (XMIN(JV),JV=1,IP) 57 WRITE (6,66000) 58 WRITE (6,DATFMT) (XMAX(JV),JV=1,IP) C C READ K, NUMBER OF CLUSTERS. 59 READ (5,11000) K 60 WRITE (6,26000) K C C READ INITIAL MEANS C READ INPUT FORMAT FOR MEANS: 61 READ (5,36000) MEANFT 62 DO 600 IC=1,K 1 63 READ (5,MEANFT) (XBAR(IC,JV), JV=1,IP) C 1 64 600 CONTINUE C READ INITIAL VALUES OF PRIOR PROBABILITIES: 65 DO 650 IC=1,K 1 66 READ (5,25000) PR(IC) C 1 67 650 CONTINUE C C C READ INITIAL VALUE OF COVARIANCE MATRIX, VARHAT: C 68 READ(5,36000) COVFMT 69 DO 660 JV = 1,IP 1 70 READ(5,COVFMT) (VARHAT(JV,JW),JW=1,IP) 1 71 660 CONTINUE C C 72 WRITE(6,22000) 73 ITER = 1 74 700 CONTINUE 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 5 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 75 WRITE (6,32000) ITER C WRITE CURRENT ESTIMATES OF PARAMETERS: C WRITE CURRENT ESTIMATES OF MEAN VECTORS:-- 76 WRITE (6,20000) 77 DO 710 IC = 1,K 1 78 WRITE (6,MEANFT) ( XBAR(IC,JV), JV=1,IP ) 1 79 710 CONTINUE 80 WRITE (6,23000) 81 WRITE (6,35000) (PR(IC), IC = 1,K) C WRITE CURRENT ESTIMATE OF COVARIANCE MATRIX, VARHAT:-- 82 WRITE(6,42000) 83 DO 670 JV = 1,IP 1 84 WRITE(6,COVFMT) (VARHAT(JV,JW),JW=1,IP) 1 85 670 CONTINUE C C CALL SUBROUTINE TO COMPUTE INVERSE COVARIANCE MATRIX: C SET PARAMETERS OF SUBROUTINE CALL: 86 IDET = 1 87 NRS1 = 0 C C 88 CALL MATEQ(VARHAT,IP,20,JFLG,DET,IDET,IV,NRS1,P,20) C ON RETURN, P CONTAINS THE INVERSE MATRIX. C C C GENERAL FORM OF CALL IS: C CALL MATEQ(A,M,N,JFLG,DET,IDET,IV,NRS1,P,LL) C SEE SUBROUTINE LISTING FOR FULLER EXPLANATION. C DET(VARHAT) = DET*10.0**IDET C C ON RETURN, P CONTAINS THE INVERSE MATRIX. C C C C WRITE VALUE OF INVERSE COVARIANCE MATRIX: C WRITE(6,44000) C DO 680 JV = 1,IP C WRITE(6,COVFMT) (P(JV,JW),JW=1,IP) C 680 CONTINUE C C If determinant is not positive, replace it by an approximation C based on diagonal version of the covariance matrix: 89 IF ( DET .LE. 0.0 ) GO TO 601 90 GO TO 602 91 601 CONTINUE 92 DET = 1.0 93 DO 603 IVAR=1,IP 1 94 DET = DET*VARHAT(IVAR,IVAR) 1 95 603 CONTINUE 96 TRUDET = DET 97 GO TO 604 98 602 CONTINUE C 99 XIDET = IDET 100 XLGDET = DLOG(DET) + XIDET*ALOG(10.0) 101 TRUDET = DET*(10.0**IDET) 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 6 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 102 604 CONTINUE C C C COMMENCE COMPUTATION OF F(I,IC), I=1,...,N, IC=1,...,K: C C COMPUTE MAHALANOBIS D-SQUARE BETWEEN THE I-TH OBSERVATION AND C THE L-TH MEAN, L=1,2,...,K, I=1,2,...,N:-- C 103 DO 1200 I = 1,N C 1 104 DO 1000 L=1,K 2 105 DSQ(L) = 0.0 2 106 DO 1310 JV=1,IP 3 107 DEVV = X(I,JV) - XBAR(L,JV) 3 108 DO 1310 JW=1,IP 4 109 DEVW = X(I,JW) - XBAR(L,JW) 4 110 DSQ(L) = DSQ(L) + DEVV*P(JV,JW)*DEVW 4 111 1310 CONTINUE 2 112 ZSQ = DSQ(L) C IF D-SQ IS INORDINATELY LARGE, SET VALUE OF PDF TO ZERO C (IT IS EXTREMELY SMALL ANYWAY, AND THIS AVOIDS UNDERFLOW): C IF ( ZSQ/2.0 .LE. 174.673 ) GO TO 1090 2 113 IF ( ZSQ/2.0 .LE. 100.0 ) GO TO 1090 2 114 F(I, L) = 0.0 2 115 GO TO 1100 C 2 116 1090 CONTINUE 2 117 F(I, L) = EXP(-ZSQ/2.0)/((2*PI)**(IP/2)) 2 118 F(I, L) = F(I,L)/DSQRT(TRUDET) 2 119 1100 CONTINUE 2 120 1000 CONTINUE 1 121 1200 CONTINUE C C COMPUTE LOG LIKELIHOOD AND VALUES OF MODEL-SELECTION CRITERIA: C 122 SUMLNF = 0.0 123 DO 2200 I=1,N 1 124 SUMPXF = 0.0 1 125 DO 2100 IC=1,K 2 126 SUMPXF = SUMPXF + PR(IC)*F(I,IC) 2 127 2100 CONTINUE 1 128 IF ( SUMPXF .EQ. 0.0 ) GO TO 2200 1 129 SUMLNF = SUMLNF + ALOG(SUMPXF) 1 130 2200 CONTINUE C 131 XMN2LL = -2.0*SUMLNF C 132 WRITE (6,30000) XMN2LL C C C COMPUTE MODEL SELECTION CRITERIA C C PARAMETERS: C K MEAN VECTORS OF DIMENSION P AND A P-BY-P COVARIANCE MATRIX, C WHERE P IS THE NUMBER OF VARIABLES, AND K-1 INDEPENDENT C MIXING PROBABILITIES. 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 7 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 133 NOPARM = K*IP + IP*(IP+1)/2 + (K-1) 134 WRITE (6,72000) NOPARM 135 AIC = XMN2LL + 2.0*NOPARM 136 SCH = XMN2LL + ALOG(XN)*NOPARM 137 WRITE (6,70000) AIC 138 WRITE (6,71000) SCH C C C COMPUTE POSTERIOR PROBABILITIES OF GROUP MEMBERSHIP, C PP(IC,I), THE CONDITIONAL PROBABILITY OF POP'N IC, GIVEN X(I), C AS PR(IC)*F(I,IC)/DENOM(I): 139 DO 1350 I = 1,N 1 140 DENOM(I) = 0.0 1 141 DO 1350 IC=1,K 2 142 DENOM(I) = DENOM(I) + PR(IC)*F(I,IC) 2 143 1350 CONTINUE 144 DO 1400 I = 1,N 1 145 DO 1400 IC=1,K 2 146 IF ( DENOM(I) .GT. 0.0 ) GO TO 1410 2 147 PP(IC,I) = 0.0 2 148 GO TO 1400 2 149 1410 CONTINUE 2 150 PP(IC,I)= PR(IC)*F(I,IC)/DENOM(I) 2 151 1400 CONTINUE C 152 WRITE(6,76000) 153 DO 1420 I = 1,4 1 154 WRITE(6,82000) ( PP(IC,I), IC = 1,K ) 1 155 1420 CONTINUE C C C UPDATE PARAMETER ESTIMATES: C C C UPDATE CLUSTER PRIOR PROBABILITIES PR(IC):-- 156 DO 3800 IC = 1,K 1 157 PR(IC) = 0.0 1 158 DO 3800 I = 1,N 2 159 PR(IC) = PR(IC) + PP(IC,I) 2 160 3800 CONTINUE 161 DO 3900 IC = 1,K 1 162 PR(IC) = PR(IC)/N 1 163 3900 CONTINUE 164 DO 1750 IG = 1,K 1 165 DO 1750 JV = 1,IP 2 166 SUM(IG,JV) = 0.0 2 167 DO 1750 JW = 1,IP 3 168 SSD(IG,JV,JW) = 0.0 3 169 1750 CONTINUE C C UPDATE MEANS:-- 170 DO 1875 IC = 1,K 1 171 DO 1875 JV = 1,IP 2 172 DO 1875 I = 1,N 3 173 SUM(IC,JV) = SUM(IC,JV) + PP(IC,I)*X(I,JV) 3 174 1875 CONTINUE 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 8 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 175 DO 1900 IG = 1,K 1 176 IF (N*PR(IG) .LT. .05) GO TO 2050 1 177 GO TO 2150 1 178 2050 WRITE (6,74000) IG 1 179 GO TO 4000 1 180 2150 CONTINUE 1 181 DO 1900 JV = 1,IP 2 182 XBAR(IG,JV) = SUM(IG,JV)/(N*PR(IG)) 2 183 1900 CONTINUE C C 184 DO 3600 IC=1,K 1 185 DO 3600 JV=1,IP 2 186 DO 3600 JW=JV,IP 3 187 DO 3600 I=1,N 4 188 DEVV=X(I,JV)-XBAR(IC,JV) 4 189 DEVW=X(I,JW)-XBAR(IC,JW) 4 190 TERM=PP(IC,I)*DEVV*DEVW 4 191 SSD(IC,JV,JW)=SSD(IC,JV,JW)+TERM 4 192 3600 CONTINUE C 193 DO 3700 IC=1,K 1 194 DO 3700 JV=2,IP 2 195 DO 3700 JW=1,JV-1 3 196 SSD(IC,JV,JW)=SSD(IC,JW,JV) 3 197 3700 CONTINUE C C C POOL: C 198 DO 1950 JV = 1,IP 1 199 DO 1950 JW = 1,IP 2 200 WGSS(JV,JW) = 0.0 2 201 1950 CONTINUE C 202 DO 2300 JV = 1,IP 1 203 DO 2300 JW = 1,IP 2 204 DO 2300 IC = 1,K 3 205 WGSS(JV,JW) = WGSS(JV,JW) + PR(IC)*SSD(IC,JV,JW) 3 206 2300 CONTINUE C COMPUTE VARHAT, MLE OF COMMON COVARIANCE MATRIX: 207 DO 2400 JV = 1,IP 1 208 DO 2400 JW = 1,IP 2 209 VARHAT(JV,JW) = WGSS(JV,JW)/N 2 210 2400 CONTINUE C (END PARAMETER-ESTIMATE UPDATE SEQUENCE) C 211 IF (ITER .EQ. 1) GO TO 900 C STORE OLD LABELS: 212 DO 800 I = 1,N 1 213 ICLSOL(I) = ICLUS(I) 1 214 800 CONTINUE C 215 900 CONTINUE C C COMPUTE NEW LABELS BY MAX POSTERIOR PROBABILITY: 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 9 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 216 DO 1600 I = 1,N 1 217 XMXPR(I) = PP(1,I) 1 218 ICLUS(I) = 1 1 219 DO 1600 IC = 2,K 2 220 IF ( PP(IC,I) .GT. XMXPR(I) ) GO TO 1500 2 221 GO TO 1600 2 222 1500 XMXPR(I) = PP(IC,I) 2 223 ICLUS(I) = IC 2 224 1600 CONTINUE C C 225 IF (N .GE. 31) GO TO 250 226 WRITE (6,14000) C 227 WRITE (6,16000) 228 WRITE (6,18000) (I, ICLUS(I), I=1,N) 229 250 CONTINUE C C C C 230 IF (ITER .EQ. 1) GO TO 3000 231 DO 2900 I = 1,N 1 232 IF (ICLUS(I) .EQ. ICLSOL(I)) GO TO 2900 1 233 GO TO 3000 1 234 2900 CONTINUE 235 GO TO 3300 236 3000 CONTINUE 237 ITER = ITER + 1 238 IF (ITER.GE.51) GO TO 3100 239 GO TO 700 240 3100 WRITE (6,68000) 241 4000 STOP C C 242 3300 CONTINUE C C C COUNT NUMBERS IN CLUSTERS: 243 DO 3310 IC = 1,K 1 244 NG(IC) = 0 1 245 3310 CONTINUE 246 DO 3320 I = 1,N 1 247 IC = ICLUS(I) 1 248 NG(IC) = NG(IC) + 1 1 249 3320 CONTINUE C C C PRINT FINAL RESULTS C C 250 WRITE (6,34000) (NG(IC),IC=1,K) 251 WRITE (6,35000) (PR(IC),IC=1,K) 252 DO 2800 IC = 1,K 1 253 WRITE (6,28000) IC 1 254 WRITE (6,MEANFT) (XBAR(IC,JV),JV=1,IP) 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 10 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 1 255 2800 CONTINUE C 256 WRITE (6,42000) 257 DO 2500 JV=1,IP 1 258 WRITE (6,48000) (VARHAT(JV,JW),JW=1,IP) 1 259 2500 CONTINUE C 260 IF ( N .GT. 60 ) GO TO 3510 261 WRITE (6,52000) 262 DO 3500 I = 1,N 1 263 WRITE (6,50000) I, ICLUS(I) 1 264 WRITE (6,DATFMT) (X(I,JV),JV=1,IP) 1 265 3500 CONTINUE 266 3510 CONTINUE C 267 WRITE (6,84000) C C 268 STOP C C C 269 10000 FORMAT('1','****************************************'//// X' CLUSTER ANALYSIS OF CASES '/ X' USING COMMON COVARIANCE MATRIX'// X' CMS FILE: MIXPCM CLUSPAC '// X' DEVELOPED AND PROGRAMMED BY DR. STANLEY L. SCLOVE'// X' MIXPCM CLUSPAC VERSION 7.7 7-APR-92 '//' COPYRIGHT', Z' 1991, 1992 STANLEY L. SCLOVE ') 270 10050 FORMAT(' ************************************************', X'********************************'//) 271 11000 FORMAT(2X,I2) 272 12000 FORMAT(2X,I4) 273 14000 FORMAT(//1X,'CLUSTERING:'/) 274 16000 FORMAT(/,1X,'CASES AND LABELS:--'/) 275 18000 FORMAT(15(I5,I3)) 276 20000 FORMAT(//1X,'MEANS'/) 277 22000 FORMAT(' FIRST ITERATION USES THE INITIAL PARAMETER ESTIMATES'/ X' PROVIDED BY THE USER.'/) 278 25000 FORMAT(5X, F3.2) 279 23000 FORMAT(//1X, 'CURRENT ESTIMATES OF PRIOR PROBABILITIES:') 280 26000 FORMAT('1',//,1X,'K = ',I2,' CLUSTERS') 281 28000 FORMAT(1X,'MEAN VECTOR FOR CLUSTER ',I2,': ') 282 30000 FORMAT(/1X,' MINUS 2 LOG LIKELIHOOD = ', F13.5//) 283 32000 FORMAT(1X,'ITERATION ', I2) 284 34000 FORMAT(/,1X,'NUMBERS IN CLUSTERS:',3X,29(I3,3X)/) 285 35000 FORMAT(/,1X,'MIXING PROBABILITIES:',3X,10(F5.3,3X)/) 286 36000 FORMAT(18A4) 287 38000 FORMAT(1X,'NUMBER OF OBSERVATIONS (SAMPLE SIZE), N = ',I4/) 288 40000 FORMAT(1X,18A4//) 289 42000 FORMAT(//,1X,'COMMON COVARIANCE MATRIX (MLE):',/) C 290 44000 FORMAT(//,1X,'INVERSE COVARIANCE MATRIX:',/) C 291 48000 FORMAT(1X,8F13.5/) 292 50000 FORMAT(1X,I4,1X,I2) 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 11 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 293 52000 FORMAT(//,1X,'CASE, LABEL / DATA'//) 294 54000 FORMAT(3X,I2) 295 56000 FORMAT(1X,'NUMBER OF VARIABLES = ',I2/) 296 58000 FORMAT(/1X,'CONVERGENCE: NO CASE CHANGED CLUSTERS AFTER ', X'ITERATION ',I2,'. RESULTS ARE PRINTED BELOW.'//) 297 60000 FORMAT(/,1X,'JFLG = ',I2,'. IF JFLG=0, COMPUTATION OF DET', X' WENT WELL; OTHERWISE, THERE WAS TROUBLE OR MATRIX WAS ', X'ILL-CONDITIONED.'//) 298 62000 FORMAT(/1X,'DET = ',F13.5,' IDET = ',I3,5X, X'ACTUAL DET. = DET*10**IDET',//) 299 64000 FORMAT(/1X,'MINIMUM FOR EACH VARIABLE: ',/) 300 66000 FORMAT(/1X,'MAXIMUM FOR EACH VARIABLE: ',/) 301 68000 FORMAT(1X,'PROGRAM HAS NOT CONVERGED IN 50 ITERATIONS: STOP'//) 302 70000 FORMAT(1X,'AIC = ', F15.5,/) 303 71000 FORMAT(1X,'SCHWARZ CRITERION = ', F15.5,/) 304 72000 FORMAT(//1X,'NUMBER OF PARAMETERS = ',I4//) 305 74000 FORMAT(1X,'EXPECTED NUMBER OF OBSERVATIONS IN CLUSTER ',I3, X' IS LESS THAN .05. STOP.'/) 306 76000 FORMAT(' POSTERIOR PROBS OF GROUP MEMBERSHIP FOR 1ST 4 CASES:') 307 82000 FORMAT(/,1X,29F5.2/) 308 84000 FORMAT(/,1X,'PROGRAM ENDED NORMALLY.') 309 END 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 12 0SYMBOL CROSS REFERENCE DICTIONARY 0PROGRAM NAME: MAIN# 0TAGS: A-ARRAY I-INTRINSIC FUNCTION S-ASSIGNED C-COMMON K-NAMED CONSTANT T-EXPLICITLY TYPED D-DUMMY ARGUMENT N-ENTRY V-INITIAL VALUE E-EQUIVALENCED P-PROMOTED X-EXTERNAL SUBPROGRAM F-STATEMENT FUNCTION Q-PADDED Y-DYNAMIC COMMON G-GENERIC NAME R-SUBPROGRAM NAME Z-EXTENDED COMMON 0NAME TYPE TAG DECLARED REFS (F:REFD S:SET B:REFD/MAY BE SET) +______ ____ ______ ________ ________________________________________ 0AIC R*4 135S 137F ALOG R*4 I 100 129 136 COVFMT R*4 A 10 68S 70 84F DATFMT R*4 A 8 37S 39 56F 58F 264F DENOM R*4 A 4 140S 142F 142S 146F 150F DET R*8 T 22 88B 89F 92S 94F 94S 96F 100F 101F DEVV R*8 T 25 107S 110F 188S 190F DEVW R*8 T 25 109S 110F 189S 190F DLOG R*8 I 100 DSQ R*8 AT 5 23 105S 110F 110S 112F DSQRT R*8 I 118 EXP GI 117 F R*8 AT 2 26 114S 117S 118F 118S 126F 142F 150F I I*4 38S 39 40F 49F 50F 51F 52B 103S 107F 109F 114F 117F 118F 118B 123S 126B 139S 140F 142F 142F 142B 144S 146F 147F 150F 150F 150B 153S 154B 158S 159B 172S 173F 173B 187S 188F 189F 190B 212S 213F 213B 216S 217F 217F 218F 220F 220F 222F 222F 223B 228S 228F 228B 231S 232F 232B 246S 247B 262S 263F 263F 264B IC I*4 62S 63B 65S 66B 77S 78B 81S 81S 125S 126F 126B 141S 142F 142B 145S 147F 150F 150F 150B 154S 154S 156S 157F 159F 159F 159B 161S 162F 162B 170S 173F 173F 173B 184S 188F 189F 190F 191F 191B 193S 196F 196B 204S 205F 205B 219S 220F 222F 223B 243S 244B 247S 248F 248F 250S 250S 251S 251S 252S 253F 254B ICLSOL I*4 A 3 213S 232F ICLUS I*4 A 3 213F 218S 223S 228F 232F 247F 263F 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 13 0TAGS: A-ARRAY I-INTRINSIC FUNCTION S-ASSIGNED C-COMMON K-NAMED CONSTANT T-EXPLICITLY TYPED D-DUMMY ARGUMENT N-ENTRY V-INITIAL VALUE E-EQUIVALENCED P-PROMOTED X-EXTERNAL SUBPROGRAM F-STATEMENT FUNCTION Q-PADDED Y-DYNAMIC COMMON G-GENERIC NAME R-SUBPROGRAM NAME Z-EXTENDED COMMON 0NAME TYPE TAG DECLARED REFS (F:REFD S:SET B:REFD/MAY BE SET) +______ ____ ______ ________ ________________________________________ 0IDET I*4 86S 88B 99F 101F IG I*4 164S 166F 168B 175S 176F 178F 182F 182F 182B IP I*4 35S 36F 39 43F 48F 56F 58F 63 69F 70 78F 83F 84F 88B 93F 106F 108F 117F 133F 133F 133F 165F 167F 171F 181F 185F 186F 194F 198F 199F 202F 203F 207F 208F 254F 257F 258F 264F ITER I*4 73S 75F 211F 230F 237F 237S 238F IV I*4 A 15 88B IVAR I*4 93S 94F 94B JFLG I*4 88B JV I*4 39S 39S 43S 44F 44F 45F 45B 48S 49F 49F 50F 50F 51F 51F 52F 52B 56S 56S 58S 58S 63S 63S 69S 70B 78S 78S 83S 84B 106S 107F 107F 110B 165S 166F 168B 171S 173F 173F 173B 181S 182F 182B 185S 186F 188F 188F 191F 191B 194S 195F 196F 196B 198S 200B 202S 205F 205F 205B 207S 209F 209B 254S 254S 257S 258B 264S 264S JW I*4 70S 70S 84S 84S 108S 109F 109F 110B 167S 168B 186S 189F 189F 191F 191B 195S 196F 196B 199S 200B 203S 205F 205F 205B 208S 209F 209B 258S 258S K I*4 59S 60F 62F 65F 77F 81F 104F 125F 133F 133F 141F 145F 154F 156F 161F 164F 170F 175F 184F 193F 204F 219F 243F 250F 251F 252F L I*4 104S 105F 107F 109F 110F 110F 112F 114F 117F 118F 118B MATEQ X 88F MEANFT I*4 A 9 61S 63 78F 254F N I*4 32S 33F 34F 38F 103F 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 14 0TAGS: A-ARRAY I-INTRINSIC FUNCTION S-ASSIGNED C-COMMON K-NAMED CONSTANT T-EXPLICITLY TYPED D-DUMMY ARGUMENT N-ENTRY V-INITIAL VALUE E-EQUIVALENCED P-PROMOTED X-EXTERNAL SUBPROGRAM F-STATEMENT FUNCTION Q-PADDED Y-DYNAMIC COMMON G-GENERIC NAME R-SUBPROGRAM NAME Z-EXTENDED COMMON 0NAME TYPE TAG DECLARED REFS (F:REFD S:SET B:REFD/MAY BE SET) +______ ____ ______ ________ ________________________________________ 0 123F 139F 144F 158F 162F 172F 176F 182F 187F 209F 212F 216F 225F 228F 231F 246F 260F 262F NG I*4 A 7 244S 248F 248S 250F NOPARM I*4 133S 134F 135F 136F NRS1 I*4 87S 88B P R*8 AT 16 21 88B 110F PI R*4 V 27 117F PP R*4 A 2 147S 150S 154F 159F 173F 190F 217F 220F 222F PR R*4 A 17 66S 81F 126F 142F 150F 157S 159F 159S 162F 162S 176F 182F 205F 251F SCH R*4 136S 138F SSD R*8 AT 11 19 168S 191F 191S 196F 196S 205F SUM R*8 AT 1 18 166S 173F 173S 182F SUMLNF R*4 122S 129F 129S 131F SUMPXF R*4 124S 126F 126S 128F 129F TERM R*4 190S 191F TITLE R*4 A 6 28S 31F TRUDET R*8 T 22 96S 101S 118F VARHAT R*8 AT 13 20 70S 84F 88B 94F 209S 258F WGSS R*8 AT 12 19 200S 205F 205S 209F X R*4 A 1 39S 44F 45F 49F 50F 51F 52F 107F 109F 173F 188F 189F 264F XBAR R*8 AT 7 24 63S 78F 107F 109F 182S 188F 189F 254F XIDET R*4 99S 100F XLGDET R*4 100S XMAX R*4 A 14 44S 51F 52S 58F XMIN R*4 A 14 45S 49F 50S 56F XMN2LL R*4 131S 132F 135F 136F XMXPR R*4 A 4 217S 220F 222S XN R*4 33S 136F ZSQ R*4 112S 113F 117F 0 0VARIABLES REFERENCED BUT NOT SET. (* POSSIBLY SET AS ARGUMENT.) 0IV* JFLG* P* 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 15 0LABEL CROSS REFERENCE DICTIONARY 0TAGS: A-USED AS ARGUMENT F-FORMAT S-USED IN ASSIGN STATEMENT B-OBJECT OF BRANCH N-NON-EXECUTABLE 0 LABEL TAG DEFINED REFERENCED +____________ ___ _______ ___________________________________________ 0 100 B 42 40 200 46 43 250 B 229 225 300 B 47 41 400 53 48 500 54 38 600 64 62 601 B 91 89 602 B 98 90 603 95 93 604 B 102 97 650 67 65 660 71 69 670 85 83 700 B 74 239 710 79 77 800 214 212 900 B 215 211 1000 120 104 1090 B 116 113 1100 B 119 115 1200 121 103 1310 111 106 108 1350 143 139 141 1400 B 151 144 145 148 1410 B 149 146 1420 155 153 1500 B 222 220 1600 B 224 216 219 221 1750 169 164 165 167 1875 174 170 171 172 1900 183 175 181 1950 201 198 199 2050 B 178 176 2100 127 125 2150 B 180 177 2200 B 130 123 128 2300 206 202 203 204 2400 210 207 208 2500 259 257 2800 255 252 2900 B 234 231 232 3000 B 236 230 233 3100 B 240 238 3300 B 242 235 3310 245 243 3320 249 246 3500 265 262 3510 B 266 260 3600 192 184 185 186 187 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:12 NAME:MAIN# PAGE: 16 0TAGS: A-USED AS ARGUMENT F-FORMAT S-USED IN ASSIGN STATEMENT B-OBJECT OF BRANCH N-NON-EXECUTABLE 0 LABEL TAG DEFINED REFERENCED +____________ ___ _______ ___________________________________________ 0 3700 197 193 194 195 3800 160 156 158 3900 163 161 4000 B 241 179 10000 NF 269 29 10050 NF 270 30 11000 NF 271 59 12000 NF 272 32 14000 NF 273 226 16000 NF 274 227 18000 NF 275 228 20000 NF 276 76 22000 NF 277 72 23000 NF 279 80 25000 NF 278 66 26000 NF 280 60 28000 NF 281 253 30000 NF 282 132 32000 NF 283 75 34000 NF 284 250 35000 NF 285 81 251 36000 NF 286 28 37 61 68 38000 NF 287 34 40000 NF 288 31 42000 NF 289 82 256 44000 NF 290 UNREFERENCED 48000 NF 291 258 50000 NF 292 263 52000 NF 293 261 54000 NF 294 35 56000 NF 295 36 58000 NF 296 UNREFERENCED 60000 NF 297 UNREFERENCED 62000 NF 298 UNREFERENCED 64000 NF 299 55 66000 NF 300 57 68000 NF 301 240 70000 NF 302 137 71000 NF 303 138 72000 NF 304 134 74000 NF 305 178 76000 NF 306 152 82000 NF 307 154 84000 NF 308 267 0*STATISTICS* SOURCE STATEMENTS: 307, PROGRAM SIZE: 569444 BYTES, PROGRAM NAME: MAIN#, PAGE: 1 *STATISTICS* NO DIAGNOSTICS GENERATED. **MAIN#** END OF COMPILATION 1 ****** TIME STAMP: 92.09900.12.12 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:15 PAGE: 17 0OPTIONS IN EFFECT: NOLIST NOMAP XREF GOSTMT NODECK SOURCE TERM OBJECT FIXED TRMFLG SRCFLG NOSYM NORENT SDUMP(ISN) SXM NOVECTOR IL(DIM) NOTEST SC(*) NODC NOEC NOEMODE NOICA NODIRECTIVE NODBCS NOSAA NOPARALLEL NOSAVE NOTABS OPT(2) LANGLVL(77) NOFIPS FLAG(I) AUTODBL(NONE) LINECOUNT(60) CHARLEN(500) 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C C 1 SUBROUTINE MATEQ(A,M,N,JFLG,DET,IDET,IV,NRS1,P,LL) C SUBROUTINE MATEQ IS DMATEQ FROM THE UICC SUBROUTINE LIBRARY. C PAGE 1 C C SUBROUTINE DMATEQ C ***************** C THIS ROUTINE WILL SOLVE A REAL*8 SYSTEM OF LINEAR EQUATIONS,COMPUTE C THE DETERMINANT, WITHOUT UNDERFLOW OR OVERFLOW, OF A REAL*8 MATRIX, C AND/OR INVERT A REAL*8 MATRIX. C CALLING SEQUENCE: C CALL DMATEQ(A,N,IA,JFLG,DET,IDET,IV,NRS,P,IP) WHERE; C A (INPUT) - IS THE REAL*8 MATRIX ON WHICH THE ROUTINE IS C TO WORK. IN THE PROCESS OF COMPUTATION THE C CONTENTS OF THIS MATRIX ARE DESTROYED. C N (INPUT) - IS AN INTEGER*4 VARIABLE WHICH SPECIFIES THE C ORDER OF THE A MATRIX. C IA (INPUT) - IS AN INTEGER*4 VARIABLE WHICH SPECIFIES THE C ACTUAL ROW DIMENSION OF A AS DIMENSIONED IN C THE CALLING PROGRAM. IA MUST BE GREATER THAN C OR EQUAL TO N. C JFLG (OUTPUT) - IS AN INTEGER*4 RETURN CODE VARIABLE. UPON C RETURN FROM DMATEQ IF; C JFLG=0, ALL WENT WELL. C JFLG=1, THE A MATRIX WAS SINGULAR OR NEAR C SINGULAR AND THE COMPUTATIONS COULD NOT BE C COMPLETED. THE CONTENTS OF THE VARIABLES C A, DET, IDET AND P ARE MEANINGLESS. C DET (OUTPUT) - IS A REAL*8 VARIABLE WHICH CONTAINS THE C DETERMINANT OF A. (SEE IDET) C IDET (INPUT) - IS AN INTEGER*4 VARIABLE. ON INPUT IF; C IDET=0, NO DETERMINANT IS CALCULATED. C IDET NOT 0, THE DETERMINANT OF A IS COMPUTED. C ON OUTPUT IDET CONTAINS THE POWER OF 10 C THAT DET SHOULD BE MULTIPLIED BY TO GIVE THE C CORRECT VALUE OF THE DETERMINANT. I.E. C DET(A)=DET*10.0D0**IDET. C IF DET(A) CAN BE COMPUTED WITHOUT UNDER OR C OVERFLOW, THEN IDET=0 OTHERWISE IDET IS SET C TO THE PROPER VALUE SO THAT NO UNDER OR OVER- C FLOW WILL OCCUR IN COMPUTING DET. C IV (INPUT) - IS AN INTEGER*4 WORK ARRAY WHICH SHOULD BE C DIMENSIONED AT LEAST IV(N). C PAGE 2 C C NRS (INPUT) - IS AN INTEGER*4 VARIABLE WITH THE FOLLOWING C INTERPRETATION: C NRS>0, SOLVE A SYSTEM OF LINEAR EQUATIONS C WITH NRS RIGHT HAND SIDES. C NRS=0, INVERT THE A MATRIX. C NRS<0, ONLY COMPUTE THE DETERMINANT OF A. 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:15 NAME:MAIN# PAGE: 18 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C IN THIS CASE IDET MUST BE DIFFERENT FROM 0. C P (INPUT) - IS A REAL*8 ARRAY WITH THE FOLLOWING INTER- C PRETATION: C IF NRS>0, THEN P CONTAINS THE NRS RIGHT HAND C SIDES STORED BY COLUMNS. IN THIS CASE P MUST C BE DIMENSIONED AT LEAST P(N,NRS). ON RETURN C THE COLUMNS OF P ARE REPLACED BY THE RESPEC- C TIVE SOLUTIONS. C IF NRS=0, THEN P MUST BE DIMENSIONED AT LEAST C P(N,N). ON RETURN P WILL CONTAIN THE INVERSE C OF A. C IF NRS<0,THEN P NEED ONLY BE A DUMMY VARIABLE C IN THIS CASE P IS NEVER ACCESSED BY DMATEQ. C IP (INPUT) - IS AN INTEGER*4 VARIABLE WHICH CONTAINS THE C ACTUAL ROW DIMENSION OF P AS DIMENSIONED IN C THE CALLING PROGRAM. IP MUST BE GREATER THAN C OR EQUAL TO N. C NOTE: IMMEDIATELY ON RETURN FROM DMATEQ THE CONDITION CODE FLAG, C JFLG, SHOULD BE INTERROGATED. IF JFLG=1, THEN THE ROUTINE C COULD NOT COMPUTE A SOLUTION. C METHOD - THE ALGORITHM USED IS GAUSSIAN ELIMINATION WITH PARTIAL C -1 C PIVOTING. IN ESSENCE THE ROUTINE GENERATES A MATRIX L SUCH C -1 C THAT L *A = U, WHERE U IS AN UPPER TRIANGULAR MATRIX. THEN IT C SOLVES THE SYSTEM A*X = P BY MEANS OF THE EQUIVALENT SYSTEM C -1 -1 C U*X = L *A*X = L *P BY BACK SUBSTITUTION. C -1 C THE L MATRIX CAN BE WRITTEN AS A PRODUCT OF THE FORM C -1 C L = L *P *....*L *P WHERE EACH P IS A PERMUTATION C N-1 N-1 1 1 K C MATRIX OBTAINED BY INTERCHANGING AT MOST TWO ROWS OF THE C IDENTITY MATRIX. ( THIS REPRESENTS THE INTERCHANGING OF TWO C ROWS). THE L MATRICES ARE ELIMINATION MATRICES WHICH ARE C K C CHOSEN TO INTRODUCE ZEROS IN THE LAST N-K ENTRIES OF THE K-TH C COLUMN OF THE MATRIX. C PAGE 3 C C -1 -1 C THE CALCULATIONS OF L *A AND L *P ARE DONE BY PERFORMING C THE PERMUTATIONS ON A AND P RESPECTIVELY. THE ACTUAL L AND P C K K C ARE NOT COMPUTED. C SUBROUTINES CALLED: DMATDT C REFERENCE: C G. W. STEWART, INTRODUCTION TO MATRIX COMPUTATIONS, C ACADEMIC PRESS, 1973. 2 REAL*8 A(N,1),DET,P(LL,1) 3 REAL*8 DNORM,DEN,DMULT,DSUM,DISIGN 4 DIMENSION IV(1) 5 NRS=NRS1 6 IF (NRS.EQ.0) IDET=1 8 DISIGN=1.0D+00 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:15 NAME:MATEQ PAGE: 19 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 9 DET=0.0D+00 10 JFLG=0 C C JFLG IS A TROUBLE FLAG.UPON EXIT IF JFLG=0 THEN THE MATRIX WAS PROCESS C WITHOUT TROUBLE.IF JFLG=1 EITHER THE MATRIX IS SINGULAR OR TROUBLE C OCCURED.ISIGN=-ISIGN EVERY TIME A ROW IS INTERCHANGED.THIS IS USED TO C INSURE THAT THE DETERMINANT HAS THE PROPER SIGN. C 11 M1=M-1 12 DO 100 I=1,M 1 13 100 IV(I)=I 14 IF (NRS) 500,200,500 15 200 DO 300 I=1,M 1 16 DO 300 J=1,M 2 17 300 P(I,J)=0.0D+00 18 DO 400 I=1,M 1 19 400 P(I,I)=1.0D+00 20 NRS=M C C INSTEAD OF ACTUALLY INTERCHANGING ROWS A POINTER ARRAY IS USED TO KEEP C TRACK OF THE ROW POSITIONS. C C BEGIN ELIMINATION LOOP. C 21 500 DO 1200 K=1,M1 1 22 ICOL=K 1 23 IPCOL=K C C SEARCHING FOR LARGEST ELEMENT IN ABSOLUTE VALUE IN COLUMN K. C 1 24 DNORM=A(IV(K),K) 1 25 IFLG=0 1 26 KK=K+1 1 27 DO 600 J=KK,M 2 28 IF (DABS(A(IV(J),K)).LE.DABS(DNORM)) GO TO 600 2 29 IFLG=1 2 30 IPCOL=IV(J) 2 31 DNORM=A(IPCOL,K) 2 32 600 CONTINUE C C IF IFLG=0 NO ROW INTERCHANGE TOOK PLACE.IF IFLG=1 A ROW INTERCHANGE C TOOK PLACE AND THE POINTER ARRAY IV MUST BE UPDATED. C 1 33 IF (IFLG.EQ.0) GO TO 800 1 34 ISAVE=IV(ICOL) 1 35 IV(ICOL)=IPCOL 1 36 ICOL1=ICOL+1 1 37 DO 700 L=ICOL1,M 2 38 IF (IV(L).EQ.IPCOL) IV(L)=ISAVE 2 40 700 CONTINUE 1 41 DISIGN=-DISIGN 1 42 800 IF (DNORM.EQ.0.0D+00) GO TO 1900 C C BEGIN ELIMINATION OF ROW BELOW IV(K).DEN IS THE PIVOT ELEMENT. C 1 43 K1=K+1 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:15 NAME:MATEQ PAGE: 20 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 1 44 DO 1100 IM=K1,M C C BEFORE ACTUALLY ELIMINATING WE CHECK TO SEE IF A(IV(IM),K) HAS C ALREADY BEEN ANNIHILATED. C 2 45 IF (A(IV(IM),K).EQ.0.0D+00) GO TO 1100 C C CALCULATE ELIMINATION FACTOR. C 2 46 DMULT=-A(IV(IM),K) C C WE NOW CALCULATE VALUE OF OTHER ELEMENTS IN ROW IV(IM). C 2 47 DO 900 NN=K1,M 3 48 900 A(IV(IM),NN)=(DMULT*A(IV(K),NN))/DNORM+A(IV(IM),NN) 2 49 IF (NRS.LE.0) GO TO 1100 2 50 DO 1000 IN=1,NRS 3 51 1000 P(IV(IM),IN)=(DMULT*P(IV(K),IN))/DNORM+P(IV(IM),IN) 2 52 1100 CONTINUE 1 53 1200 CONTINUE C C CALCULATE VALUE OF DETERMINANT. C 54 IF (A(IV(M),M).EQ.0.0D0) GO TO 1900 55 DET=DISIGN 56 IF (IDET.NE.0) CALL DMATDT(A,N,M,DET,IV,IDET) 58 IF (DET.EQ.0.0D+00) GO TO 1900 59 IF (NRS.LE.0) GO TO 2000 C C WE START SOLVING RIGHT HAND SIDES.THE SOLUTION REPLACES THE RIGHT HAND C VECTOR. C 60 1300 N1=M-1 61 DO 1600 JJ=1,NRS C C BEGIN BACK SUBSTITUTION. C 1 62 P(IV(M),JJ)=P(IV(M),JJ)/A(IV(M),M) 1 63 DO 1500 I=1,N1 2 64 DSUM=0.0D+00 2 65 DO 1400 J=1,I 3 66 1400 DSUM=DSUM-A(IV(M-I),M-J+1)*P(IV(M-J+1),JJ) 2 67 1500 P(IV(M-I),JJ)=(P(IV(M-I),JJ)+DSUM)/A(IV(M-I),M-I) 1 68 1600 CONTINUE 69 DO 1800 JJ=1,NRS 1 70 DO 1700 IND=1,M 2 71 1700 A(IND,1)=P(IV(IND),JJ) 1 72 DO 1800 IND=1,M 2 73 1800 P(IND,JJ)=A(IND,1) 74 RETURN 75 1900 JFLG=1 76 IDET=0 77 2000 RETURN 78 END 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:15 NAME:MATEQ PAGE: 21 0SYMBOL CROSS REFERENCE DICTIONARY 0PROGRAM NAME: MATEQ 0TAGS: A-ARRAY I-INTRINSIC FUNCTION S-ASSIGNED C-COMMON K-NAMED CONSTANT T-EXPLICITLY TYPED D-DUMMY ARGUMENT N-ENTRY V-INITIAL VALUE E-EQUIVALENCED P-PROMOTED X-EXTERNAL SUBPROGRAM F-STATEMENT FUNCTION Q-PADDED Y-DYNAMIC COMMON G-GENERIC NAME R-SUBPROGRAM NAME Z-EXTENDED COMMON 0NAME TYPE TAG DECLARED REFS (F:REFD S:SET B:REFD/MAY BE SET) +______ ____ ______ ________ ________________________________________ 0A R*8 ADT 1 2 24F 28F 31F 45F 46F 48F 48F 48S 54F 57B 62F 66F 67F 71S 73F DABS R*8 I 28 28 DEN R*8 T 3 UNREFERENCED DET R*8 DT 1 2 9S 55S 57B 58F DISIGN R*8 T 3 8S 41F 41S 55F DMATDT X 57F DMULT R*8 T 3 46S 48F 51F DNORM R*8 T 3 24S 28F 31S 42F 48F 51F DSUM R*8 T 3 64S 66F 66S 67F I I*4 12S 13F 13B 15S 17B 18S 19F 19B 63S 65F 66F 67F 67F 67F 67B ICOL I*4 22S 34F 35F 36F ICOL1 I*4 36S 37F IDET I*4 D 1 7S 56F 57B 76S IFLG I*4 25S 29S 33F IM I*4 44S 45F 46F 48F 48F 51F 51B IN I*4 50S 51F 51F 51B IND I*4 70S 71F 71B 72S 73F 73B IPCOL I*4 23S 30S 31F 35F 38F ISAVE I*4 34S 39F IV I*4 AD 1 4 13S 24F 28F 30F 34F 35S 38F 39S 45F 46F 48F 48F 48F 51F 51F 51F 54F 57B 62F 62F 62F 66F 66F 67F 67F 67F 71F J I*4 16S 17B 27S 28F 30B 65S 66F 66B JFLG I*4 D 1 10S 75S JJ I*4 61S 62F 62F 66F 67F 67B 69S 71F 73B K I*4 21S 22F 23F 24F 24F 26F 28F 31F 43F 45F 46F 48F 51B KK I*4 26S 27F K1 I*4 43S 44F 47F L I*4 37S 38F 39B 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:15 NAME:MATEQ PAGE: 22 0TAGS: A-ARRAY I-INTRINSIC FUNCTION S-ASSIGNED C-COMMON K-NAMED CONSTANT T-EXPLICITLY TYPED D-DUMMY ARGUMENT N-ENTRY V-INITIAL VALUE E-EQUIVALENCED P-PROMOTED X-EXTERNAL SUBPROGRAM F-STATEMENT FUNCTION Q-PADDED Y-DYNAMIC COMMON G-GENERIC NAME R-SUBPROGRAM NAME Z-EXTENDED COMMON 0NAME TYPE TAG DECLARED REFS (F:REFD S:SET B:REFD/MAY BE SET) +______ ____ ______ ________ ________________________________________ 0LL I*4 D 1 2 M I*4 D 1 11F 12F 15F 16F 18F 20F 27F 37F 44F 47F 54F 54F 57B 60F 62F 62F 62F 62F 66F 66F 66F 67F 67F 67F 67F 70F 72F MATEQ R 1 M1 I*4 11S 21F N I*4 D 1 2 57B NN I*4 47S 48F 48F 48B NRS I*4 5S 6F 14F 20S 49F 50F 59F 61F 69F NRS1 I*4 D 1 5F N1 I*4 60S 63F P R*8 ADT 1 2 17S 19S 51F 51F 51S 62F 62S 66F 67F 67S 71F 73S 0LABEL CROSS REFERENCE DICTIONARY 0TAGS: A-USED AS ARGUMENT F-FORMAT S-USED IN ASSIGN STATEMENT B-OBJECT OF BRANCH N-NON-EXECUTABLE 0 LABEL TAG DEFINED REFERENCED +____________ ___ _______ ___________________________________________ 0 100 13 12 200 B 15 14 300 17 15 16 400 19 18 500 B 21 14 14 600 B 32 27 28 700 40 37 800 B 42 33 900 48 47 1000 51 50 1100 B 52 44 45 49 1200 53 21 1300 60 UNREFERENCED 1400 66 65 1500 67 63 1600 68 61 1700 71 70 1800 73 69 72 1900 B 75 42 54 58 2000 B 77 59 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:15 NAME:MATEQ PAGE: 23 0*STATISTICS* SOURCE STATEMENTS: 75, PROGRAM SIZE: 3564 BYTES, PROGRAM NAME: MATEQ, PAGE: 17 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATEQ** END OF COMPILATION 2 ****** TIME STAMP: 92.09900.12.15 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:16 PAGE: 24 0OPTIONS IN EFFECT: NOLIST NOMAP XREF GOSTMT NODECK SOURCE TERM OBJECT FIXED TRMFLG SRCFLG NOSYM NORENT SDUMP(ISN) SXM NOVECTOR IL(DIM) NOTEST SC(*) NODC NOEC NOEMODE NOICA NODIRECTIVE NODBCS NOSAA NOPARALLEL NOSAVE NOTABS OPT(2) LANGLVL(77) NOFIPS FLAG(I) AUTODBL(NONE) LINECOUNT(60) CHARLEN(500) 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 1 SUBROUTINE MATDT(A,IA,N,DET,IV,IDET) C SUBROUTINE MATDT IS DMATDT FROM THE UICC SUBROUTINE LIBRARY. 2 REAL*8 A(IA,1),DET,B,LOG16 3 INTEGER*4 IV(1),K 4 EQUIVALENCE (B,K) 5 NUM=16777216 6 LOG16=.120411998265592457D+01 7 IF (A(IV(N),N).EQ.0.0D+00) GO TO 300 8 L=0 9 DO 100 I=1,N 1 10 B=DABS(A(IV(I),I)) 1 11 K=K/NUM-64 1 12 L=L+K 1 13 100 DET=DET*(A(IV(I),I)/16.0D+00**K) 14 B=DABS(DET) 15 K=K/NUM-64 16 IW=L+K 17 IF ((IW.LT.-64).OR.(IW.GT.63)) GO TO 200 18 DET=DET*16.0D+00**L 19 IDET=0 20 GO TO 400 21 200 DET=DET*16.0D+00**(-K) 22 IDET=L+K 23 B=IDET*LOG16 24 IDET=B 25 B=B-DFLOAT(IDET) 26 DET=DET*1.0D+01**B 27 GO TO 400 28 300 DET=0.0D+00 29 IDET=0 30 400 RETURN 31 END 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:16 NAME:MATDT PAGE: 25 0SYMBOL CROSS REFERENCE DICTIONARY 0PROGRAM NAME: MATDT 0TAGS: A-ARRAY I-INTRINSIC FUNCTION S-ASSIGNED C-COMMON K-NAMED CONSTANT T-EXPLICITLY TYPED D-DUMMY ARGUMENT N-ENTRY V-INITIAL VALUE E-EQUIVALENCED P-PROMOTED X-EXTERNAL SUBPROGRAM F-STATEMENT FUNCTION Q-PADDED Y-DYNAMIC COMMON G-GENERIC NAME R-SUBPROGRAM NAME Z-EXTENDED COMMON 0NAME TYPE TAG DECLARED REFS (F:REFD S:SET B:REFD/MAY BE SET) +______ ____ ______ ________ ________________________________________ 0A R*8 ADT 1 2 7F 10F 13F B R*8 ET 2 4 10S 14S 23S 24F 25F 25S 26F DABS R*8 I 10 14 DET R*8 DT 1 2 13F 13S 14F 18F 18S 21F 21S 26F 26S 28S DFLOAT R*8 I 25 I I*4 9S 10F 10F 13F 13B IA I*4 D 1 2 IDET I*4 D 1 19S 22S 23F 24S 25F 29S IV I*4 ADT 1 3 7F 10F 13F IW I*4 16S 17F 17F K I*4 ET 3 4 11F 11S 12F 13F 15F 15S 16F 21F 22F L I*4 8S 12F 12S 16F 18F 22F LOG16 R*8 T 2 6S 23F MATDT R 1 N I*4 D 1 7F 7F 9F NUM I*4 5S 11F 15F 0LABEL CROSS REFERENCE DICTIONARY 0TAGS: A-USED AS ARGUMENT F-FORMAT S-USED IN ASSIGN STATEMENT B-OBJECT OF BRANCH N-NON-EXECUTABLE 0 LABEL TAG DEFINED REFERENCED +____________ ___ _______ ___________________________________________ 0 100 13 9 200 B 21 17 300 B 28 7 400 B 30 20 27 0*STATISTICS* SOURCE STATEMENTS: 31, PROGRAM SIZE: 1552 BYTES, PROGRAM NAME: MATDT, PAGE: 24 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATDT** END OF COMPILATION 3 ****** TIME STAMP: 92.09900.12.16 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN APR 08, 1992 00:12:16 PAGE: 26 0SUMMARY OF MESSAGES AND STATISTICS FOR ALL COMPILATIONS 0*STATISTICS* SOURCE STATEMENTS: 307, PROGRAM SIZE: 569444 BYTES, PROGRAM NAME: MAIN#, PAGE: 1 *STATISTICS* NO DIAGNOSTICS GENERATED. **MAIN#** END OF COMPILATION 1 ****** TIME STAMP: 92.09900.12.16 0*STATISTICS* SOURCE STATEMENTS: 75, PROGRAM SIZE: 3564 BYTES, PROGRAM NAME: MATEQ, PAGE: 17 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATEQ** END OF COMPILATION 2 ****** TIME STAMP: 92.09900.12.16 0*STATISTICS* SOURCE STATEMENTS: 31, PROGRAM SIZE: 1552 BYTES, PROGRAM NAME: MATDT, PAGE: 24 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATDT** END OF COMPILATION 3 ****** TIME STAMP: 92.09900.12.16 0******* SUMMARY STATISTICS ******* 0 DIAGNOSTICS GENERATED. HIGHEST SEVERITY CODE IS 0.