1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 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 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C CLUSPAC: Software for Mixture-Model Clustering C C C C COPYRIGHT (C) 1991, 1992, 1993 STANLEY L. SCLOVE C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C ALAk7DT CLUSPAC C C VERSION 1.0 5-JAN-94 C C C C PROGRAMMED BY: C C C C Prof. Stanley L. Sclove, Ph.D. 312/996-2681 C C Information & Decision Sciences Dept. M/C 294 C C University of Illinois at Chicago C C 601 So. Morgan Street C C Chicago, IL 60607-7124 C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C CLUSPAC programs implement clustering algorithms which are C C derived under the assumption of Gaussian class-conditional C C distributions. The ISDT* programs in CLUSPAC are based on C C the so-called "classification" likelihood. The MIX* programs C C are based on the mixture-model likelihood. Program C C MIXPDT in CLUSPAC is one of the mixture-model programs for C C clustering multivariate data. (For univariate data the C C "MIX1" programs may be used.) C C C C MIXPDT allows different covariance matrices; MIXPCM C C assumes a common covariance matrix across distributions. C C C C AMNOPDT, for clustering dihedral angles of molecules C C in polypeptide chains, is adapted from MIXPDT. C C C C FISIDT, for clustering (phi,psi), is adapted from C C AMNOPDT, which is for clustering (phi,psi,chi1). C C C C Input: C C ----- C C Number of clusters (K), initial values of means, prior C C probabilities, and covariance matrices. If desired, C C program ISDTPCM.CLUSPAC can be used to obtain these initial C C values. Use program MIXPDTA.CLUSPAC to try a range of C C numbers of clusters (values of K), with automatic setting C 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 2 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C of initial values. C C C C Program restrictions (can be modified): C C -------------------------------------- C C N, sample size, at most 9999; C C IP, number of variables, at most 20; C C K, number of clusters, at most 29; C C MAXITER, maximum number of iterations, 99 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 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 MIXING PROBABILITIES, C C IN FORMAT (5X,F3.2). C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 1 DIMENSION X(9999,20),SUM(29,20),SD(29,3) C 2 DIMENSION AA(9999,3) C 3 DIMENSION F(9999,29),PP(29,9999),FMAX(9999),DSQMIN(9999) C The matrix F is an N x K matrix of values of p.d.f.'s. 4 DIMENSION ICLUS(9999),ICLSOL(9999) 5 DIMENSION DENOM(9999),XMXPR(9999) 6 DIMENSION DSQ(9999,29) 7 DIMENSION TITLE(18) C 8 DIMENSION NG(29),XBAR(29,20),XBAROLD(29,20),SEED(29,20) 9 DIMENSION DATFMT(18) 10 DIMENSION MEANFT(18) C DIMENSION COVFMT(18) 11 DIMENSION SSD(29,20,20),SIGMA(29,20,20) 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 3 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 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),PREC(29,20,20) 17 DIMENSION XIDET(29),XLGDET(29),TRUDET(29) 18 DIMENSION PR(29) C 19 DOUBLE PRECISION SUM,SUMPXF 20 DOUBLE PRECISION WGSS,SSD 21 DOUBLE PRECISION VARHAT 22 DOUBLE PRECISION P 23 DOUBLE PRECISION DET,TRUDET 24 DOUBLE PRECISION DSQ 25 DOUBLE PRECISION XBAR,XBAROLD 26 DOUBLE PRECISION DEVV,DEVW 27 DOUBLE PRECISION F,BOTTOM C C C C FLOW OF PROGRAM: C C C READ DATA AND INITIAL PARAMETER ESTIMATES. C INVERT COVARIANCE MATRICES. 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 MATRICES). C CLUSTER BY MAXIMUM PROBABILITY OF CLUSTER MEMBERSHIP. C IF CLUSTERING HASN'T CHANGED, STOP AND PRINT RESULTS. C OTHERWISE DO ANOTHER ITERATION (UNLESS TOO MANY HAVE C ALREADY BEEN DONE). C C C 28 DATA PI/3.141593/ C 29 READ (5,36000) TITLE C C WRITE PROGRAM INFORMATION. 30 WRITE (6,10000) 31 WRITE (6,40000) TITLE C C READ SAMPLE SIZE, N. 32 READ (5,12000) N 33 XN = N 34 WRITE (6,15000) N C READ NUMBER OF VARIABLES, IP. 35 READ (5,54000) IP 36 WRITE (6,13000) IP C 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 4 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C READ DATA FORMAT. 37 READ (5,36000) DATFMT C C READ DATA. 38 DO 500 I = 1,N C 1 39 READ (5,DATFMT) ( AA(I,KV),KV=1,3 ), ( X(I,JV),JV=1,IP ) C was: READ (5,DATFMT) (X(I,JV), JV = 1,IP) C 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) (XMIN(JV),JV=1,IP) 56 WRITE (6,66000) (XMAX(JV),JV=1,IP) C C READ K, NUMBER OF CLUSTERS. 57 READ (5,11000) K 58 WRITE (6,26000) K C C READ INITIAL MEANS C READ INPUT FORMAT FOR MEANS: 59 READ (5,36000) MEANFT 60 DO 600 IC=1,K 1 61 READ (5,MEANFT) (XBAR(IC,JV), JV=1,IP) C 1 62 600 CONTINUE C Store initial means into SEED: 63 DO 602 IC = 1,K 1 64 DO 602 IVAR=1,IP 2 65 SEED(IC,IVAR) = XBAR(IC,IVAR) 2 66 602 CONTINUE C C READ INITIAL VALUES OF MIXING PROBABILITIES: 67 DO 650 IC=1,K 1 68 READ (5,25000) PR(IC) C 1 69 650 CONTINUE C C C SET INITIAL VALUES OF COVARIANCE MATRICES: C C READ(5,36000) COVFMT 70 DO 660 IC = 1,K 1 71 DO 660 JV = 1,IP 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 5 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 2 72 DO 660 JW = 1,IP 3 73 SIGMA(IC,JV,JW) = 0.0 3 74 660 CONTINUE 75 DO 665 IC = 1,K 1 76 DO 665 JV = 1,IP 2 77 SIGMA(IC,JV,JV) = 300.00 2 78 665 CONTINUE C C 79 WRITE(6,22000) 80 MAXITER = 99 81 ITER = 1 C 82 700 CONTINUE C C Store old means: 83 DO 810 IC = 1,K 1 84 DO 810 JV = 1,IP 2 85 XBAROLD(IC,JV) = XBAR(IC,JV) 2 86 810 CONTINUE C C 87 WRITE (6,32000) ITER C WRITE CURRENT ESTIMATES OF PARAMETERS: 88 WRITE (6,23000) C WRITE CURRENT ESTIMATES OF MEAN VECTORS:-- 89 WRITE (6,20000) 90 DO 710 IC = 1,K 1 91 WRITE (6,33000) ( XBAR(IC,JV), JV=1,IP ) 1 92 710 CONTINUE 93 WRITE (6,35000) (PR(IC), IC = 1,K) C WRITE CURRENT ESTIMATES OF COVARIANCE MATRICES:- 94 IF (K .GE. 4) GO TO 671 95 DO 670 IC = 1,K 1 96 WRITE(6,42500) IC 1 97 DO 670 JV = 1,IP 2 98 WRITE (6,48000) (SIGMA(IC,JV,JW),JW=1,IP) 2 99 670 CONTINUE C 100 671 CONTINUE C C Copy SIGMA into VARHAT for input to Subroutine MATEQ: 101 DO 680 IC = 1,K 1 102 DO 675 JV = 1,IP 2 103 DO 675 JW = 1,IP 3 104 VARHAT(JV,JW) = SIGMA(IC,JV,JW) 3 105 675 CONTINUE C C CALL SUBROUTINE TO COMPUTE INVERSE COVARIANCE MATRIX: C SET PARAMETERS OF SUBROUTINE CALL: 1 106 IDET = 1 1 107 NRS1 = 0 C C 1 108 CALL MATEQ(VARHAT,IP,20,JFLG,DET,IDET,IV,NRS1,P,20) C ON RETURN, P CONTAINS THE INVERSE MATRIX. 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 6 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 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 1 109 DO 676 JV = 1,IP 2 110 DO 676 JW = 1,IP 3 111 PREC(IC,JV,JW) = P(JV,JW) 3 112 676 CONTINUE C 1 113 IF(DET .LE. 0.0) IDET = 0 1 115 XIDET(IC) = IDET 1 116 IF(DET .LE. 0.0) DET=VARHAT(1,1)*VARHAT(2,2)*VARHAT(3,3) 1 118 IF (DET .LE. 0.0) DET = -DET 1 120 XLGDET(IC) = DLOG(DET) + XIDET(IC)*ALOG(10.0) 1 121 TRUDET(IC) = DET*(10.0**IDET) 1 122 680 CONTINUE C C 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 123 DO 1200 I = 1,N C 1 124 DO 1000 L=1,K 2 125 DSQ(I,L) = 0.0 2 126 DO 1310 JV=1,IP 3 127 DEVV = XBAR(L,JV) - X(I,JV) 3 128 DO 1310 JW=1,IP 4 129 DEVW = XBAR(L,JW) - X(I,JW) 4 130 DSQ(I,L) = DSQ(I,L) + DEVV*PREC(L,JV,JW)*DEVW 4 131 1310 CONTINUE 2 132 IF ( DSQ(I,L) .LT. 0.0 ) DSQ(I,L)=0.0 2 134 ZSQ = DSQ(I,L) C 2 135 IF(TRUDET(L) .LE. 0.0) 2 XTRUDET(L)=SIGMA(L,1,1)*SIGMA(L,2,2)*SIGMA(L,3,3) 2 137 IF ( TRUDET(L) .LE. 0.0 ) TRUDET(L) = -TRUDET(L) C C IF D-SQ IS INORDINATELY LARGE, SET VALUE OF PDF TO ZERO C (IT IS EXTREMELY SMALL ANYWAY, AND THIS AVOIDS UNDERFLOW): 2 139 IF ( ZSQ/2.0 .LE. 174.673 ) GO TO 1090 2 140 F(I, L) = 0.0 2 141 GO TO 1100 C 2 142 1090 CONTINUE 2 143 F(I, L) = EXP(-ZSQ/2.0) 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 7 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 2 144 BOTTOM = DSQRT( TRUDET(L) ) 2 145 F(I, L) = F(I,L)/BOTTOM 2 146 1100 CONTINUE C 2 147 1000 CONTINUE 1 148 1200 CONTINUE C C COMPUTE LOG LIKELIHOOD AND VALUES OF MODEL-SELECTION CRITERIA: C 149 SUMLNF = 0.0 150 DO 2200 I=1,N 1 151 SUMPXF = 0.0 1 152 DO 2100 IC=1,K 2 153 SUMPXF = SUMPXF + PR(IC)*F(I,IC) 2 154 2100 CONTINUE C 1 155 IF ( SUMPXF .LE. 0.0 ) GO TO 2200 C 1 156 SUMLNF = SUMLNF + DLOG(SUMPXF) 1 157 2200 CONTINUE C 158 XMN2LL = -2.0*SUMLNF C 159 WRITE (6,30000) XMN2LL C C C COMPUTE MODEL SELECTION CRITERIA C C PARAMETERS: C K MEAN VECTORS OF DIMENSION P AND K P-BY-P COVARIANCE MATRICES, C WHERE P IS THE NUMBER OF VARIABLES, AND K-1 INDEPENDENT MIXING C PROBABILITIES. 160 NOPARM = K*IP + K*IP*(IP+1)/2 + (K-1) 161 WRITE (6,72000) NOPARM 162 AIC = XMN2LL + 2.0*NOPARM 163 SCH = XMN2LL + ALOG(XN)*NOPARM 164 WRITE (6,70000) AIC 165 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): 166 DO 1350 I = 1,N 1 167 DENOM(I) = 0.0 1 168 DO 1350 IC=1,K 2 169 DENOM(I) = DENOM(I) + PR(IC)*F(I,IC) 2 170 1350 CONTINUE 171 DO 1400 I = 1,N 1 172 DO 1400 IC=1,K 2 173 IF ( DENOM(I) .GT. 0.0 ) GO TO 1410 2 174 PP(IC,I) = 0.0 2 175 GO TO 1400 2 176 1410 CONTINUE 2 177 PP(IC,I)= PR(IC)*F(I,IC)/DENOM(I) 2 178 1400 CONTINUE 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 8 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C 179 WRITE(6,76000) 180 DO 1420 I = 1,4 1 181 WRITE(6,82000) ( PP(IC,I), IC = 1,K ) 1 182 1420 CONTINUE C C C UPDATE PARAMETER ESTIMATES: C C C UPDATE CLUSTER MIXING PROBABILITIES PR(IC):-- 183 DO 3800 IC = 1,K 1 184 PR(IC) = 0.0 1 185 DO 3800 I = 1,N 2 186 PR(IC) = PR(IC) + PP(IC,I) 2 187 3800 CONTINUE 188 DO 3900 IC = 1,K 1 189 PR(IC) = PR(IC)/N 1 190 3900 CONTINUE 191 DO 1750 IG = 1,K 1 192 DO 1750 JV = 1,IP 2 193 SUM(IG,JV) = 0.0 2 194 DO 1750 JW = 1,IP 3 195 SSD(IG,JV,JW) = 0.0 3 196 1750 CONTINUE C C UPDATE MEANS:-- 197 DO 1875 IC = 1,K 1 198 DO 1875 JV = 1,IP 2 199 DO 1875 I = 1,N 3 200 SUM(IC,JV) = SUM(IC,JV) + PP(IC,I)*X(I,JV) 3 201 1875 CONTINUE 202 DO 1900 IG = 1,K 1 203 XMINOBS = 0.5 1 204 IF (N*PR(IG) .LT. XMINOBS) GO TO 2050 1 205 GO TO 2150 1 206 2050 WRITE (6,74000) IG, XMINOBS 1 207 GO TO 4000 1 208 2150 CONTINUE 1 209 DO 1900 JV = 1,IP 2 210 XBAR(IG,JV) = SUM(IG,JV)/(N*PR(IG)) 2 211 1900 CONTINUE C C 212 DO 3600 IC=1,K 1 213 DO 3600 JV=1,IP 2 214 DO 3600 JW=JV,IP 3 215 DO 3600 I=1,N 4 216 DEVV=X(I,JV)-XBAR(IC,JV) 4 217 DEVW=X(I,JW)-XBAR(IC,JW) 4 218 TERM=PP(IC,I)*DEVV*DEVW 4 219 SSD(IC,JV,JW)=SSD(IC,JV,JW)+TERM 4 220 3600 CONTINUE C 221 DO 3700 IC=1,K 1 222 DO 3700 JV=2,IP 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 9 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 2 223 DO 3700 JW=1,JV-1 3 224 SSD(IC,JV,JW)=SSD(IC,JW,JV) 3 225 3700 CONTINUE C 226 DO 3710 IC=1,K 1 227 DO 3710 JV=1,IP 2 228 DO 3710 JW=1,IP 3 229 SIGMA(IC,JV,JW)=SSD(IC,JW,JV)/(N*PR(IC)) 3 230 3710 CONTINUE C C POOL: C 231 DO 1950 JV = 1,IP 1 232 DO 1950 JW = 1,IP 2 233 WGSS(JV,JW) = 0.0 2 234 1950 CONTINUE C 235 DO 2300 JV = 1,IP 1 236 DO 2300 JW = 1,IP 2 237 DO 2300 IC = 1,K 3 238 WGSS(JV,JW) = WGSS(JV,JW) + PR(IC)*SSD(IC,JV,JW) 3 239 2300 CONTINUE C COMPUTE VARHAT, MLE OF COMMON COVARIANCE MATRIX: 240 DO 2400 JV = 1,IP 1 241 DO 2400 JW = 1,IP 2 242 VARHAT(JV,JW) = WGSS(JV,JW)/N 2 243 2400 CONTINUE C (END PARAMETER-ESTIMATE UPDATE SEQUENCE) C 244 IF (ITER .EQ. 1) GO TO 900 C STORE OLD LABELS: 245 DO 800 I = 1,N 1 246 ICLSOL(I) = ICLUS(I) 1 247 800 CONTINUE C C 248 900 CONTINUE C C COMPUTE NEW LABELS BY MAX POSTERIOR PROBABILITY: 249 DO 1600 I = 1,N 1 250 XMXPR(I) = PP(1,I) 1 251 ICLUS(I) = 1 1 252 DO 1600 IC = 2,K 2 253 IF ( PP(IC,I) .GT. XMXPR(I) ) GO TO 1500 2 254 GO TO 1600 2 255 1500 XMXPR(I) = PP(IC,I) 2 256 ICLUS(I) = IC 2 257 1600 CONTINUE C C 258 IF (N .GE. 31) GO TO 250 259 WRITE (6,15500) C 260 WRITE (6,16000) 261 WRITE (6,18000) (I, ICLUS(I), I=1,N) 262 250 CONTINUE 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 10 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C C C 263 IF (ITER .EQ. 1) GO TO 3000 264 DO 2900 I = 1,N 1 265 IF (ICLUS(I) .EQ. ICLSOL(I)) GO TO 2900 C If any case changed clusters, another iteration will be done: 1 266 GO TO 3000 1 267 2900 CONTINUE C If no case changed cluster, a test of convergence of C estimates of the means will be done: 268 TOL = 0.5 269 DO 2901 IC = 1,K 1 270 DO 2901 JV = 1,IP 2 271 TEST = ABS( XBAR(IC,JV)-XBAROLD(IC,JV) ) 2 272 IF ( TEST .LT. TOL ) GO TO 2901 C If any mean changed much, another iteration will be done: 2 273 GO TO 3000 2 274 2901 CONTINUE C If no mean has changed much, stop iterating: 275 GO TO 3300 C 276 3000 CONTINUE C Maximum number of iterations is set at beginning of program C (currently it is 99). 277 IF (ITER.GE.MAXITER) GO TO 3100 278 ITER = ITER + 1 279 GO TO 700 280 3100 WRITE (6,68000) 281 GO TO 3300 C C 282 3300 CONTINUE C C C COUNT NUMBERS IN CLUSTERS: 283 DO 3310 IC = 1,K 1 284 NG(IC) = 0 1 285 3310 CONTINUE C 286 DO 3320 I = 1,N 1 287 IC = ICLUS(I) 1 288 NG(IC) = NG(IC) + 1 1 289 3320 CONTINUE C C C PRINT FINAL RESULTS C C 290 WRITE (6,34000) (NG(IC),IC=1,K) 291 WRITE (6,35000) (PR(IC),IC=1,K) C 292 DO 2800 IC = 1,K 1 293 WRITE (6,28000) IC, (XBAR(IC,JV),JV=1,IP) 1 294 2800 CONTINUE C 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 11 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C 295 DO 2501 IC = 1,K 1 296 WRITE(6,42500) IC C 1 297 WRITE (6,28000) IC, (XBAR(IC,JV),JV=1,IP) C 1 298 WRITE (6,42000) 1 299 DO 2500 JV=1,IP 2 300 WRITE (6,48000) (SIGMA(IC,JV,JW),JW=1,IP) 2 301 2500 CONTINUE C C Compute and print standard deviations: 1 302 WRITE (6,48600) C 1 303 SD(IC,1) = SQRT(SIGMA(IC, 1,1 )) 1 304 SD(IC,2) = SQRT(SIGMA(IC, 2,2 )) C 1 305 SD1 = SD(IC,1) 1 306 SD2 = SD(IC,2) C 1 307 WRITE (6,48500) SD1,SD2 C C C Compute correlation matrix: 1 308 DO 2503 JV = 1,IP 2 309 JVN1 = JV+1 2 310 DO 2503 JW = JVN1,IP 3 311 SD1 = SQRT(SIGMA(IC,JV,JV)) 3 312 SD2 = SQRT(SIGMA(IC,JW,JW)) 3 313 SIGMA(IC,JV,JW) = SIGMA(IC,JV,JW)/(SD1*SD2) 3 314 2503 CONTINUE 1 315 DO 2505 JV = 2,IP 2 316 JVM1 = IP-1 2 317 DO 2505 JW = 1,JVM1 3 318 SIGMA(IC,JV,JW) = SIGMA(IC,JW,JV) 3 319 2505 CONTINUE 1 320 DO 2506 JV = 1,IP 2 321 SIGMA(IC,JV,JV) = 1.0 2 322 2506 CONTINUE C C Write correlation matrix: 1 323 WRITE (6,48800) C 1 324 WRITE (6,48700) SIGMA(IC, 1, 2) C C 1 325 2501 CONTINUE C 326 WRITE (6,10000) 327 WRITE (6,48955) 328 WRITE (6,10000) 329 WRITE (6,40000) TITLE 330 WRITE (6,15000) N 331 WRITE (6,30000) XMN2LL 332 WRITE (6,48952) 333 DO 2508 IC = 1,K 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 12 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C 1 334 WRITE (6,48901) IC,NG(IC), SEED(IC,1),SEED(IC,2), 1 1XBAR(IC,1),XBAR(IC,2), SD(IC,1),SD(IC,2) C 1 335 2508 CONTINUE 336 WRITE (6,49000) 337 DO 2509 IC = 1,K 1 338 WRITE (6,48900) IC, PR(IC),NG(IC),XBAR(IC,1),XBAR(IC,2), 1 1 SD(IC,1),SD(IC,2), 1 2SIGMA(IC,1,2) C 1 339 2509 CONTINUE C C 340 IF (ITER .GE. MAXITER + 1 ) WRITE (6,68000) C 342 DO 3525 I = 1,N 1 343 FMAX(I) = 0.0 1 344 DSQMIN(I) = 10.0**10 1 345 DO 3525 IC = 1,K 2 346 IF ( F(I,IC) .GT. FMAX(I) ) FMAX(I) = F(I,IC) 2 348 IF ( DSQ(I,IC) .LT. DSQMIN(I) ) DSQMIN(I) = DSQ(I,IC) 2 350 3525 CONTINUE C 351 WRITE (6,52000) 352 WRITE (6,52100) C C C Seed points: C C B -139 +135 1 beta-poly(L-alanine) C P -80 +150 2 polyglycine II C T -95 -10 3 C R -57 -47 4 right alpha-helix C L +57 +47 5 left alpha-helix C B2 -180 -180 1 C B3 +180 +180 1 C C Cluster 6, with a center near (-180,-180), will be C moved to near (-180,+180): 353 DO 3510 I = 1,N 1 354 IF(ICLUS(I) .EQ. 6 ) X(I,1) = X(I,1) 1 356 IF(ICLUS(I) .EQ. 6 ) X(I,2) = 360 + X(I,2) C Cluster 7, with a center near (+180,+180), will be C moved to near (-180,+180): 1 358 IF(ICLUS(I) .EQ. 7 ) X(I,1) = X(I,1)-360 1 360 IF(ICLUS(I) .EQ. 7 ) X(I,2) = X(I,2) 1 362 3510 CONTINUE C 363 DO 3500 IC = 1,K 1 364 WRITE (6,53000) IC 1 365 DO 3500 I = 1,N C C Cases with min D-sq > 5.99 (upper 5% point) will be deleted C in next run: 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 13 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 2 366 IF( DSQMIN(I) .GT. 5.99) GO TO 3505 C 2 367 IF(ICLUS(I) .EQ. IC) WRITE (6,50000) I,ICLUS(I), 2 X ( AA(I,KV),KV=1,3 ), 2 X( X(I,JV), JV = 1,IP ), PP(IC,I), F(I,IC), FMAX(I),DSQMIN(I) 2 369 3505 CONTINUE C 2 370 3500 CONTINUE C 371 WRITE (6,84000) C 372 IF (ITER .GE. MAXITER + 1 ) WRITE (6,68000) C 374 4000 STOP C C 375 10000 FORMAT('1',//,' ..........................................'// X1X, ' Program ALAk7DT CLUSPAC ' / X1X, ' MIXTURE MODEL CLUSTERING FOR AMINO ACIDS',/, X1X, ' MODEL WITH VARYING COVARIANCE MATRICES '// X' Developed and programmed by: '/ X' Prof. Stanley L. Sclove, Ph.D. '/ X' Information & Decision Sciences Dept. M/C 294 '/ X' College of Business Administration '/ X' University of Illinois at Chicago '/ X' 601 South Morgan Street '// X' Chicago, IL 60607-7124 '// X' 312/996-2681 '// X' FISIDT CLUSPAC (from AMNOPDT CLUSPAC) '/ X' ALAk7dt CLUSPAC Version 1.0 5-Jan-94 '/ X' COPYRIGHT (C) 1991-1993 STANLEY L. SCLOVE', X' ALL RIGHTS RESERVED.'//) 376 11000 FORMAT(2X,I2) 377 12000 FORMAT(2X,I4) 378 13000 FORMAT(1X,'Number of variables used ...................',I3 ) 379 15000 FORMAT(1X,'Number of observations (sample size), n ...', I4 ) 380 15500 FORMAT(/ 1X,'CLUSTERING:' ) 381 16000 FORMAT(/,1X,'CASES AND LABELS:--' ) 382 18000 FORMAT(15(I5,I3)) 383 20000 FORMAT(/1X,' Means: '/) 384 22000 FORMAT(' FIRST ITERATION USES THE INITIAL PARAMETER ESTIMATES', X' PROVIDED BY THE USER.' ) 385 25000 FORMAT(5X, F3.2) 386 23000 FORMAT(/1X, 'CURRENT ESTIMATES OF PARAMETERS: ' ) 387 26000 FORMAT('1',/, 1X,'K = ',I2,' CLUSTERS'/ ) 388 28000 FORMAT(1X,'Mean vector for Cluster ',I2,': ',(8F12.0/)) 389 30000 FORMAT( 1X,' MINUS 2 LOG LIKELIHOOD = ', F12.0/) 390 32000 FORMAT(/, 1X,'ITERATION ', I2,/ ) 391 34000 FORMAT(/,1X,'Frequencies:',1X,9(I10,3X)/) 392 35000 FORMAT(/,1X,' Mixing probabilities: ', 3X,17(F5.3,1X)/) 393 33000 FORMAT( 1X, 2F7.0) 394 36000 FORMAT(18A4) 395 40000 FORMAT(//,1X,18A4//) 396 42000 FORMAT(/, ' Covariance matrix of phi, psi: ') 397 42500 FORMAT( ' Distribution ',I3 ) 398 48000 FORMAT(1X,8F12.1/) 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 14 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 399 48500 FORMAT(1X,2F6.1) 400 48600 FORMAT(1X,'Standard deviations of phi, psi: ') 401 48700 FORMAT(1X, F13.2/) 402 48800 FORMAT(1X,'Correlation between phi and psi: ') C C WRITE (6,48900) IC, PR(IC),NG(IC),XBAR(IC,1),XBAR(IC,2), C 1 SD(IC,1),SD(IC,2), C 2SIGMA(IC,1,2) 403 48900 FORMAT(1X,I2,1X,F5.3,I5,2F7.0,1X,2F5.0,1X, F5.1) C 404 48901 FORMAT(1X,I2,1X, I4, 2F6.0,3X,2F6.0,3X,2F6.1) C 405 48955 FORMAT(1X,'SUMMARY OF RESULTS '//) 406 48952 FORMAT(' Clus- Seeds',17X,'Final Means Std. Devs.'/ A' ter Freq phi psi phi psi phi psi '/ B' ------------------------------------------------------ ') C 407 49000 FORMAT(1X,'SUMMARY OF RESULTS'/,40X,' Correlation '/ 1' Clus- Means Std.Devs. between ,'/ 2' ter Prob Freq phi psi phi psi phi and psi '/ 5' ------------------------------------------------ ' ) C C SUMMARY OF RESULTS Correlations C Clus- Means Std. Devs. phi, phi, psi, C ter Prob Freq phi psi chi1 phi psi chi1 psi chi1 chi1 C --- ---- ---- ------------------- ------------- --------------- C C IF(ICLUS(I) .EQ. IC) WRITE (6,50000) I,ICLUS(I), C X ( AA(I,KV),KV=1,3 ), C X( X(I,JV), JV = 1,IP ), PP(IC,I), F(I,IC), FMAX(I),DSQMIN(I) C 408 50000 FORMAT(1X,I4,1X,I2, 1X, 3A1, 2F7.0, F7.2,2E11.2, F7.1) C 409 52000 FORMAT( 1X,'CASE, LABEL / DATA' ) 410 52100 FORMAT(/, 1X, 30X, 'F(I) MAX F(I|C) min DSQ(I,C) '/) 411 53000 FORMAT( 1X,' CLUSTER ', I2 ) 412 54000 FORMAT(3X,I2) 413 58000 FORMAT(/1X,'CONVERGENCE: NO CASE CHANGED CLUSTERS AFTER ', X'ITERATION ',I2,'. RESULTS ARE PRINTED BELOW.'//) 414 60000 FORMAT(/,1X,'JFLG = ',I2,'. IF JFLG=0, COMPUTATION OF DET', X' WENT WELL; OTHERWISE, THERE WAS TROUBLE OR MATRIX WAS ', X'ILL-CONDITIONED.'//) 415 62000 FORMAT(/1X,'DET = ',F13.1,' IDET = ',I3,5X, X'ACTUAL DET. = DET*10**IDET',//) 416 64000 FORMAT(/1X,'Minimum of each variable: ',1X,2F9.1) 417 66000 FORMAT(/1X,'Maximum of each variable: ',1X,2F9.1) 418 68000 FORMAT(1X,'PROGRAM HAS NOT CONVERGED IN 99 ITERATIONS. STOP') 419 70000 FORMAT(1X,' AIC = ', F15.4 ) 420 71000 FORMAT(1X,'SCHWARZ CRITERION = ', F15.4 ) 421 72000 FORMAT( 1X,'NUMBER OF PARAMETERS = ',I4 ) 422 74000 FORMAT(1X,'EXPECTED NUMBER OF OBSERVATIONS IN CLUSTER ',I3, X' IS LESS THAN ',F7.2,'. STOP.'/) 423 76000 FORMAT(//' POSTERIOR PROBS OF GROUP MEMBERSHIP FOR 1ST 4 CASES:') 424 82000 FORMAT(1X,29F5.2) 425 84000 FORMAT(1X,'PROGRAM ENDED NORMALLY.') 426 END 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 15 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) +_______ ____ ______ ________ _______________________________________ 0AA R*4 A 2 39S 368F ABS GI 271 AIC R*4 162S 164F ALOG R*4 I 120 163 BOTTOM R*8 T 27 144S 145F DATFMT R*4 A 9 37S 39 DENOM R*4 A 5 167S 169F 169S 173F 177F DET R*8 T 23 108B 113F 116F 117S 118F 119F 119S 120F 121F DEVV R*8 T 26 127S 130F 216S 218F DEVW R*8 T 26 129S 130F 217S 218F DLOG R*8 I 120 156 DSQ R*8 AT 6 24 125S 130F 130S 132F 133S 134F 348F 349F DSQMIN R*4 A 3 344S 348F 349S 366F 368F DSQRT R*8 I 144 EXP GI 143 F R*8 AT 3 27 140S 143S 145F 145S 153F 169F 177F 346F 347F 368F FMAX R*4 A 3 343S 346F 347S 368F I I*4 38S 39 39 40F 49F 50F 51F 52B 123S 125F 127F 129F 130F 130F 132F 133F 134F 140F 143F 145F 145B 150S 153B 166S 167F 169F 169F 169B 171S 173F 174F 177F 177F 177B 180S 181B 185S 186B 199S 200F 200B 215S 216F 217F 218B 245S 246F 246B 249S 250F 250F 251F 253F 253F 255F 255F 256B 261S 261F 261B 264S 265F 265B 286S 287B 342S 343F 344F 346F 346F 347F 347F 348F 348F 349F 349B 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 16 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 353S 354F 355F 355F 356F 357F 357F 358F 359F 359F 360F 361F 361B 365S 366F 367F 368F 368F 368F 368F 368F 368F 368F 368B IC I*4 60S 61B 63S 65F 65B 67S 68B 70S 73B 75S 77B 83S 85F 85B 90S 91B 93S 93S 95S 96F 98B 101S 104F 111F 115F 120F 120F 121B 152S 153F 153B 168S 169F 169B 172S 174F 177F 177F 177B 181S 181S 183S 184F 186F 186F 186B 188S 189F 189B 197S 200F 200F 200B 212S 216F 217F 218F 219F 219B 221S 224F 224B 226S 229F 229F 229B 237S 238F 238B 252S 253F 255F 256B 269S 271F 271B 283S 284B 287S 288F 288F 290S 290S 291S 291S 292S 293F 293B 295S 296F 297F 297F 300F 303F 303F 304F 304F 305F 306F 311F 312F 313F 313F 318F 318F 321F 324B 333S 334F 334F 334F 334F 334F 334F 334F 334B 337S 338F 338F 338F 338F 338F 338F 338F 338B 345S 346F 347F 348F 349B 363S 364F 367F 368F 368B ICLSOL I*4 A 4 246S 265F ICLUS I*4 A 4 246F 251S 256S 261F 265F 287F 354F 356F 358F 360F 367F 368F IDET I*4 106S 108B 114S 115F 121F IG I*4 191S 193F 195B 202S 204F 206F 210F 210F 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 17 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 210B IP I*4 35S 36F 39 43F 48F 55F 56F 61 64F 71F 72F 76F 84F 91F 97F 98F 102F 103F 108B 109F 110F 126F 128F 160F 160F 160F 192F 194F 198F 209F 213F 214F 222F 227F 228F 231F 232F 235F 236F 240F 241F 270F 293F 297F 299F 300F 308F 310F 315F 316F 320F 368F ITER I*4 81S 87F 244F 263F 277F 278F 278S 340F 372F IV I*4 A 15 108B IVAR I*4 64S 65F 65B JFLG I*4 108B JV I*4 39S 39S 43S 44F 44F 45F 45B 48S 49F 49F 50F 50F 51F 51F 52F 52B 55S 55S 56S 56S 61S 61S 71S 73B 76S 77F 77B 84S 85F 85B 91S 91S 97S 98B 102S 104F 104B 109S 111F 111B 126S 127F 127F 130B 192S 193F 195B 198S 200F 200F 200B 209S 210F 210B 213S 214F 216F 216F 219F 219B 222S 223F 224F 224B 227S 229F 229B 231S 233B 235S 238F 238F 238B 240S 242F 242B 270S 271F 271B 293S 293S 297S 297S 299S 300B 308S 309F 311F 311F 313F 313B 315S 318F 318B 320S 321F 321B 368S 368S JVM1 I*4 316S 317F JVN1 I*4 309S 310F JW I*4 72S 73B 98S 98S 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 18 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 103S 104F 104B 110S 111F 111B 128S 129F 129F 130B 194S 195B 214S 217F 217F 219F 219B 223S 224F 224B 228S 229F 229B 232S 233B 236S 238F 238F 238B 241S 242F 242B 300S 300S 310S 312F 312F 313F 313B 317S 318F 318B K I*4 57S 58F 60F 63F 67F 70F 75F 83F 90F 93F 94F 95F 101F 124F 152F 160F 160F 160F 168F 172F 181F 183F 188F 191F 197F 202F 212F 221F 226F 237F 252F 269F 283F 290F 291F 292F 295F 333F 337F 345F 363F KV I*4 39S 39S 368S 368S L I*4 124S 125F 127F 129F 130F 130F 130F 132F 133F 134F 135F 136F 136F 136F 136F 137F 138F 138F 140F 143F 144F 145F 145B MATEQ X 108F MAXITER I*4 80S 277F 340F 372F MEANFT I*4 A 10 59S 61 N I*4 32S 33F 34F 38F 123F 150F 166F 171F 185F 189F 199F 204F 210F 215F 229F 242F 245F 249F 258F 261F 264F 286F 330F 342F 353F 365F NG I*4 A 8 284S 288F 288S 290F 334F 338F NOPARM I*4 160S 161F 162F 163F NRS1 I*4 107S 108B P R*8 AT 16 22 108B 111F PI R*4 V 28 PP R*4 A 3 174S 177S 181F 186F 200F 218F 250F 253F 255F 368F 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 19 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) +_______ ____ ______ ________ _______________________________________ 0PR R*4 A 18 68S 93F 153F 169F 177F 184S 186F 186S 189F 189S 204F 210F 229F 238F 291F 338F PREC R*4 A 16 111S 130F SCH R*4 163S 165F SD R*4 A 1 303S 304S 305F 306F 334F 334F 338F 338F SD1 R*4 305S 307F 311S 313F SD2 R*4 306S 307F 312S 313F SEED R*4 A 8 65S 334F 334F SIGMA R*4 A 11 73S 77S 98F 104F 136F 136F 136F 229S 300F 303F 304F 311F 312F 313F 313S 318F 318S 321S 324F 338F SQRT GI 303 304 311 312 SSD R*8 AT 11 20 195S 219F 219S 224F 224S 229F 238F SUM R*8 AT 1 19 193S 200F 200S 210F SUMLNF R*4 149S 156F 156S 158F SUMPXF R*8 T 19 151S 153F 153S 155F 156F TERM R*4 218S 219F TEST R*4 271S 272F TITLE R*4 A 7 29S 31F 329F TOL R*4 268S 272F TRUDET R*8 AT 17 23 121S 135F 136S 137F 138F 138S 144F VARHAT R*8 AT 13 21 104S 108B 117F 117F 117F 242S WGSS R*8 AT 12 20 233S 238F 238S 242F X R*4 A 1 39S 44F 45F 49F 50F 51F 52F 127F 129F 200F 216F 217F 355F 355S 357F 357S 359F 359S 361F 361S 368F XBAR R*8 AT 8 25 61S 65F 85F 91F 127F 129F 210S 216F 217F 271F 293F 297F 334F 334F 338F 338F XBAROLD R*8 AT 8 25 85S 271F XIDET R*4 A 17 115S 120F XLGDET R*4 A 17 120S 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 20 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) +_______ ____ ______ ________ _______________________________________ 0XMAX R*4 A 14 44S 51F 52S 56F XMIN R*4 A 14 45S 49F 50S 55F XMINOBS R*4 203S 204F 206F XMN2LL R*4 158S 159F 162F 163F 331F XMXPR R*4 A 5 250S 253F 255S XN R*4 33S 163F ZSQ R*4 134S 139F 143F 0 0VARIABLES REFERENCED BUT NOT SET. (* POSSIBLY SET AS ARGUMENT.) 0IV* JFLG* P* 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 21 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 262 258 300 B 47 41 400 53 48 500 54 38 600 62 60 602 66 63 64 650 69 67 660 74 70 71 72 665 78 75 76 670 99 95 97 671 B 100 94 675 105 102 103 676 112 109 110 680 122 101 700 B 82 279 710 92 90 800 247 245 810 86 83 84 900 B 248 244 1000 147 124 1090 B 142 139 1100 B 146 141 1200 148 123 1310 131 126 128 1350 170 166 168 1400 B 178 171 172 175 1410 B 176 173 1420 182 180 1500 B 255 253 1600 B 257 249 252 254 1750 196 191 192 194 1875 201 197 198 199 1900 211 202 209 1950 234 231 232 2050 B 206 204 2100 154 152 2150 B 208 205 2200 B 157 150 155 2300 239 235 236 237 2400 243 240 241 2500 301 299 2501 325 295 2503 314 308 310 2505 319 315 317 2506 322 320 2508 335 333 2509 339 337 2800 294 292 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 22 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 2900 B 267 264 265 2901 B 274 269 270 272 3000 B 276 263 266 273 3100 B 280 277 3300 B 282 275 281 3310 285 283 3320 289 286 3500 370 363 365 3505 B 369 366 3510 362 353 3525 350 342 345 3600 220 212 213 214 215 3700 225 221 222 223 3710 230 226 227 228 3800 187 183 185 3900 190 188 4000 B 374 207 10000 NF 375 30 326 328 11000 NF 376 57 12000 NF 377 32 13000 NF 378 36 15000 NF 379 34 330 15500 NF 380 259 16000 NF 381 260 18000 NF 382 261 20000 NF 383 89 22000 NF 384 79 23000 NF 386 88 25000 NF 385 68 26000 NF 387 58 28000 NF 388 293 297 30000 NF 389 159 331 32000 NF 390 87 33000 NF 393 91 34000 NF 391 290 35000 NF 392 93 291 36000 NF 394 29 37 59 40000 NF 395 31 329 42000 NF 396 298 42500 NF 397 96 296 48000 NF 398 98 300 48500 NF 399 307 48600 NF 400 302 48700 NF 401 324 48800 NF 402 323 48900 NF 403 338 48901 NF 404 334 48952 NF 406 332 48955 NF 405 327 49000 NF 407 336 50000 NF 408 368 52000 NF 409 351 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:34 NAME:MAIN# PAGE: 23 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 52100 NF 410 352 53000 NF 411 364 54000 NF 412 35 58000 NF 413 UNREFERENCED 60000 NF 414 UNREFERENCED 62000 NF 415 UNREFERENCED 64000 NF 416 55 66000 NF 417 56 68000 NF 418 280 341 373 70000 NF 419 164 71000 NF 420 165 72000 NF 421 161 74000 NF 422 206 76000 NF 423 179 82000 NF 424 181 84000 NF 425 371 0*STATISTICS* SOURCE STATEMENTS: 409, PROGRAM SIZE: 7190728 BYTES, PROGRAM NAME: MAIN#, PAGE: 1 *STATISTICS* NO DIAGNOSTICS GENERATED. **MAIN#** END OF COMPILATION 1 ****** TIME STAMP: 94.00601.48.34 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:36 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 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 JAN 06, 1994 01:48:36 NAME:MAIN# PAGE: 25 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 JAN 06, 1994 01:48:36 NAME:MATEQ PAGE: 26 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 JAN 06, 1994 01:48:36 NAME:MATEQ PAGE: 27 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 JAN 06, 1994 01:48:36 NAME:MATEQ PAGE: 28 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 JAN 06, 1994 01:48:36 NAME:MATEQ PAGE: 29 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 JAN 06, 1994 01:48:36 NAME:MATEQ PAGE: 30 0*STATISTICS* SOURCE STATEMENTS: 75, PROGRAM SIZE: 3564 BYTES, PROGRAM NAME: MATEQ, PAGE: 24 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATEQ** END OF COMPILATION 2 ****** TIME STAMP: 94.00601.48.36 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:36 PAGE: 31 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 JAN 06, 1994 01:48:36 NAME:MATDT PAGE: 32 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: 31 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATDT** END OF COMPILATION 3 ****** TIME STAMP: 94.00601.48.36 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN JAN 06, 1994 01:48:36 PAGE: 33 0SUMMARY OF MESSAGES AND STATISTICS FOR ALL COMPILATIONS 0*STATISTICS* SOURCE STATEMENTS: 409, PROGRAM SIZE: 7190728 BYTES, PROGRAM NAME: MAIN#, PAGE: 1 *STATISTICS* NO DIAGNOSTICS GENERATED. **MAIN#** END OF COMPILATION 1 ****** TIME STAMP: 94.00601.48.36 0*STATISTICS* SOURCE STATEMENTS: 75, PROGRAM SIZE: 3564 BYTES, PROGRAM NAME: MATEQ, PAGE: 24 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATEQ** END OF COMPILATION 2 ****** TIME STAMP: 94.00601.48.36 0*STATISTICS* SOURCE STATEMENTS: 31, PROGRAM SIZE: 1552 BYTES, PROGRAM NAME: MATDT, PAGE: 31 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATDT** END OF COMPILATION 3 ****** TIME STAMP: 94.00601.48.36 0******* SUMMARY STATISTICS ******* 0 DIAGNOSTICS GENERATED. HIGHEST SEVERITY CODE IS 0.