1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 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: Computer Programs for Mixture-Model Clustering C C C C COPYRIGHT 1991 STANLEY LOUIS SCLOVE. C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C PROGRAM ISDTPDT C VERSION 1.7 23-MAR-92 C C PROGRAM ISDTPDT (ISoDaTa, P-variate data, using C DeTerminants of group covariance matrices) IS ONE OF THE C "ISODATA" (ISDTP)PROGRAMS FOR CLUSTERING MULTIVARIATE C DATA. (FOR UNIVARIATE DATA THE C "ISDT1" PROGRAMS MAY BE USED.) C ISODATA.EUCLID USES EUCLIDEAN DISTANCE (FOR RESEARCH C PURPOSES, NOT RECOMMENDED FOR DATA ANALYSIS). ISDTPCM C USES DISTANCE IN THE METRIC OF THE ESTIMATED COMMON C COVARIANCE MATRIX. ISDTPDF USES DIFFERENT COVARIANCE C MATRICES FOR THE C CLUSTERS. ISDTPDT USES DIFFERENT COVARIANCE MATRICES, WITH C ADJUSTMENT BY THE DETERMINANTS, I.E., IT USES THE ESTIMATED LOG C LIKELIHOOD FOR THE GAUSSIAN MODEL WITH DIFFERENT COVARIANCE C MATRICES. C MANUAL MODE: NUMBER OF CLUSTERS AND INITIAL MEANS ARE INPUT C USE PROGRAMS ISDT***A (A=AUTOMATIC) TO TRY A RANGE OF NUMBERS OF C C CLUSTERS, WITH AUTOMATIC SETTING OF INITIAL MEANS. C C C C C C PROGRAMMED BY C C DR. STANLEY L. SCLOVE 312/996-2681 C C DEPT. OF INFORMATION & DECISION SCIENCES 312/996-2676 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 PROGRAM ISOPAC:ISDTPDT C C COPYRIGHT 1991 STANLEY LOUIS SCLOVE. C C C C C C RESEARCH SUPPORTED IN PART BY: C C C C ONR CONTRACT N00014-80-C-0408, TASK NR042-443 C C ARO CONTRACT DAAG29-82-K-0155 C C C 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 2 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C RESTRICTIONS (CAN BE MODIFIED): 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 SUBROUTINE(S) CALLED: C C MATEQ, WHICH CALLS MATDT C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1 DIMENSION X(1000,20),SUM(29,20) 2 DIMENSION D(29),ICLUS(1000) 3 DIMENSION TITLE(18) 4 DIMENSION NG(29),XMEAN(29,20) 5 DIMENSION FMT(18) 6 DIMENSION SS(29,20,20),SSD(29,20,20) 7 DIMENSION WGSS(20,20) 8 DIMENSION VARHAT(20,20),WGMS(20,20) 9 DIMENSION ICLSOL(1000) 10 DIMENSION XMIN(20),XMAX(20) 11 DIMENSION IV(20,20) 12 DIMENSION P(20,20) C 13 DIMENSION A(20,20) C 14 DIMENSION ET(29) 15 DIMENSION PG(29,20,20) C 16 DOUBLE PRECISION SS,SUM 17 DOUBLE PRECISION WGSS,SSD 18 DOUBLE PRECISION VARHAT 19 DOUBLE PRECISION P 20 DOUBLE PRECISION DET 21 DOUBLE PRECISION D 22 DOUBLE PRECISION XMEAN 23 DOUBLE PRECISION TEMPIV,TEMPJV 24 DOUBLE PRECISION F 25 DOUBLE PRECISION CF C 26 DOUBLE PRECISION A C 27 DOUBLE PRECISION ET 28 DOUBLE PRECISION PG C C IV IS A WORK ARRAY FOR SUBROUTINE MATEQ. C C CONTROL CARDS: C C DATASET TITLE C N, IN FORMAT (2X,I4) C IP, IN FORMAT (3X,I2) C FMT, IN FORMAT (18A4), E.G., (4F4.1) C "FMT" WILL ALSO BE USED FOR OUTPUT, SO ALLOW AT LEAST ONE BLANK C AT THE BEGINNING FOR CARRIAGE CONTROL. C DATA, ONE CASE AT A TIME, IN FORMAT SPECIFIED BY FMT 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 3 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C K, NUMBER OF CLUSTERS, IN FORMAT (2X,I2) C K INITIAL MEANS, IN FORMAT SPECIFIED BY FMT C C 29 READ (5,38000) TITLE C C WRITE PROGRAM INFORMATION. 30 WRITE (6,24000) 31 WRITE (6,42000) TITLE C C READ SAMPLE SIZE, N. 32 READ (5,12000) N 33 XN = N 34 WRITE (6,40000) N C READ NUMBER OF VARIABLES, IP. 35 READ (5,56000) IP 36 WRITE (6,58000) IP C C READ DATA FORMAT. 37 READ (5,38000) FMT C C READ DATA. 38 DO 500 I = 1,N 1 39 READ (5,FMT) (X(I,IVAR), IVAR = 1,IP) 1 40 IF (I .EQ. 1) GO TO 100 1 41 GO TO 300 1 42 100 CONTINUE 1 43 DO 200 IVAR = 1,IP 2 44 XMAX(IVAR) = X(1,IVAR) 2 45 XMIN(IVAR) = X(1,IVAR) 2 46 200 CONTINUE 1 47 300 CONTINUE 1 48 DO 400 IVAR = 1,IP 2 49 IF (X(I,IVAR) .LT. XMIN(IVAR)) XMIN(IVAR)=X(I,IVAR) 2 51 IF (X(I,IVAR) .GT. XMAX(IVAR)) XMAX(IVAR)=X(I,IVAR) 2 53 400 CONTINUE 1 54 500 CONTINUE 55 WRITE (6,66000) 56 WRITE (6,FMT) (XMIN(IVAR),IVAR=1,IP) 57 WRITE (6,68000) 58 WRITE (6,FMT) (XMAX(IVAR),IVAR=1,IP) C READ K, NUMBER OF CLUSTERS. 59 READ (5,10000) K 60 WRITE (6,26000) K C 61 WRITE (6,20000) C READ INITIAL MEANS 62 DO 600 IG=1,K 1 63 READ (5,FMT) (XMEAN(IG,IVAR), IVAR=1,IP) C 1 64 WRITE (6,22000) 1 65 WRITE (6,FMT) ( XMEAN(IG,IVAR), IVAR=1,IP) 1 66 600 CONTINUE C SET CONSTANTS. 67 PI = 3.1415927 C PARAMETERS FOR MODEL WITH COMMON COVARIANCE MATRIX ARE 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 4 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 C K MEAN VECTORS AND ONE COVARIANCE MATRIX. 68 NOPARM = K*IP + IP*(IP+1)/2 C PARAMETERS FOR MODEL WITH DIFFERENT COVARIANCE MATRICES ARE C K MEAN VECTORS AND K COVARIANCE MATRICES. 69 NPRMDF = K*IP + K*IP*(IP+1)/2 C 70 ITER = 1 71 700 CONTINUE 72 IF (ITER .EQ. 1) GO TO 900 73 DO 800 I = 1,N 1 74 ICLSOL(I) = ICLUS(I) 1 75 800 CONTINUE C COMMENCE DISTANCE COMPUTATIONS. 76 900 CONTINUE 77 DO 1700 I = 1,N 1 78 DO 1000 L = 1,K 2 79 D(L) = 0.0 2 80 1000 CONTINUE C FOR FIRST ITERATION, EUCLIDEAN DISTANCE IS USED BECAUSE C NO COVARIANCE MATRIX IS YET AVAILABLE. AFTER THE FIRST C ITERATION, DISTANCE WILL BE TAKEN IN THE METRIC OF THE C COVARIANCE MATRIX. C 1 81 IF (ITER .GT. 1) GO TO 1200 1 82 DO 1100 L=1,K 2 83 DO 1100 IVAR=1,IP 3 84 D(L) = D(L) + ( XMEAN(L,IVAR) - X(I,IVAR) )**2 3 85 1100 CONTINUE 1 86 GO TO 1500 1 87 1200 CONTINUE 1 88 DO 1400 L=1,K 2 89 DO 1300 IVAR=1,IP 3 90 TEMPIV = XMEAN(L,IVAR) - X(I,IVAR) 3 91 DO 1300 JV=1,IP 4 92 TEMPJV = XMEAN(L,JV) - X(I,JV) C 4 93 D(L) = D(L) + TEMPIV*PG(L,IVAR,JV)*TEMPJV C 4 94 1300 CONTINUE 2 95 D(L) = D(L) + ET(L) 2 96 1400 CONTINUE 1 97 1500 CONTINUE 1 98 F = D(1) 1 99 ICLUS(I) = 1 1 100 DO 1700 L = 2,K 2 101 IF ( D(L) - F ) 1600,1700,1700 2 102 1600 F = D(L) 2 103 ICLUS(I) = L 2 104 1700 CONTINUE 105 WRITE (6,14000) C 106 IF ( N .GE. 61 ) GO TO 1701 107 WRITE (6,16000) 108 WRITE (6,18000) (I, ICLUS(I), I=1,N) 109 1701 CONTINUE C 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 5 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 110 DO 1800 IG = 1,K 1 111 NG(IG) = 0 1 112 DO 1800 IVAR = 1,IP 2 113 SUM(IG,IVAR) = 0.0 2 114 DO 1800 JV = 1,IP 3 115 SS(IG,IVAR,JV) = 0.0 3 116 SSD(IG,IVAR,JV) = 0.0 3 117 1800 CONTINUE 118 DO 1900 I = 1,N 1 119 IGROUP = ICLUS(I) 1 120 NG(IGROUP) = NG(IGROUP) + 1 1 121 DO 1900 IVAR = 1,IP 2 122 SUM(IGROUP,IVAR) = SUM(IGROUP,IVAR) + X(I,IVAR) 2 123 DO 1900 JV = 1,IP 3 124 SS(IGROUP,IVAR,JV) = SS(IGROUP,IVAR,JV) + X(I,IVAR) 3 X *X(I,JV) 3 125 1900 CONTINUE 126 DO 2000 IVAR = 1,IP 1 127 DO 2000 JV = 1,IP 2 128 WGSS(IVAR,JV) = 0.0 2 129 2000 CONTINUE C C 130 DO 2300 IG = 1,K 1 131 IF (NG(IG) .EQ. 0) GO TO 2100 1 132 GO TO 2200 1 133 2100 WRITE (6,78000) IG 1 134 GO TO 3500 1 135 2200 CONTINUE 1 136 DO 2300 IVAR = 1,IP 2 137 XMEAN(IG,IVAR) = SUM(IG,IVAR)/NG(IG) 2 138 DO 2300 JV = 1,IP 3 139 CF = SUM(IG,IVAR)*SUM(IG,JV)/NG(IG) 3 140 SSD(IG,IVAR,JV) = SS(IG,IVAR,JV) - CF 3 141 2300 CONTINUE C C C C POOL: C 142 DO 2400 IG = 1,K 1 143 DO 2400 IVAR = 1,IP 2 144 DO 2400 JV = 1,IP 3 145 WGSS(IVAR,JV) = WGSS(IVAR,JV) + SSD(IG,IVAR,JV) 3 146 2400 CONTINUE C C C COMPUTE VARHAT, MLE OF COMMON COVARIANCE MATRIX: 147 DO 2500 IVAR = 1,IP 1 148 DO 2500 JV = 1,IP 2 149 VARHAT(IVAR,JV) = WGSS(IVAR,JV)/N 2 150 2500 CONTINUE 151 WRITE (6,44000) 152 DO 2600 IVAR=1,IP 1 153 WRITE (6,50000) (VARHAT(IVAR,JV),JV=1,IP) 1 154 2600 CONTINUE 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 6 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 155 IDET = 1 156 NRS1 = 0 157 CALL MATEQ(VARHAT,IP,20,JFLG,DET,IDET,IV,NRS1,P,20) 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 158 IF (JFLG .GT. 0) WRITE (6,62000) JFLG 160 WRITE (6,64000) DET,IDET C 161 WRITE (6,46000) 162 DO 2700 IVAR=1,IP 1 163 WRITE (6,50000) (P(IVAR,JV),JV=1,IP) 1 164 2700 CONTINUE 165 XIDET = IDET 166 XLGDET = DLOG(DET) + XIDET*ALOG(10.0) 167 XMN2LL = N*(IP*ALOG(2.0*PI) + IP + XLGDET) C 168 WRITE (6,30000) XMN2LL C COMPUTE MODEL-SELECTION CRITERIA (AIC AND SCHWARZ' CRITERION): C PARAMETERS: C K MEAN VECTORS OF DIMENSION P AND A P-BY-P COVARIANCE MATRIX, C WHERE P IS THE NUMBER OF VARIABLES 169 WRITE (6,76000) NOPARM 170 AIC = XMN2LL + 2.0*NOPARM 171 WRITE (6,72000) AIC 172 SCH = XMN2LL + ALOG(XN)*NOPARM 173 WRITE (6,73000) SCH 174 TERM=0.0 175 DO 3000 L=1,K 1 176 DO 2800 IVAR=1,IP 2 177 DO 2800 JV = 1,IP 3 178 A(IVAR,JV) = SSD(L,IVAR,JV)/NG(L) 3 179 2800 CONTINUE 1 180 IDET = 1 1 181 NRS1 = 0 1 182 CALL MATEQ(A,IP,20,JFLG,DET,IDET,IV,NRS1,P,20) 1 183 DO 2900 IVAR=1,IP 2 184 DO 2900 JV=1,IP 3 185 PG(L,IVAR,JV) = P(IVAR,JV) 3 186 2900 CONTINUE C 1 187 ET(L) = DLOG(DET*10**IDET) 1 188 TERM = TERM + NG(L)*ET(L) 1 189 3000 CONTINUE C COMPUTE MODEL-SELECTION CRITERIA BASED ON DIFFERENT COVARIANCE C MATRICES. C PARAMETERS: C K MEAN VECTORS OF DIMENSION P AND K P-BY-P COVARIANCE MATRICES, C WHERE P IS THE NUMBER OF VARIABLES 190 XM2LLD = N*IP*ALOG(2*PI) + N*IP + TERM 191 AICD = XM2LLD + 2.0*NPRMDF 192 SCHD = XM2LLD + ALOG(XN)*NPRMDF 193 WRITE (6,32000) XM2LLD 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 7 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 194 WRITE (6,76000) NPRMDF 195 WRITE (6,74000) AICD 196 WRITE (6,75000) SCHD C C 197 WRITE (6,34000) ITER 198 DO 3100 IG = 1,K 1 199 WRITE (6,28000) IG, (XMEAN(IG,IVAR),IVAR=1,IP) 1 200 3100 CONTINUE 201 IF (ITER .EQ. 1) GO TO 3300 202 DO 3200 I = 1,N 1 203 IF (ICLUS(I) .EQ. ICLSOL(I)) GO TO 3200 1 204 GO TO 3300 1 205 3200 CONTINUE 206 GO TO 3600 207 3300 CONTINUE 208 ITER = ITER + 1 209 IF (ITER.GE.21) GO TO 3400 210 GO TO 700 211 3400 WRITE (6,70000) 212 3500 STOP C C 213 3600 CONTINUE C 214 WRITE (6,60000) ITER 215 WRITE (6,36000) (NG(IG),IG=1,K) 216 DO 3700 IVAR = 1,IP 1 217 DO 3700 JV = 1,IP 2 218 WGMS(IVAR,JV) = WGSS(IVAR,JV)/(N-K) 2 219 3700 CONTINUE 220 WRITE (6,48000) 221 DO 3800 IVAR=1,IP 1 222 WRITE (6,50000) (WGMS(IVAR,JV), JV=1,IP) 1 223 3800 CONTINUE C 224 WRITE (6,82000) 225 DO 3900 L=1,K 1 226 DO 3900 IVAR=1,IP 2 227 DO 3900 JV=1,IP C3900 SSD(L,IVAR,JV) = SSD(L,IVAR,JV)/(NG(L)-1) 3 228 3900 SSD(L,IVAR,JV) = SSD(L,IVAR,JV)/NG(L) 229 DO 4000 L=1,K 1 230 WRITE (6,86000) L 1 231 DO 4000 IVAR=1,IP 2 232 4000 WRITE (6,84000) (SSD(L,IVAR,JV),JV=1,IP) C C C 233 IF ( N .GE. 61) GO TO 4001 C 234 WRITE (6,54000) 235 DO 4100 I = 1,N 1 236 WRITE (6,52000) I, ICLUS(I) 1 237 WRITE (6,FMT) (X(I,IVAR),IVAR=1,IP) 1 238 4100 CONTINUE 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 8 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 239 4001 CONTINUE C 240 WRITE (6,80000) C C 241 STOP 242 10000 FORMAT(2X,I2) 243 12000 FORMAT(2X,I4) 244 14000 FORMAT(//1X,'CLUSTERING:'/) 245 16000 FORMAT(/,1X,'CASES AND LABELS:--'/) 246 18000 FORMAT(15(I5,I3)) 247 20000 FORMAT(//1X,'INITIAL MEANS'/) 248 22000 FORMAT(1X, (8F13.5/)//) 249 24000 FORMAT('1','****************************************', X//,1X,'PROGRAM ISDTPDT '/ X,1X,'FOR CLUSTERING MULTIVARIATE DATA '/ X,1X,'USING DISTANCE IN THE METRICS OF THE COVARIANCE MATRICES'/ X,1X,'ADJUSTED BY THE DETERMINANTS '/ X//,1X,'DEVELOPED AND PROGRAMMED BY DR. STANLEY L. SCLOVE' X//,1X,'VERSION 1.7 23-MAR-92 '//, Y//,1X,'PROGRAM ISOPAC:ISDTPDT'/ Z' COPYRIGHT 1991 STANLEY LOUIS SCLOVE. '//) 250 26000 FORMAT('1',//,1X,'K = ',I2,' CLUSTERS') 251 28000 FORMAT(1X,'MEAN VECTOR FOR CLUSTER ',I2,': ',(8F13.5/)) 252 30000 FORMAT(/,1X,'MINUS 2 LOG LIKELIHOOD FOR MODEL WITH COMMON', X' COVARIANCE MATRIX= ', F13.5//) 253 32000 FORMAT(/,1X,'MINUS 2 LOG LIKELIHOOD FOR MODEL WITH DIFFERENT ', X'COVARIANCE MATRICES = ', F13.5//) 254 34000 FORMAT(///,1X,'ITERATION ', I2,//) 255 36000 FORMAT(/,1X,'NUMBERS:',3X,9(I10,3X)/) 256 38000 FORMAT(18A4) 257 40000 FORMAT(1X,'N = ',I3/) 258 42000 FORMAT(1X,18A4) 259 44000 FORMAT(///,1X,'COMMON COVARIANCE MATRIX (MLE):',//) 260 46000 FORMAT(//,1X,'INVERSE COVARIANCE MATRIX:',//) 261 48000 FORMAT(///,1X,'COMMON COVARIANCE MATRIX (UNBIASED ESTIMATE):',//) 262 50000 FORMAT(1X,8F13.5/) 263 52000 FORMAT(1X,I4,1X,I2) 264 54000 FORMAT(//,1X,'CASE, LABEL / DATA'//) 265 56000 FORMAT(3X,I2) 266 58000 FORMAT(1X,'NUMBER OF VARIABLES = ',I2/) 267 60000 FORMAT(/1X,'CONVERGENCE: NO CASE CHANGED CLUSTERS AFTER ', X'ITERATION ',I2,'. RESULTS ARE PRINTED BELOW.'//) 268 62000 FORMAT(/,1X,'JFLG = ',I2,'. IF JFLG=0, COMPUTATION OF DET', X' WENT WELL; OTHERWISE, THERE WAS TROUBLE OR MATRIX WAS ', X'ILL-CONDITIONED.'//) 269 64000 FORMAT(/1X,'DET = ',F13.5,' IDET = ',I3,5X, X'ACTUAL DET. = DET*10**IDET',//) 270 66000 FORMAT(/1X,'MINIMUM FOR EACH VARIABLE: ',/) 271 68000 FORMAT(/1X,'MAXIMUM FOR EACH VARIABLE: ',/) 272 70000 FORMAT(1X,'ROUTINE HAS NOT CONVERGED IN 20 ITERATIONS. STOP') 273 72000 FORMAT(1X,'AIC FOR MODEL WITH COMMON COVARIANCE MATRIX = ',F15.5/) 274 73000 FORMAT(1X,'SCHWARZ CRITERION ', X'FOR MODEL WITH COMMON COVARIANCE MATRIX = ',F15.5/) 275 74000 FORMAT(1X,'AIC FOR MODEL WITH DIFFERENT COVARIANCE MATRICES = ', XF15.5/) 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 9 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 276 75000 FORMAT(1X,'SCHWARZ CRITERION ', X'FOR MODEL WITH DIFFERENT COVARIANCE MATRICES = ', XF15.5/) 277 76000 FORMAT(/,1X,'NUMBER OF PARAMETERS = ',I4//) 278 78000 FORMAT(1X,'NO OBSERVATIONS IN GROUP ',I3,'. STOP') 279 80000 FORMAT(//,1X,'PROGRAM ENDED NORMALLY.') 280 82000 FORMAT(//,1X,'COVARIANCE MATRICES (UNBIASED ESTIMATES)'//) 281 84000 FORMAT(/1X,15F5.2/(3X,15F5.2/)) 282 86000 FORMAT(//,1X,'COVARIANCE MATRIX FOR CLUSTER ', I2/) 283 END 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 10 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) +______ ____ ______ ________ ________________________________________ 0A R*8 AT 13 26 178S 182B AIC R*4 170S 171F AICD R*4 191S 195F ALOG R*4 I 166 167 172 190 192 CF R*8 T 25 139S 140F D R*8 AT 2 21 79S 84F 84S 93F 93S 95F 95S 98F 101F 102F DET R*8 T 20 157B 160F 166F 182B 187F DLOG R*8 I 166 187 ET R*8 AT 14 27 95F 187S 188F F R*8 T 24 98S 101F 102S FMT R*4 A 5 37S 39 56F 58F 63 65F 237F I I*4 38S 39 40F 49F 50F 51F 52B 73S 74F 74B 77S 84F 90F 92F 99F 103B 108S 108F 108B 118S 119F 122F 124F 124B 202S 203F 203B 235S 236F 236F 237B ICLSOL I*4 A 9 74S 203F ICLUS I*4 A 2 74F 99S 103S 108F 119F 203F 236F IDET I*4 155S 157B 160F 165F 180S 182B 187F IG I*4 62S 63 65B 110S 111F 113F 115F 116B 130S 131F 133F 137F 137F 137F 139F 139F 139F 140F 140B 142S 145B 198S 199F 199B 215S 215S IGROUP I*4 119S 120F 120F 122F 122F 124F 124F IP I*4 35S 36F 39 43F 48F 56F 58F 63 65F 68F 68F 68F 69F 69F 69F 83F 89F 91F 112F 114F 121F 123F 126F 127F 136F 138F 143F 144F 147F 148F 152F 153F 157B 162F 163F 167F 167F 176F 177F 182B 183F 184F 190F 190F 199F 216F 217F 221F 222F 226F 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 11 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 227F 231F 232F 237F ITER I*4 70S 72F 81F 197F 201F 208F 208S 209F 214F IV I*4 A 11 157B 182B IVAR I*4 39S 39S 43S 44F 44F 45F 45B 48S 49F 49F 50F 50F 51F 51F 52F 52B 56S 56S 58S 58S 63S 63S 65S 65S 83S 84F 84B 89S 90F 90F 93B 112S 113F 115F 116B 121S 122F 122F 122F 124F 124F 124B 126S 128B 136S 137F 137F 139F 140F 140B 143S 145F 145F 145B 147S 149F 149B 152S 153B 162S 163B 176S 178F 178B 183S 185F 185B 199S 199S 216S 218F 218B 221S 222B 226S 228F 228B 231S 232B 237S 237S JFLG I*4 157B 158F 159F 182B JV I*4 91S 92F 92F 93B 114S 115F 116B 123S 124F 124F 124B 127S 128B 138S 139F 140F 140B 144S 145F 145F 145B 148S 149F 149B 153S 153S 163S 163S 177S 178F 178B 184S 185F 185B 217S 218F 218B 222S 222S 227S 228F 228B 232S 232S K I*4 59S 60F 62F 68F 69F 69F 78F 82F 88F 100F 110F 130F 142F 175F 198F 215F 218F 225F 229F L I*4 78S 79B 82S 84F 84F 84B 88S 90F 92F 93F 93F 93F 95F 95F 95B 100S 101F 102F 103B 175S 178F 178F 185F 187F 188F 188B 225S 228F 228F 228B 229S 230F 232B MATEQ X 157F 182F N I*4 32S 33F 34F 38F 73F 77F 106F 108F 118F 149F 167F 190F 190F 202F 218F 233F 235F NG I*4 A 4 111S 120F 120S 131F 137F 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 12 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 139F 178F 188F 215F 228F NOPARM I*4 68S 169F 170F 172F NPRMDF I*4 69S 191F 192F 194F NRS1 I*4 156S 157B 181S 182B P R*8 AT 12 19 157B 163F 182B 185F PG R*8 AT 15 28 93F 185S PI R*4 67S 167F 190F SCH R*4 172S 173F SCHD R*4 192S 196F SS R*8 AT 6 16 115S 124F 124S 140F SSD R*8 AT 6 17 116S 140S 145F 178F 228F 228S 232F SUM R*8 AT 1 16 113S 122F 122S 137F 139F 139F TEMPIV R*8 T 23 90S 93F TEMPJV R*8 T 23 92S 93F TERM R*4 174S 188F 188S 190F TITLE R*4 A 3 29S 31F VARHAT R*8 AT 8 18 149S 153F 157B WGMS R*4 A 8 218S 222F WGSS R*8 AT 7 17 128S 145F 145S 149F 218F X R*4 A 1 39S 44F 45F 49F 50F 51F 52F 84F 90F 92F 122F 124F 124F 237F XIDET R*4 165S 166F XLGDET R*4 166S 167F XMAX R*4 A 10 44S 51F 52S 58F XMEAN R*8 AT 4 22 63S 65F 84F 90F 92F 137S 199F XMIN R*4 A 10 45S 49F 50S 56F XMN2LL R*4 167S 168F 170F 172F XM2LLD R*4 190S 191F 192F 193F XN R*4 33S 172F 192F 0 0VARIABLES REFERENCED BUT NOT SET. (* POSSIBLY SET AS ARGUMENT.) 0DET* IV* JFLG* P* 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 13 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 300 B 47 41 400 53 48 500 54 38 600 66 62 700 B 71 210 800 75 73 900 B 76 72 1000 80 78 1100 85 82 83 1200 B 87 81 1300 94 89 91 1400 96 88 1500 B 97 86 1600 B 102 101 1700 B 104 77 100 101 101 1701 B 109 106 1800 117 110 112 114 1900 125 118 121 123 2000 129 126 127 2100 B 133 131 2200 B 135 132 2300 141 130 136 138 2400 146 142 143 144 2500 150 147 148 2600 154 152 2700 164 162 2800 179 176 177 2900 186 183 184 3000 189 175 3100 200 198 3200 B 205 202 203 3300 B 207 201 204 3400 B 211 209 3500 B 212 134 3600 B 213 206 3700 219 216 217 3800 223 221 3900 228 225 226 227 4000 232 229 231 4001 B 239 233 4100 238 235 10000 NF 242 59 12000 NF 243 32 14000 NF 244 105 16000 NF 245 107 18000 NF 246 108 20000 NF 247 61 22000 NF 248 64 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:26 NAME:MAIN# PAGE: 14 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 24000 NF 249 30 26000 NF 250 60 28000 NF 251 199 30000 NF 252 168 32000 NF 253 193 34000 NF 254 197 36000 NF 255 215 38000 NF 256 29 37 40000 NF 257 34 42000 NF 258 31 44000 NF 259 151 46000 NF 260 161 48000 NF 261 220 50000 NF 262 153 163 222 52000 NF 263 236 54000 NF 264 234 56000 NF 265 35 58000 NF 266 36 60000 NF 267 214 62000 NF 268 159 64000 NF 269 160 66000 NF 270 55 68000 NF 271 57 70000 NF 272 211 72000 NF 273 171 73000 NF 274 173 74000 NF 275 195 75000 NF 276 196 76000 NF 277 169 194 78000 NF 278 133 80000 NF 279 240 82000 NF 280 224 84000 NF 281 232 86000 NF 282 230 0*STATISTICS* SOURCE STATEMENTS: 280, PROGRAM SIZE: 403828 BYTES, PROGRAM NAME: MAIN#, PAGE: 1 *STATISTICS* NO DIAGNOSTICS GENERATED. **MAIN#** END OF COMPILATION 1 ****** TIME STAMP: 92.08323.44.26 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:27 PAGE: 15 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 MATEQ(A,M,N,JFLG,DET,IDET,IV,NRS1,P,LL) C SUBROUTINE MATEQ IS DMATEQ FROM THE UICC SUBROUTINE LIBRARY. 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 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. 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 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:27 NAME:MAIN# PAGE: 16 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 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 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 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 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:27 NAME:MATEQ PAGE: 17 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 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 1 44 DO 1100 IM=K1,M C C BEFORE ACTUALLY ELIMINTING WE CHECK TO SEE IF A(IV(IM),K) HAS ALREADY C BEEN ANIHALATED. C 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:27 NAME:MATEQ PAGE: 18 0 IF DO ISN *....*...1.........2.........3.........4.........5.........6.........7.*.......8 0 2 45 IF (A(IV(IM),K).EQ.0.0D+00) GO TO 1100 C C CACULATE 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 MAR 23, 1992 23:44:27 NAME:MATEQ PAGE: 19 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 MAR 23, 1992 23:44:27 NAME:MATEQ 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) +______ ____ ______ ________ ________________________________________ 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 MAR 23, 1992 23:44:27 NAME:MATEQ PAGE: 21 0*STATISTICS* SOURCE STATEMENTS: 75, PROGRAM SIZE: 3564 BYTES, PROGRAM NAME: MATEQ, PAGE: 15 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATEQ** END OF COMPILATION 2 ****** TIME STAMP: 92.08323.44.27 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:28 PAGE: 22 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 MAR 23, 1992 23:44:28 NAME:MATDT PAGE: 23 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: 22 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATDT** END OF COMPILATION 3 ****** TIME STAMP: 92.08323.44.28 1LEVEL 2.5.0 (JUNE 1991) VS FORTRAN MAR 23, 1992 23:44:28 PAGE: 24 0SUMMARY OF MESSAGES AND STATISTICS FOR ALL COMPILATIONS 0*STATISTICS* SOURCE STATEMENTS: 280, PROGRAM SIZE: 403828 BYTES, PROGRAM NAME: MAIN#, PAGE: 1 *STATISTICS* NO DIAGNOSTICS GENERATED. **MAIN#** END OF COMPILATION 1 ****** TIME STAMP: 92.08323.44.28 0*STATISTICS* SOURCE STATEMENTS: 75, PROGRAM SIZE: 3564 BYTES, PROGRAM NAME: MATEQ, PAGE: 15 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATEQ** END OF COMPILATION 2 ****** TIME STAMP: 92.08323.44.28 0*STATISTICS* SOURCE STATEMENTS: 31, PROGRAM SIZE: 1552 BYTES, PROGRAM NAME: MATDT, PAGE: 22 *STATISTICS* NO DIAGNOSTICS GENERATED. **MATDT** END OF COMPILATION 3 ****** TIME STAMP: 92.08323.44.28 0******* SUMMARY STATISTICS ******* 0 DIAGNOSTICS GENERATED. HIGHEST SEVERITY CODE IS 0.